Context Navigation

cosp_types.F90 @ 2955

Last change on this file since 2955 was 2955, checked in by musat, 7 years ago
Ajout modifs de Rodrigo Guzman et Marine Bonazolla dans la version COSP/CMIP6 IM
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory
File size: 70.5 KB

Line
1	! (c) British Crown Copyright 2008, the Met Office.
2	! All rights reserved.
3	!
4	! Redistribution and use in source and binary forms, with or without modification, are permitted
5	! provided that the following conditions are met:
6	!
7	! * Redistributions of source code must retain the above copyright notice, this list
8	! of conditions and the following disclaimer.
9	! * Redistributions in binary form must reproduce the above copyright notice, this list
10	! of conditions and the following disclaimer in the documentation and/or other materials
11	! provided with the distribution.
12	! * Neither the name of the Met Office nor the names of its contributors may be used
13	! to endorse or promote products derived from this software without specific prior written
14	! permission.
15	!
16	! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR
17	! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
18	! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
19	! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
20	! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
21	! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
22	! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
23	! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
24
25	MODULE MOD_COSP_TYPES
26	USE MOD_COSP_CONSTANTS
27	USE MOD_COSP_UTILS
28
29	use radar_simulator_types, only: class_param, nd, mt_nd, dmax, dmin
30
31	IMPLICIT NONE
32
33	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
34	!----------------------- DERIVED TYPES ----------------------------
35	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
36
37	! Configuration choices (simulators, variables)
38	TYPE COSP_CONFIG
39	logical :: Lradar_sim,Llidar_sim,Lisccp_sim,Lmodis_sim,Lmisr_sim,Lrttov_sim,Lstats,Lwrite_output, &
40	Lalbisccp,Latb532,Lboxptopisccp,Lboxtauisccp,LcfadDbze94, &
41	LcfadLidarsr532,Lclcalipso2,Lclcalipso,Lclhcalipso,Lclisccp,Lcllcalipso, &
42	Lclmcalipso,Lcltcalipso,Lcltlidarradar,Lpctisccp,Ldbze94,Ltauisccp,Lcltisccp, &
43	Ltoffset,LparasolRefl,LclMISR,Lmeantbisccp,Lmeantbclrisccp, &
44	Lclcalipsoliq,Lclcalipsoice,Lclcalipsoun, &
45	Lclcalipsotmp,Lclcalipsotmpliq,Lclcalipsotmpice,Lclcalipsotmpun, &
46	Lcltcalipsoliq,Lcltcalipsoice,Lcltcalipsoun, &
47	Lclhcalipsoliq,Lclhcalipsoice,Lclhcalipsoun, &
48	Lclmcalipsoliq,Lclmcalipsoice,Lclmcalipsoun, &
49	Lcllcalipsoliq,Lcllcalipsoice,Lcllcalipsoun, &
50	Lfracout,LlidarBetaMol532,Ltbrttov, &
51	Lcltmodis,Lclwmodis,Lclimodis,Lclhmodis,Lclmmodis,Lcllmodis,Ltautmodis,Ltauwmodis,Ltauimodis,Ltautlogmodis, &
52	Ltauwlogmodis,Ltauilogmodis,Lreffclwmodis,Lreffclimodis,Lpctmodis,Llwpmodis, &
53	Liwpmodis,Lclmodis,Lcrimodis,Lcrlmodis,Lclopaquecalipso,Lclthincalipso, & !OPAQ (2)
54	Lclzopaquecalipso,Lclcalipsoopaque,Lclcalipsothin,Lclcalipsozopaque, & !OPAQ (4)
55	Lclcalipsoopacity,LprofSR,Lproftemp !OPAQ (1) !TIBO (2)
56
57	character(len=32) :: out_list(N_OUT_LIST)
58	END TYPE COSP_CONFIG
59
60	! Outputs from RTTOV
61	TYPE COSP_RTTOV
62	! Dimensions
63	integer :: Npoints ! Number of gridpoints
64	integer :: Nchan ! Number of channels
65
66	! Brightness temperatures (Npoints,Nchan)
67	real,pointer :: tbs(:,:)
68
69	END TYPE COSP_RTTOV
70
71	! Outputs from MISR simulator
72	TYPE COSP_MISR
73	! Dimensions
74	integer :: Npoints ! Number of gridpoints
75	integer :: Ntau ! Number of tau intervals
76	integer :: Nlevels ! Number of cth levels
77
78	! --- (npoints,ntau,nlevels)
79	! the fraction of the model grid box covered by each of the MISR cloud types
80	real,pointer :: fq_MISR(:,:,:)
81
82	! --- (npoints)
83	real,pointer :: MISR_meanztop(:), MISR_cldarea(:)
84	! --- (npoints,nlevels)
85	real,pointer :: MISR_dist_model_layertops(:,:)
86	END TYPE COSP_MISR
87
88	! Outputs from ISCCP simulator
89	TYPE COSP_ISCCP
90	! Dimensions
91	integer :: Npoints ! Number of gridpoints
92	integer :: Ncolumns ! Number of columns
93	integer :: Nlevels ! Number of levels
94
95
96	! --- (npoints,tau=7,pressure=7)
97	! the fraction of the model grid box covered by each of the 49 ISCCP D level cloud types
98	real,pointer :: fq_isccp(:,:,:)
99
100	! --- (npoints) ---
101	! The fraction of model grid box columns with cloud somewhere in them.
102	! This should equal the sum over all entries of fq_isccp
103	real,pointer :: totalcldarea(:)
104	! mean all-sky 10.5 micron brightness temperature
105	real,pointer :: meantb(:)
106	! mean clear-sky 10.5 micron brightness temperature
107	real,pointer :: meantbclr(:)
108
109	! The following three means are averages over the cloudy areas only. If no
110	! clouds are in grid box all three quantities should equal zero.
111
112	! mean cloud top pressure (mb) - linear averaging in cloud top pressure.
113	real,pointer :: meanptop(:)
114	! mean optical thickness linear averaging in albedo performed.
115	real,pointer :: meantaucld(:)
116	! mean cloud albedo. linear averaging in albedo performed
117	real,pointer :: meanalbedocld(:)
118
119	!--- (npoints,ncol) ---
120	! optical thickness in each column
121	real,pointer :: boxtau(:,:)
122	! cloud top pressure (mb) in each column
123	real,pointer :: boxptop(:,:)
124	END TYPE COSP_ISCCP
125
126	! Summary statistics from radar
127	TYPE COSP_VGRID
128	logical :: use_vgrid ! Logical flag that indicates change of grid
129	logical :: csat_vgrid ! Flag for Cloudsat grid
130	integer :: Npoints ! Number of sampled points
131	integer :: Ncolumns ! Number of subgrid columns
132	integer :: Nlevels ! Number of model levels
133	integer :: Nlvgrid ! Number of levels of new grid
134	! Array with dimensions (Nlvgrid)
135	real, dimension(:), pointer :: z,zl,zu ! Height and lower and upper boundaries of new levels
136	! Array with dimensions (Nlevels)
137	real, dimension(:), pointer :: mz,mzl,mzu ! Height and lower and upper boundaries of model levels
138	END TYPE COSP_VGRID
139
140	! Output data from lidar code
141	TYPE COSP_SGLIDAR
142	! Dimensions
143	integer :: Npoints ! Number of gridpoints
144	integer :: Ncolumns ! Number of columns
145	integer :: Nlevels ! Number of levels
146	integer :: Nhydro ! Number of hydrometeors
147	integer :: Nrefl ! Number of parasol reflectances
148	! Arrays with dimensions (Npoints,Nlevels)
149	real,dimension(:,:),pointer :: beta_mol ! Molecular backscatter
150	real,dimension(:,:),pointer :: temp_tot
151	! Arrays with dimensions (Npoints,Ncolumns,Nlevels)
152	real,dimension(:,:,:),pointer :: betaperp_tot ! Total backscattered signal
153	real,dimension(:,:,:),pointer :: beta_tot ! Total backscattered signal
154	real,dimension(:,:,:),pointer :: tau_tot ! Optical thickness integrated from top to level z
155	! Arrays with dimensions (Npoints,Ncolumns,Nrefl)
156	real,dimension(:,:,:),pointer :: refl ! parasol reflectances
157	END TYPE COSP_SGLIDAR
158
159	! Output data from radar code
160	TYPE COSP_SGRADAR
161	! Dimensions
162	integer :: Npoints ! Number of gridpoints
163	integer :: Ncolumns ! Number of columns
164	integer :: Nlevels ! Number of levels
165	integer :: Nhydro ! Number of hydrometeors
166	! output vertical levels: spaceborne radar -> from TOA to SURFACE
167	! Arrays with dimensions (Npoints,Nlevels)
168	real,dimension(:,:),pointer :: att_gas ! 2-way attenuation by gases [dBZ]
169	! Arrays with dimensions (Npoints,Ncolumns,Nlevels)
170	real,dimension(:,:,:),pointer :: Ze_tot ! Effective reflectivity factor [dBZ]
171
172	END TYPE COSP_SGRADAR
173
174
175	! Summary statistics from radar
176	TYPE COSP_RADARSTATS
177	integer :: Npoints ! Number of sampled points
178	integer :: Ncolumns ! Number of subgrid columns
179	integer :: Nlevels ! Number of model levels
180	integer :: Nhydro ! Number of hydrometeors
181	! Array with dimensions (Npoints,dBZe_bins,Nlevels)
182	real, dimension(:,:,:), pointer :: cfad_ze ! Ze CFAD
183	! Array with dimensions (Npoints)
184	real,dimension(:),pointer :: radar_lidar_tcc ! Radar&lidar total cloud amount, grid-box scale
185	! Arrays with dimensions (Npoints,Nlevels)
186	real, dimension(:,:),pointer :: lidar_only_freq_cloud
187	END TYPE COSP_RADARSTATS
188
189	! Summary statistics from lidar
190	TYPE COSP_LIDARSTATS
191	integer :: Npoints ! Number of sampled points
192	integer :: Ncolumns ! Number of subgrid columns
193	integer :: Nlevels ! Number of model levels
194	integer :: Nhydro ! Number of hydrometeors
195	integer :: Nrefl ! Number of parasol reflectances
196
197	! Arrays with dimensions (SR_BINS)
198	real, dimension(:),pointer :: srbval ! SR bins in cfad_sr
199	! Arrays with dimensions (Npoints,SR_BINS,Nlevels)
200	real, dimension(:,:,:),pointer :: cfad_sr ! CFAD of scattering ratio
201	! Arrays with dimensions (Npoints,Nlevels)
202	real, dimension(:,:),pointer :: lidarcld ! 3D "lidar" cloud fraction
203	real, dimension(:,:),pointer :: proftemp ! Temperature profiles 40 levs !TIBO
204	! Arrays with dimensions (Npoints,LIDAR_NCAT)
205	real, dimension(:,:),pointer :: cldlayer ! low, mid, high-level, total lidar cloud cover
206	! Arrays with dimensions (Npoints,LIDAR_NTYPE) !OPAQ
207	real, dimension(:,:),pointer :: cldtype ! opaque and thin cloud covers, z_opaque !OPAQ
208	! Arrays with dimensions (Npoints,Nlevels,Nphase)
209	real, dimension(:,:,:),pointer :: lidarcldphase ! 3D "lidar" phase cloud fraction
210	! Arrays with dimensions (Npoints,Nlevels,LIDAR_NTYPE+1) !OPAQ
211	real, dimension(:,:,:),pointer :: lidarcldtype ! 3D "lidar" OPAQ type fraction + opacity !OPAQ
212	! Arrays with dimensions (Npoints,LIDAR_NCAT,Nphase)
213	real, dimension(:,:,:),pointer :: cldlayerphase ! low, mid, high-level lidar phase cloud cover
214	! Arrays with dimensions (Npoints,Ntemps,Nphase)
215	real, dimension(:,:,:),pointer :: lidarcldtmp ! 3D "lidar" phase cloud temperature
216	! Arrays with dimensions (Npoints,PARASOL_NREFL)
217	real, dimension(:,:),pointer :: parasolrefl ! mean parasol reflectance
218	! ! Arrays with dimensions (Npoints,Ncolumns,Nlevels) !TIBO
219	! real, dimension(:,:,:),pointer :: profSR ! subcolumns for each day !TIBO
220	! Arrays with dimensions (Npoints,Nlevels,Ncolumns) !TIBO2
221	real, dimension(:,:,:),pointer :: profSR ! subcolumns for each day !TIBO2
222
223	END TYPE COSP_LIDARSTATS
224
225
226	! Input data for simulator. Subgrid scale.
227	! Input data from SURFACE to TOA
228	TYPE COSP_SUBGRID
229	! Dimensions
230	integer :: Npoints ! Number of gridpoints
231	integer :: Ncolumns ! Number of columns
232	integer :: Nlevels ! Number of levels
233	integer :: Nhydro ! Number of hydrometeors
234
235	real,dimension(:,:,:),pointer :: prec_frac ! Subgrid precip array. Dimensions (Npoints,Ncolumns,Nlevels)
236	real,dimension(:,:,:),pointer :: frac_out ! Subgrid cloud array. Dimensions (Npoints,Ncolumns,Nlevels)
237	END TYPE COSP_SUBGRID
238
239	! Input data for simulator at Subgrid scale.
240	! Used on a reduced number of points
241	TYPE COSP_SGHYDRO
242	! Dimensions
243	integer :: Npoints ! Number of gridpoints
244	integer :: Ncolumns ! Number of columns
245	integer :: Nlevels ! Number of levels
246	integer :: Nhydro ! Number of hydrometeors
247	real,dimension(:,:,:,:),pointer :: mr_hydro ! Mixing ratio of each hydrometeor
248	! (Npoints,Ncolumns,Nlevels,Nhydro) [kg/kg]
249	real,dimension(:,:,:,:),pointer :: Reff ! Effective Radius of each hydrometeor
250	! (Reff==0 means use default size)
251	! (Npoints,Ncolumns,Nlevels,Nhydro) [m]
252	real,dimension(:,:,:,:),pointer :: Np ! Total # concentration each hydrometeor
253	! (Optional, ignored if Reff > 0).
254	! (Npoints,Ncolumns,Nlevels,Nhydro) [#/kg]
255	! Np = Ntot / rho_a = [#/m^3] / [kg/m^3)
256	! added by Roj with Quickbeam V3
257	END TYPE COSP_SGHYDRO
258
259	! Input data for simulator. Gridbox scale.
260	TYPE COSP_GRIDBOX
261	! Scalars and dimensions
262	integer :: Npoints ! Number of gridpoints
263	integer :: Nlevels ! Number of levels
264	integer :: Ncolumns ! Number of columns
265	integer :: Nhydro ! Number of hydrometeors
266	integer :: Nprmts_max_hydro ! Max number of parameters for hydrometeor size distributions
267	integer :: Naero ! Number of aerosol species
268	integer :: Nprmts_max_aero ! Max number of parameters for aerosol size distributions
269	integer :: Npoints_it ! Max number of gridpoints to be processed in one iteration
270
271	! Time [days]
272	double precision :: time
273	double precision :: time_bnds(2)
274
275	! Radar ancillary info
276	real :: radar_freq, & ! Radar frequency [GHz]
277	k2 ! \|K\|^2, -1=use frequency dependent default
278	integer :: surface_radar, & ! surface=1, spaceborne=0
279	use_mie_tables, & ! use a precomputed loopup table? yes=1,no=0
280	use_gas_abs, & ! include gaseous absorption? yes=1,no=0
281	do_ray, & ! calculate/output Rayleigh refl=1, not=0
282	melt_lay ! melting layer model off=0, on=1
283
284	! structures used by radar simulator that need to be set only ONCE per radar configuration (e.g. freq, pointing direction) ... added by roj Feb 2008
285	type(class_param) :: hp ! structure used by radar simulator to store Ze and N scaling constants and other information
286	integer :: nsizes ! number of discrete drop sizes (um) used to represent the distribution
287
288	! Lidar
289	integer :: lidar_ice_type !ice particle shape hypothesis in lidar calculations
290	!(ice_type=0 for spheres, ice_type=1 for non spherical particles)
291
292	! Radar
293	logical :: use_precipitation_fluxes ! True if precipitation fluxes are input to the algorithm
294	logical :: use_reff ! True if Reff is to be used by radar (memory not allocated
295
296
297	! Geolocation (Npoints)
298	real,dimension(:),pointer :: toffset ! Time offset of esch point from the value in time
299	real,dimension(:),pointer :: longitude ! longitude [degrees East]
300	real,dimension(:),pointer :: latitude ! latitude [deg North]
301	! Gridbox information (Npoints,Nlevels)
302	real,dimension(:,:),pointer :: zlev ! Height of model levels [m]
303	real,dimension(:,:),pointer :: zlev_half ! Height at half model levels [m] (Bottom of model layer)
304	real,dimension(:,:),pointer :: dlev ! Depth of model levels [m]
305	real,dimension(:,:),pointer :: p ! Pressure at full model levels [Pa]
306	real,dimension(:,:),pointer :: ph ! Pressure at half model levels [Pa]
307	real,dimension(:,:),pointer :: T ! Temperature at model levels [K]
308	real,dimension(:,:),pointer :: q ! Relative humidity to water (%)
309	real,dimension(:,:),pointer :: sh ! Specific humidity to water [kg/kg]
310	real,dimension(:,:),pointer :: dtau_s ! mean 0.67 micron optical depth of stratiform
311	! clouds in each model level
312	! NOTE: this the cloud optical depth of only the
313	! cloudy part of the grid box, it is not weighted
314	! with the 0 cloud optical depth of the clear
315	! part of the grid box
316	real,dimension(:,:),pointer :: dtau_c ! mean 0.67 micron optical depth of convective
317	! clouds in each model level. Same note applies as in dtau_s.
318	real,dimension(:,:),pointer :: dem_s ! 10.5 micron longwave emissivity of stratiform
319	! clouds in each model level. Same note applies as in dtau_s.
320	real,dimension(:,:),pointer :: dem_c ! 10.5 micron longwave emissivity of convective
321	! clouds in each model level. Same note applies as in dtau_s.
322	real,dimension(:,:),pointer :: mr_ozone ! Ozone mass mixing ratio [kg/kg]
323
324	! Point information (Npoints)
325	real,dimension(:),pointer :: land !Landmask [0 - Ocean, 1 - Land]
326	real,dimension(:),pointer :: psfc !Surface pressure [Pa]
327	real,dimension(:),pointer :: sunlit ! (npoints) 1 for day points, 0 for nightime
328	real,dimension(:),pointer :: skt ! Skin temperature (K)
329	real,dimension(:),pointer :: u_wind ! eastward wind [m s-1]
330	real,dimension(:),pointer :: v_wind ! northward wind [m s-1]
331
332	! TOTAL and CONV cloud fraction for SCOPS
333	real,dimension(:,:),pointer :: tca ! Total cloud fraction
334	real,dimension(:,:),pointer :: cca ! Convective cloud fraction
335	! Precipitation fluxes on model levels
336	real,dimension(:,:),pointer :: rain_ls ! large-scale precipitation flux of rain [kg/m2.s]
337	real,dimension(:,:),pointer :: rain_cv ! convective precipitation flux of rain [kg/m2.s]
338	real,dimension(:,:),pointer :: snow_ls ! large-scale precipitation flux of snow [kg/m2.s]
339	real,dimension(:,:),pointer :: snow_cv ! convective precipitation flux of snow [kg/m2.s]
340	real,dimension(:,:),pointer :: grpl_ls ! large-scale precipitation flux of graupel [kg/m2.s]
341	! Hydrometeors concentration and distribution parameters
342	! real,dimension(:,:,:),pointer :: fr_hydro ! Fraction of the gridbox occupied by each hydrometeor (Npoints,Nlevels,Nhydro)
343	real,dimension(:,:,:),pointer :: mr_hydro ! Mixing ratio of each hydrometeor (Npoints,Nlevels,Nhydro) [kg/kg]
344	real,dimension(:,:),pointer :: dist_prmts_hydro !Distributional parameters for hydrometeors (Nprmts_max_hydro,Nhydro)
345
346	! Effective radius [m]. (Npoints,Nlevels,Nhydro) -- OPTIONAL, value of 0 mean use fixed default
347	real,dimension(:,:,:),pointer :: Reff
348
349	! Total Number Concentration [#/kg]. (Npoints,Nlevels,Nhydro) -- OPTIONAL, value of 0 mean use fixed default
350	real,dimension(:,:,:),pointer :: Np ! added by Roj with Quickbeam V3
351
352	! Aerosols concentration and distribution parameters
353	real,dimension(:,:,:),pointer :: conc_aero ! Aerosol concentration for each species (Npoints,Nlevels,Naero)
354	integer,dimension(:),pointer :: dist_type_aero ! Particle size distribution type for each aerosol species (Naero)
355	real,dimension(:,:,:,:),pointer :: dist_prmts_aero ! Distributional parameters for aerosols
356	! (Npoints,Nlevels,Nprmts_max_aero,Naero)
357	! ISCCP simulator inputs
358	integer :: isccp_top_height ! 1 = adjust top height using both a computed
359	! infrared brightness temperature and the visible
360	! optical depth to adjust cloud top pressure. Note
361	! that this calculation is most appropriate to compare
362	! to ISCCP data during sunlit hours.
363	! 2 = do not adjust top height, that is cloud top
364	! pressure is the actual cloud top pressure
365	! in the model
366	! 3 = adjust top height using only the computed
367	! infrared brightness temperature. Note that this
368	! calculation is most appropriate to compare to ISCCP
369	! IR only algortihm (i.e. you can compare to nighttime
370	! ISCCP data with this option)
371	integer :: isccp_top_height_direction ! direction for finding atmosphere pressure level
372	! with interpolated temperature equal to the radiance
373	! determined cloud-top temperature
374	! 1 = find the lowest altitude (highest pressure) level
375	! with interpolated temperature equal to the radiance
376	! determined cloud-top temperature
377	! 2 = find the highest altitude (lowest pressure) level
378	! with interpolated temperature equal to the radiance
379	! determined cloud-top temperature
380	! ONLY APPLICABLE IF top_height EQUALS 1 or 3
381	! 1 = default setting, and matches all versions of
382	! ISCCP simulator with versions numbers 3.5.1 and lower
383	! 2 = experimental setting
384	integer :: isccp_overlap ! overlap type (1=max, 2=rand, 3=max/rand)
385	real :: isccp_emsfc_lw ! 10.5 micron emissivity of surface (fraction)
386
387	! RTTOV inputs/options
388	integer :: plat ! satellite platform
389	integer :: sat ! satellite
390	integer :: inst ! instrument
391	integer :: Nchan ! Number of channels to be computed
392	integer, dimension(:), pointer :: Ichan ! Channel numbers
393	real, dimension(:), pointer :: Surfem ! Surface emissivity
394	real :: ZenAng ! Satellite Zenith Angles
395	real :: co2,ch4,n2o,co ! Mixing ratios of trace gases
396
397	END TYPE COSP_GRIDBOX
398
399	CONTAINS
400
401	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
402	!------------- SUBROUTINE CONSTRUCT_COSP_RTTOV -------------------
403	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
404	SUBROUTINE CONSTRUCT_COSP_RTTOV(cfg,Npoints,Nchan,x)
405	type(cosp_config),intent(in) :: cfg ! Configuration options
406	integer,intent(in) :: Npoints ! Number of sampled points
407	integer,intent(in) :: Nchan ! Number of channels
408	type(cosp_rttov),intent(out) :: x
409	! Local variables
410	integer :: i,j
411
412	! Allocate minumum storage if simulator not used
413	if (cfg%Lrttov_sim) then
414	i = Npoints
415	j = Nchan
416	else
417	i = 1
418	j = 1
419	endif
420	x%Npoints = i
421	x%Nchan = j
422
423	! --- Allocate arrays ---
424	allocate(x%tbs(i, j))
425	! --- Initialise to zero ---
426	x%tbs = 0.0
427	END SUBROUTINE CONSTRUCT_COSP_RTTOV
428
429	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
430	!------------- SUBROUTINE FREE_COSP_RTTOV ------------------------
431	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
432	SUBROUTINE FREE_COSP_RTTOV(x)
433	type(cosp_rttov),intent(inout) :: x
434
435	! --- Deallocate arrays ---
436	deallocate(x%tbs)
437	END SUBROUTINE FREE_COSP_RTTOV
438
439	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
440	!------------- SUBROUTINE CONSTRUCT_COSP_MISR ------------------
441	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
442	SUBROUTINE CONSTRUCT_COSP_MISR(cfg,Npoints,x)
443	type(cosp_config),intent(in) :: cfg ! Configuration options
444	integer,intent(in) :: Npoints ! Number of gridpoints
445	type(cosp_misr),intent(out) :: x
446	! Local variables
447	integer :: i,j,k
448
449
450	! Allocate minumum storage if simulator not used
451	if (cfg%Lmisr_sim) then
452	i = Npoints
453	j = 7
454	k = MISR_N_CTH
455	else
456	i = 1
457	j = 1
458	k = 1
459	endif
460
461	! Dimensions
462	x%Npoints = i
463	x%Ntau = j
464	x%Nlevels = k
465
466	! allocate space for MISR simulator outputs ...
467	allocate(x%fq_MISR(i,j,k), x%MISR_meanztop(i),x%MISR_cldarea(i), x%MISR_dist_model_layertops(i,k))
468	x%fq_MISR = 0.0
469	x%MISR_meanztop = 0.0
470	x%MISR_cldarea = 0.0
471	x%MISR_dist_model_layertops = 0.0
472
473	END SUBROUTINE CONSTRUCT_COSP_MISR
474	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
475	!------------- SUBROUTINE FREE_COSP_MISR ------------------
476	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
477	SUBROUTINE FREE_COSP_MISR(x)
478	type(cosp_misr),intent(inout) :: x
479	deallocate(x%fq_MISR, x%MISR_meanztop,x%MISR_cldarea, x%MISR_dist_model_layertops)
480
481	END SUBROUTINE FREE_COSP_MISR
482
483	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
484	!------------- SUBROUTINE CONSTRUCT_COSP_ISCCP ------------------
485	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
486	SUBROUTINE CONSTRUCT_COSP_ISCCP(cfg,Npoints,Ncolumns,Nlevels,x)
487	type(cosp_config),intent(in) :: cfg ! Configuration options
488	integer,intent(in) :: Npoints ! Number of sampled points
489	integer,intent(in) :: Ncolumns ! Number of subgrid columns
490	integer,intent(in) :: Nlevels ! Number of model levels
491	type(cosp_isccp),intent(out) :: x
492	! Local variables
493	integer :: i,j,k
494
495	! Allocate minumum storage if simulator not used
496	if (cfg%Lisccp_sim) then
497	i = Npoints
498	j = Ncolumns
499	k = Nlevels
500	else
501	i = 1
502	j = 1
503	k = 1
504	endif
505
506	! Dimensions
507	x%Npoints = i
508	x%Ncolumns = j
509	x%Nlevels = k
510
511	! --- Allocate arrays ---
512	allocate(x%fq_isccp(i,7,7), x%totalcldarea(i), &
513	x%meanptop(i), x%meantaucld(i), &
514	x%meantb(i), x%meantbclr(i), &
515	x%boxtau(i,j), x%boxptop(i,j), &
516	x%meanalbedocld(i))
517	! --- Initialise to zero ---
518	x%fq_isccp = 0.0
519	x%totalcldarea = 0.0
520	x%meanptop = 0.0
521	x%meantaucld = 0.0
522	x%meantb = 0.0
523	x%meantbclr = 0.0
524	x%boxtau = 0.0
525	x%boxptop = 0.0
526	x%meanalbedocld= 0.0
527	END SUBROUTINE CONSTRUCT_COSP_ISCCP
528
529	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
530	!------------- SUBROUTINE FREE_COSP_ISCCP -----------------------
531	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
532	SUBROUTINE FREE_COSP_ISCCP(x)
533	type(cosp_isccp),intent(inout) :: x
534
535	deallocate(x%fq_isccp, x%totalcldarea, &
536	x%meanptop, x%meantaucld, x%meantb, x%meantbclr, &
537	x%boxtau, x%boxptop, x%meanalbedocld)
538	END SUBROUTINE FREE_COSP_ISCCP
539
540	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
541	!------------- SUBROUTINE CONSTRUCT_COSP_VGRID ------------------
542	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
543	SUBROUTINE CONSTRUCT_COSP_VGRID(gbx,Nlvgrid,use_vgrid,cloudsat,x)
544	type(cosp_gridbox),intent(in) :: gbx ! Gridbox information
545	integer,intent(in) :: Nlvgrid ! Number of new levels
546	logical,intent(in) :: use_vgrid! Logical flag that controls the output on a different grid
547	logical,intent(in) :: cloudsat ! TRUE if a CloudSat like grid (480m) is requested
548	type(cosp_vgrid),intent(out) :: x
549
550	! Local variables
551	integer :: i
552	real :: zstep
553
554	x%use_vgrid = use_vgrid
555	x%csat_vgrid = cloudsat
556
557	! Dimensions
558	x%Npoints = gbx%Npoints
559	x%Ncolumns = gbx%Ncolumns
560	x%Nlevels = gbx%Nlevels
561
562	! --- Allocate arrays ---
563	if (use_vgrid) then
564	x%Nlvgrid = Nlvgrid
565	else
566	x%Nlvgrid = gbx%Nlevels
567	endif
568	allocate(x%z(x%Nlvgrid),x%zl(x%Nlvgrid),x%zu(x%Nlvgrid))
569	allocate(x%mz(x%Nlevels),x%mzl(x%Nlevels),x%mzu(x%Nlevels))
570
571	! --- Model vertical levels ---
572	! Use height levels of first model gridbox
573	x%mz = gbx%zlev(1,:)
574	x%mzl = gbx%zlev_half(1,:)
575	x%mzu(1:x%Nlevels-1) = gbx%zlev_half(1,2:x%Nlevels)
576	x%mzu(x%Nlevels) = gbx%zlev(1,x%Nlevels) + (gbx%zlev(1,x%Nlevels) - x%mzl(x%Nlevels))
577
578	if (use_vgrid) then
579	! --- Initialise to zero ---
580	x%z = 0.0
581	x%zl = 0.0
582	x%zu = 0.0
583	if (cloudsat) then ! --- CloudSat grid requested ---
584	zstep = 480.0
585	else
586	! Other grid requested. Constant vertical spacing with top at 20 km
587	zstep = 20000.0/x%Nlvgrid
588	endif
589	do i=1,x%Nlvgrid
590	x%zl(i) = (i-1)*zstep
591	x%zu(i) = i*zstep
592	enddo
593	x%z = (x%zl + x%zu)/2.0
594	else
595	x%z = x%mz
596	x%zl = x%mzl
597	x%zu = x%mzu
598	endif
599
600	END SUBROUTINE CONSTRUCT_COSP_VGRID
601
602	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
603	!------------------ SUBROUTINE FREE_COSP_VGRID ------------------
604	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
605	SUBROUTINE FREE_COSP_VGRID(x)
606	type(cosp_vgrid),intent(inout) :: x
607
608	deallocate(x%z, x%zl, x%zu, x%mz, x%mzl, x%mzu)
609	END SUBROUTINE FREE_COSP_VGRID
610
611	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
612	!------------- SUBROUTINE CONSTRUCT_COSP_SGLIDAR ------------------
613	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
614	SUBROUTINE CONSTRUCT_COSP_SGLIDAR(cfg,Npoints,Ncolumns,Nlevels,Nhydro,Nrefl,x)
615	type(cosp_config),intent(in) :: cfg ! Configuration options
616	integer,intent(in) :: Npoints ! Number of sampled points
617	integer,intent(in) :: Ncolumns ! Number of subgrid columns
618	integer,intent(in) :: Nlevels ! Number of model levels
619	integer,intent(in) :: Nhydro ! Number of hydrometeors
620	integer,intent(in) :: Nrefl ! Number of parasol reflectances ! parasol
621	type(cosp_sglidar),intent(out) :: x
622	! Local variables
623	integer :: i,j,k,l,m
624
625	! Allocate minumum storage if simulator not used
626	if (cfg%Llidar_sim) then
627	i = Npoints
628	j = Ncolumns
629	k = Nlevels
630	l = Nhydro
631	m = Nrefl
632	else
633	i = 1
634	j = 1
635	k = 1
636	l = 1
637	m = 1
638	endif
639
640	! Dimensions
641	x%Npoints = i
642	x%Ncolumns = j
643	x%Nlevels = k
644	x%Nhydro = l
645	x%Nrefl = m
646
647	! --- Allocate arrays ---
648	allocate(x%beta_mol(i,k), x%beta_tot(i,j,k), &
649	x%tau_tot(i,j,k),x%refl(i,j,m), &
650	x%temp_tot(i,k),x%betaperp_tot(i,j,k))
651	! --- Initialise to zero ---
652	x%beta_mol = 0.0
653	x%beta_tot = 0.0
654	x%tau_tot = 0.0
655	x%refl = 0.0 ! parasol
656	x%temp_tot = 0.0
657	x%betaperp_tot = 0.0
658	END SUBROUTINE CONSTRUCT_COSP_SGLIDAR
659
660	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
661	!------------------ SUBROUTINE FREE_COSP_SGLIDAR ------------------
662	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
663	SUBROUTINE FREE_COSP_SGLIDAR(x)
664	type(cosp_sglidar),intent(inout) :: x
665
666	deallocate(x%beta_mol, x%beta_tot, x%tau_tot, x%refl, &
667	x%temp_tot, x%betaperp_tot)
668
669	END SUBROUTINE FREE_COSP_SGLIDAR
670
671	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
672	!------------- SUBROUTINE CONSTRUCT_COSP_SGRADAR ------------------
673	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
674	SUBROUTINE CONSTRUCT_COSP_SGRADAR(cfg,Npoints,Ncolumns,Nlevels,Nhydro,x)
675	type(cosp_config),intent(in) :: cfg ! Configuration options
676	integer,intent(in) :: Npoints ! Number of sampled points
677	integer,intent(in) :: Ncolumns ! Number of subgrid columns
678	integer,intent(in) :: Nlevels ! Number of model levels
679	integer,intent(in) :: Nhydro ! Number of hydrometeors
680	type(cosp_sgradar),intent(out) :: x
681	! Local variables
682	integer :: i,j,k,l
683
684	if (cfg%Lradar_sim) then
685	i = Npoints
686	j = Ncolumns
687	k = Nlevels
688	l = Nhydro
689	else ! Allocate minumum storage if simulator not used
690	i = 1
691	j = 1
692	k = 1
693	l = 1
694	endif
695
696	! Dimensions
697	x%Npoints = i
698	x%Ncolumns = j
699	x%Nlevels = k
700	x%Nhydro = l
701
702	! --- Allocate arrays ---
703	allocate(x%att_gas(i,k), x%Ze_tot(i,j,k))
704	! --- Initialise to zero ---
705	x%att_gas = 0.0
706	x%Ze_tot = 0.0
707	! The following line give a compilation error on the Met Office NEC
708	! call zero_real(x%Z_hydro, x%att_hydro)
709	! f90: error(666): cosp_types.f90, line nnn:
710	! Actual argument corresponding to dummy
711	! argument of ELEMENTAL subroutine
712	! "zero_real" with INTENET(OUT) attribute
713	! is not array.
714	END SUBROUTINE CONSTRUCT_COSP_SGRADAR
715
716	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
717	!------------------ SUBROUTINE FREE_COSP_SGRADAR ----------------
718	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
719	SUBROUTINE FREE_COSP_SGRADAR(x)
720	type(cosp_sgradar),intent(inout) :: x
721
722	deallocate(x%att_gas, x%Ze_tot)
723	END SUBROUTINE FREE_COSP_SGRADAR
724
725	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
726	!----------- SUBROUTINE CONSTRUCT_COSP_RADARSTATS ---------------
727	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
728	SUBROUTINE CONSTRUCT_COSP_RADARSTATS(cfg,Npoints,Ncolumns,Nlevels,Nhydro,x)
729	type(cosp_config),intent(in) :: cfg ! Configuration options
730	integer,intent(in) :: Npoints ! Number of sampled points
731	integer,intent(in) :: Ncolumns ! Number of subgrid columns
732	integer,intent(in) :: Nlevels ! Number of model levels
733	integer,intent(in) :: Nhydro ! Number of hydrometeors
734	type(cosp_radarstats),intent(out) :: x
735	! Local variables
736	integer :: i,j,k,l
737
738	! Allocate minumum storage if simulator not used
739	if (cfg%Lradar_sim) then
740	i = Npoints
741	j = Ncolumns
742	k = Nlevels
743	l = Nhydro
744	else
745	i = 1
746	j = 1
747	k = 1
748	l = 1
749	endif
750
751	! Dimensions
752	x%Npoints = i
753	x%Ncolumns = j
754	x%Nlevels = k
755	x%Nhydro = l
756
757	! --- Allocate arrays ---
758	allocate(x%cfad_ze(i,DBZE_BINS,k),x%lidar_only_freq_cloud(i,k))
759	allocate(x%radar_lidar_tcc(i))
760	! --- Initialise to zero ---
761	x%cfad_ze = 0.0
762	x%lidar_only_freq_cloud = 0.0
763	x%radar_lidar_tcc = 0.0
764	END SUBROUTINE CONSTRUCT_COSP_RADARSTATS
765
766	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
767	!------------------ SUBROUTINE FREE_COSP_RADARSTATS -------------
768	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
769	SUBROUTINE FREE_COSP_RADARSTATS(x)
770	type(cosp_radarstats),intent(inout) :: x
771
772	deallocate(x%cfad_ze,x%lidar_only_freq_cloud,x%radar_lidar_tcc)
773	END SUBROUTINE FREE_COSP_RADARSTATS
774
775	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
776	!----------- SUBROUTINE CONSTRUCT_COSP_LIDARSTATS ---------------
777	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
778	SUBROUTINE CONSTRUCT_COSP_LIDARSTATS(cfg,Npoints,Ncolumns,Nlevels,Nhydro,Nrefl,x)
779	type(cosp_config),intent(in) :: cfg ! Configuration options
780	integer,intent(in) :: Npoints ! Number of sampled points
781	integer,intent(in) :: Ncolumns ! Number of subgrid columns
782	integer,intent(in) :: Nlevels ! Number of model levels
783	integer,intent(in) :: Nhydro ! Number of hydrometeors
784	integer,intent(in) :: Nrefl ! Number of parasol reflectance
785	type(cosp_lidarstats),intent(out) :: x
786	! Local variables
787	integer :: i,j,k,l,m
788
789	! Allocate minumum storage if simulator not used
790	if (cfg%Llidar_sim) then
791	i = Npoints
792	j = Ncolumns
793	k = Nlevels
794	l = Nhydro
795	m = Nrefl
796	else
797	i = 1
798	j = 1
799	k = 1
800	l = 1
801	m = 1
802	endif
803
804	! Dimensions
805	x%Npoints = i
806	x%Ncolumns = j
807	x%Nlevels = k
808	x%Nhydro = l
809	x%Nrefl = m
810
811	! --- Allocate arrays ---
812	allocate(x%srbval(SR_BINS),x%cfad_sr(i,SR_BINS,k), &
813	x%lidarcld(i,k), x%cldlayer(i,LIDAR_NCAT), x%parasolrefl(i,m))
814	allocate(x%lidarcldphase(i,k,6),x%lidarcldtmp(i,LIDAR_NTEMP,5),&
815	x%cldlayerphase(i,LIDAR_NCAT,6))
816	allocate(x%lidarcldtype(i,k,LIDAR_NTYPE+1),x%cldtype(i,LIDAR_NTYPE)) !OPAQ
817	! allocate(x%profSR(i,j,k),x%proftemp(i,k)) !TIBO
818	allocate(x%profSR(i,k,j),x%proftemp(i,k)) !TIBO2
819	! --- Initialise to zero ---
820	x%srbval = 0.0
821	x%cfad_sr = 0.0
822	x%lidarcld = 0.0
823	x%cldlayer = 0.0
824	x%parasolrefl = 0.0
825	x%lidarcldphase = 0.0
826	x%cldlayerphase = 0.0
827	x%lidarcldtmp = 0.0
828	x%lidarcldtype = 0.0 !OPAQ
829	x%cldtype = 0.0 !OPAQ
830	x%profSR = 0.0 !TIBO
831	x%proftemp = 0.0 !TIBO
832
833	END SUBROUTINE CONSTRUCT_COSP_LIDARSTATS
834
835	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
836	!------------------ SUBROUTINE FREE_COSP_LIDARSTATS -------------
837	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
838	SUBROUTINE FREE_COSP_LIDARSTATS(x)
839	type(cosp_lidarstats),intent(inout) :: x
840
841	deallocate(x%srbval, x%cfad_sr, x%lidarcld, x%cldlayer, x%parasolrefl)
842	deallocate(x%cldlayerphase, x%lidarcldtmp, x%lidarcldphase)
843	deallocate(x%lidarcldtype, x%cldtype) !OPAQ
844	deallocate(x%profSR, x%proftemp) !TIBO
845	END SUBROUTINE FREE_COSP_LIDARSTATS
846
847
848	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
849	!------------- SUBROUTINE CONSTRUCT_COSP_SUBGRID ------------------
850	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
851	SUBROUTINE CONSTRUCT_COSP_SUBGRID(Npoints,Ncolumns,Nlevels,y)
852	integer,intent(in) :: Npoints, & ! Number of gridpoints
853	Ncolumns, & ! Number of columns
854	Nlevels ! Number of levels
855	type(cosp_subgrid),intent(out) :: y
856
857	! Dimensions
858	y%Npoints = Npoints
859	y%Ncolumns = Ncolumns
860	y%Nlevels = Nlevels
861
862	! --- Allocate arrays ---
863	allocate(y%frac_out(Npoints,Ncolumns,Nlevels))
864	if (Ncolumns > 1) then
865	allocate(y%prec_frac(Npoints,Ncolumns,Nlevels))
866	else ! CRM mode, not needed
867	allocate(y%prec_frac(1,1,1))
868	endif
869	! --- Initialise to zero ---
870	y%prec_frac = 0.0
871	y%frac_out = 0.0
872	! The following line gives a compilation error on the Met Office NEC
873	! call zero_real(y%mr_hydro)
874	! f90: error(666): cosp_types.f90, line nnn:
875	! Actual argument corresponding to dummy
876	! argument of ELEMENTAL subroutine
877	! "zero_real" with INTENET(OUT) attribute
878	! is not array.
879
880	END SUBROUTINE CONSTRUCT_COSP_SUBGRID
881
882	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
883	!------------- SUBROUTINE FREE_COSP_SUBGRID -----------------------
884	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
885	SUBROUTINE FREE_COSP_SUBGRID(y)
886	type(cosp_subgrid),intent(inout) :: y
887
888	! --- Deallocate arrays ---
889	deallocate(y%prec_frac, y%frac_out)
890
891	END SUBROUTINE FREE_COSP_SUBGRID
892
893	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
894	!------------- SUBROUTINE CONSTRUCT_COSP_SGHYDRO -----------------
895	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
896	SUBROUTINE CONSTRUCT_COSP_SGHYDRO(Npoints,Ncolumns,Nlevels,Nhydro,y)
897	integer,intent(in) :: Npoints, & ! Number of gridpoints
898	Ncolumns, & ! Number of columns
899	Nhydro, & ! Number of hydrometeors
900	Nlevels ! Number of levels
901	type(cosp_sghydro),intent(out) :: y
902
903	! Dimensions
904	y%Npoints = Npoints
905	y%Ncolumns = Ncolumns
906	y%Nlevels = Nlevels
907	y%Nhydro = Nhydro
908
909	! --- Allocate arrays ---
910	allocate(y%mr_hydro(Npoints,Ncolumns,Nlevels,Nhydro), &
911	y%Reff(Npoints,Ncolumns,Nlevels,Nhydro), &
912	y%Np(Npoints,Ncolumns,Nlevels,Nhydro)) ! added by roj with Quickbeam V3
913
914	! --- Initialise to zero ---
915	y%mr_hydro = 0.0
916	y%Reff = 0.0
917	y%Np = 0.0 ! added by roj with Quickbeam V3
918
919	END SUBROUTINE CONSTRUCT_COSP_SGHYDRO
920
921	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
922	!------------- SUBROUTINE FREE_COSP_SGHYDRO -----------------------
923	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
924	SUBROUTINE FREE_COSP_SGHYDRO(y)
925	type(cosp_sghydro),intent(inout) :: y
926
927	! --- Deallocate arrays ---
928	deallocate(y%mr_hydro, y%Reff, y%Np) ! added by Roj with Quickbeam V3
929
930	END SUBROUTINE FREE_COSP_SGHYDRO
931
932	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
933	!------------- SUBROUTINE CONSTRUCT_COSP_GRIDBOX ------------------
934	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
935	SUBROUTINE CONSTRUCT_COSP_GRIDBOX(time,time_bnds,radar_freq,surface_radar,use_mie_tables,use_gas_abs,do_ray,melt_lay,k2, &
936	Npoints,Nlevels,Ncolumns,Nhydro,Nprmts_max_hydro,Naero,Nprmts_max_aero,Npoints_it, &
937	lidar_ice_type,isccp_top_height,isccp_top_height_direction,isccp_overlap,isccp_emsfc_lw, &
938	use_precipitation_fluxes,use_reff, &
939	! RTTOV inputs
940	Plat,Sat,Inst,Nchan,ZenAng,Ichan,SurfEm,co2,ch4,n2o,co,&
941	y,load_LUT)
942	double precision,intent(in) :: time ! Time since start of run [days]
943	double precision,intent(in) :: time_bnds(2) ! Time boundaries
944	real,intent(in) :: radar_freq, & ! Radar frequency [GHz]
945	k2 ! \|K\|^2, -1=use frequency dependent default
946	integer,intent(in) :: &
947	surface_radar, & ! surface=1,spaceborne=0
948	use_mie_tables, & ! use a precomputed lookup table? yes=1,no=0,2=use first column everywhere
949	use_gas_abs, & ! include gaseous absorption? yes=1,no=0
950	do_ray, & ! calculate/output Rayleigh refl=1, not=0
951	melt_lay ! melting layer model off=0, on=1
952	integer,intent(in) :: Npoints ! Number of gridpoints
953	integer,intent(in) :: Nlevels ! Number of levels
954	integer,intent(in) :: Ncolumns ! Number of columns
955	integer,intent(in) :: Nhydro ! Number of hydrometeors
956	integer,intent(in) :: Nprmts_max_hydro ! Max number of parameters for hydrometeor size distributions
957	integer,intent(in) :: Naero ! Number of aerosol species
958	integer,intent(in) :: Nprmts_max_aero ! Max number of parameters for aerosol size distributions
959	integer,intent(in) :: Npoints_it ! Number of gridpoints processed in one iteration
960	integer,intent(in) :: lidar_ice_type ! Ice particle shape in lidar calculations (0=ice-spheres ; 1=ice-non-spherical)
961	integer,intent(in) :: isccp_top_height
962	integer,intent(in) :: isccp_top_height_direction
963	integer,intent(in) :: isccp_overlap
964	real,intent(in) :: isccp_emsfc_lw
965	logical,intent(in) :: use_precipitation_fluxes,use_reff
966	integer,intent(in) :: Plat
967	integer,intent(in) :: Sat
968	integer,intent(in) :: Inst
969	integer,intent(in) :: Nchan
970	integer,intent(in) :: Ichan(Nchan)
971	real,intent(in) :: SurfEm(Nchan)
972	real,intent(in) :: ZenAng
973	real,intent(in) :: co2,ch4,n2o,co
974	type(cosp_gridbox),intent(out) :: y
975	logical,intent(in),optional :: load_LUT
976
977
978	! local variables
979	character*240 :: LUT_file_name
980	logical :: local_load_LUT
981
982	if (present(load_LUT)) then
983	local_load_LUT = load_LUT
984	else
985	local_load_LUT = RADAR_SIM_LOAD_scale_LUTs_flag
986	endif
987
988	! Dimensions and scalars
989	y%radar_freq = radar_freq
990	y%surface_radar = surface_radar
991	y%use_mie_tables = use_mie_tables
992	y%use_gas_abs = use_gas_abs
993	y%do_ray = do_ray
994	y%melt_lay = melt_lay
995	y%k2 = k2
996	y%Npoints = Npoints
997	y%Nlevels = Nlevels
998	y%Ncolumns = Ncolumns
999	y%Nhydro = Nhydro
1000	y%Nprmts_max_hydro = Nprmts_max_hydro
1001	y%Naero = Naero
1002	y%Nprmts_max_aero = Nprmts_max_aero
1003	y%Npoints_it = Npoints_it
1004	y%lidar_ice_type = lidar_ice_type
1005	y%isccp_top_height = isccp_top_height
1006	y%isccp_top_height_direction = isccp_top_height_direction
1007	y%isccp_overlap = isccp_overlap
1008	y%isccp_emsfc_lw = isccp_emsfc_lw
1009	y%use_precipitation_fluxes = use_precipitation_fluxes
1010	y%use_reff = use_reff
1011
1012	y%time = time
1013	y%time_bnds = time_bnds
1014
1015	! RTTOV parameters
1016	y%Plat = Plat
1017	y%Sat = Sat
1018	y%Inst = Inst
1019	y%Nchan = Nchan
1020	y%ZenAng = ZenAng
1021	y%co2 = co2
1022	y%ch4 = ch4
1023	y%n2o = n2o
1024	y%co = co
1025
1026	! --- Allocate arrays ---
1027	! Gridbox information (Npoints,Nlevels)
1028	allocate(y%zlev(Npoints,Nlevels), y%zlev_half(Npoints,Nlevels), y%dlev(Npoints,Nlevels), &
1029	y%p(Npoints,Nlevels), y%ph(Npoints,Nlevels), y%T(Npoints,Nlevels), &
1030	y%q(Npoints,Nlevels), y%sh(Npoints,Nlevels), &
1031	y%dtau_s(Npoints,Nlevels), y%dtau_c(Npoints,Nlevels), &
1032	y%dem_s(Npoints,Nlevels), y%dem_c(Npoints,Nlevels), &
1033	y%tca(Npoints,Nlevels), y%cca(Npoints,Nlevels), &
1034	y%rain_ls(Npoints,Nlevels), y%rain_cv(Npoints,Nlevels), y%grpl_ls(Npoints,Nlevels), &
1035	y%snow_ls(Npoints,Nlevels), y%snow_cv(Npoints,Nlevels),y%mr_ozone(Npoints,Nlevels))
1036
1037
1038	! Surface information and geolocation (Npoints)
1039	allocate(y%toffset(Npoints), y%longitude(Npoints),y%latitude(Npoints),y%psfc(Npoints), y%land(Npoints), &
1040	y%sunlit(Npoints),y%skt(Npoints),y%u_wind(Npoints),y%v_wind(Npoints))
1041	! Hydrometeors concentration and distribution parameters
1042	allocate(y%mr_hydro(Npoints,Nlevels,Nhydro), &
1043	y%dist_prmts_hydro(Nprmts_max_hydro,Nhydro), &
1044	y%Reff(Npoints,Nlevels,Nhydro), &
1045	y%Np(Npoints,Nlevels,Nhydro)) ! added by Roj with Quickbeam V3
1046	! Aerosols concentration and distribution parameters
1047	allocate(y%conc_aero(Npoints,Nlevels,Naero), y%dist_type_aero(Naero), &
1048	y%dist_prmts_aero(Npoints,Nlevels,Nprmts_max_aero,Naero))
1049
1050	! RTTOV channels and sfc. emissivity
1051	allocate(y%ichan(Nchan),y%surfem(Nchan))
1052
1053	! RTTOV parameters
1054	y%ichan = ichan
1055	y%surfem = surfem
1056
1057	! --- Initialise to zero ---
1058	y%zlev = 0.0
1059	y%zlev_half = 0.0
1060	y%dlev = 0.0
1061	y%p = 0.0
1062	y%ph = 0.0
1063	y%T = 0.0
1064	y%q = 0.0
1065	y%sh = 0.0
1066	y%dtau_s = 0.0
1067	y%dtau_c = 0.0
1068	y%dem_s = 0.0
1069	y%dem_c = 0.0
1070	y%tca = 0.0
1071	y%cca = 0.0
1072	y%rain_ls = 0.0
1073	y%rain_cv = 0.0
1074	y%grpl_ls = 0.0
1075	y%snow_ls = 0.0
1076	y%snow_cv = 0.0
1077	y%Reff = 0.0
1078	y%Np = 0.0 ! added by Roj with Quickbeam V3
1079	y%mr_ozone = 0.0
1080	y%u_wind = 0.0
1081	y%v_wind = 0.0
1082
1083
1084	! (Npoints)
1085	y%toffset = 0.0
1086	y%longitude = 0.0
1087	y%latitude = 0.0
1088	y%psfc = 0.0
1089	y%land = 0.0
1090	y%sunlit = 0.0
1091	y%skt = 0.0
1092	! (Npoints,Nlevels,Nhydro)
1093	! y%fr_hydro = 0.0
1094	y%mr_hydro = 0.0
1095	! Others
1096	y%dist_prmts_hydro = 0.0 ! (Nprmts_max_hydro,Nhydro)
1097	y%conc_aero = 0.0 ! (Npoints,Nlevels,Naero)
1098	y%dist_type_aero = 0 ! (Naero)
1099	y%dist_prmts_aero = 0.0 ! (Npoints,Nlevels,Nprmts_max_aero,Naero)
1100
1101
1102	! NOTE: This location use to contain initialization of some radar simulator variables
1103	! this initialization (including use of the variable "dist_prmts_hydro" - now obselete)
1104	! has been unified in the quickbeam v3 subroutine "radar_simulator_init". Roj, June 2010
1105
1106	! --- Initialize the distributional parameters for hydrometeors in radar simulator
1107
1108	write(,) 'RADAR_SIM microphysics scheme is set to: ', &
1109	trim(RADAR_SIM_MICROPHYSICS_SCHEME_NAME)
1110
1111
1112	if(y%Nhydro.ne.N_HYDRO) then
1113
1114	write(,) 'Number of hydrometeor input to subroutine', &
1115	' CONSTRUCT_COSP_GRIDBOX does not match value', &
1116	' specified in cosp_constants.f90!'
1117	write(,)
1118	endif
1119
1120	! NOTE: SAVE_scale_LUTs_flag is hard codded as .false. here
1121	! so that radar simulator will NOT update LUT each time it
1122	! is called, but rather will update when "Free_COSP_GRIDBOX" is called!
1123	! Roj, June 2010
1124
1125	LUT_file_name = trim(RADAR_SIM_LUT_DIRECTORY) // &
1126	trim(RADAR_SIM_MICROPHYSICS_SCHEME_NAME)
1127
1128	call radar_simulator_init(radar_freq,k2, &
1129	use_gas_abs,do_ray,R_UNDEF, &
1130	y%Nhydro, &
1131	HCLASS_TYPE,HCLASS_PHASE, &
1132	HCLASS_DMIN,HCLASS_DMAX, &
1133	HCLASS_APM,HCLASS_BPM,HCLASS_RHO, &
1134	HCLASS_P1,HCLASS_P2,HCLASS_P3, &
1135	local_load_LUT, &
1136	.false., &
1137	LUT_file_name, &
1138	y%hp)
1139
1140	END SUBROUTINE CONSTRUCT_COSP_GRIDBOX
1141
1142
1143	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1144	!------------- SUBROUTINE FREE_COSP_GRIDBOX -----------------------
1145	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1146	SUBROUTINE FREE_COSP_GRIDBOX(y,dglobal,save_LUT)
1147
1148	use scale_LUTs_io
1149
1150	type(cosp_gridbox),intent(inout) :: y
1151	logical,intent(in),optional :: dglobal
1152	logical,intent(in),optional :: save_LUT
1153
1154	logical :: local_save_LUT
1155
1156	if (present(save_LUT)) then
1157	local_save_LUT = save_LUT
1158	else
1159	local_save_LUT = RADAR_SIM_UPDATE_scale_LUTs_flag
1160	endif
1161
1162	! save any updates to radar simulator LUT
1163	if (local_save_LUT) call save_scale_LUTs(y%hp)
1164
1165	deallocate(y%zlev, y%zlev_half, y%dlev, y%p, y%ph, y%T, y%q, &
1166	y%sh, y%dtau_s, y%dtau_c, y%dem_s, y%dem_c, &
1167	y%toffset, y%longitude,y%latitude,y%psfc, y%land, y%tca, y%cca, &
1168	y%mr_hydro, y%dist_prmts_hydro, &
1169	y%conc_aero, y%dist_type_aero, y%dist_prmts_aero, &
1170	y%rain_ls, y%rain_cv, y%snow_ls, y%snow_cv, y%grpl_ls, &
1171	y%sunlit, y%skt, y%Reff,y%Np, &
1172	y%ichan,y%surfem, &
1173	y%mr_ozone,y%u_wind,y%v_wind)
1174
1175	END SUBROUTINE FREE_COSP_GRIDBOX
1176
1177	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1178	!------------- SUBROUTINE COSP_GRIDBOX_CPHP ----------------------
1179	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1180	SUBROUTINE COSP_GRIDBOX_CPHP(x,y)
1181	type(cosp_gridbox),intent(in) :: x
1182	type(cosp_gridbox),intent(inout) :: y
1183
1184	integer :: i,j,k,sz(3)
1185	double precision :: tny
1186
1187	tny = tiny(tny)
1188	y%hp%p1 = x%hp%p1
1189	y%hp%p2 = x%hp%p2
1190	y%hp%p3 = x%hp%p3
1191	y%hp%dmin = x%hp%dmin
1192	y%hp%dmax = x%hp%dmax
1193	y%hp%apm = x%hp%apm
1194	y%hp%bpm = x%hp%bpm
1195	y%hp%rho = x%hp%rho
1196	y%hp%dtype = x%hp%dtype
1197	y%hp%col = x%hp%col
1198	y%hp%cp = x%hp%cp
1199	y%hp%phase = x%hp%phase
1200
1201	y%hp%fc = x%hp%fc
1202	y%hp%rho_eff = x%hp%rho_eff
1203	! y%hp%ifc = x%hp%ifc obsolete, Roj, June 2010
1204	! y%hp%idd = x%hp%idd
1205	sz = shape(x%hp%Z_scale_flag)
1206	do k=1,sz(3)
1207	do j=1,sz(2)
1208	do i=1,sz(1)
1209	if (x%hp%N_scale_flag(i,k)) y%hp%N_scale_flag(i,k) = .true.
1210	if (x%hp%Z_scale_flag(i,j,k)) y%hp%Z_scale_flag(i,j,k) = .true.
1211	if (abs(x%hp%Ze_scaled(i,j,k)) > tny) y%hp%Ze_scaled(i,j,k) = x%hp%Ze_scaled(i,j,k)
1212	if (abs(x%hp%Zr_scaled(i,j,k)) > tny) y%hp%Zr_scaled(i,j,k) = x%hp%Zr_scaled(i,j,k)
1213	if (abs(x%hp%kr_scaled(i,j,k)) > tny) y%hp%kr_scaled(i,j,k) = x%hp%kr_scaled(i,j,k)
1214	enddo
1215	enddo
1216	enddo
1217
1218	END SUBROUTINE COSP_GRIDBOX_CPHP
1219
1220	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1221	!------------- SUBROUTINE COSP_GRIDBOX_CPSECTION -----------------
1222	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1223	SUBROUTINE COSP_GRIDBOX_CPSECTION(ix,iy,x,y)
1224	integer,intent(in),dimension(2) :: ix,iy
1225	type(cosp_gridbox),intent(in) :: x
1226	type(cosp_gridbox),intent(inout) :: y
1227
1228	! --- Copy arrays without Npoints as dimension ---
1229	y%dist_prmts_hydro = x%dist_prmts_hydro
1230	y%dist_type_aero = x%dist_type_aero
1231
1232
1233	! call cosp_gridbox_cphp(x,y)
1234
1235	! 1D
1236	y%longitude(iy(1):iy(2)) = x%longitude(ix(1):ix(2))
1237	y%latitude(iy(1):iy(2)) = x%latitude(ix(1):ix(2))
1238	y%psfc(iy(1):iy(2)) = x%psfc(ix(1):ix(2))
1239	y%land(iy(1):iy(2)) = x%land(ix(1):ix(2))
1240	y%sunlit(iy(1):iy(2)) = x%sunlit(ix(1):ix(2))
1241	y%skt(iy(1):iy(2)) = x%skt(ix(1):ix(2))
1242	y%u_wind(iy(1):iy(2)) = x%u_wind(ix(1):ix(2))
1243	y%v_wind(iy(1):iy(2)) = x%v_wind(ix(1):ix(2))
1244	! 2D
1245	y%zlev(iy(1):iy(2),:) = x%zlev(ix(1):ix(2),:)
1246	y%zlev_half(iy(1):iy(2),:) = x%zlev_half(ix(1):ix(2),:)
1247	y%dlev(iy(1):iy(2),:) = x%dlev(ix(1):ix(2),:)
1248	y%p(iy(1):iy(2),:) = x%p(ix(1):ix(2),:)
1249	y%ph(iy(1):iy(2),:) = x%ph(ix(1):ix(2),:)
1250	y%T(iy(1):iy(2),:) = x%T(ix(1):ix(2),:)
1251	y%q(iy(1):iy(2),:) = x%q(ix(1):ix(2),:)
1252	y%sh(iy(1):iy(2),:) = x%sh(ix(1):ix(2),:)
1253	y%dtau_s(iy(1):iy(2),:) = x%dtau_s(ix(1):ix(2),:)
1254	y%dtau_c(iy(1):iy(2),:) = x%dtau_c(ix(1):ix(2),:)
1255	y%dem_s(iy(1):iy(2),:) = x%dem_s(ix(1):ix(2),:)
1256	y%dem_c(iy(1):iy(2),:) = x%dem_c(ix(1):ix(2),:)
1257	y%tca(iy(1):iy(2),:) = x%tca(ix(1):ix(2),:)
1258	y%cca(iy(1):iy(2),:) = x%cca(ix(1):ix(2),:)
1259	y%rain_ls(iy(1):iy(2),:) = x%rain_ls(ix(1):ix(2),:)
1260	y%rain_cv(iy(1):iy(2),:) = x%rain_cv(ix(1):ix(2),:)
1261	y%grpl_ls(iy(1):iy(2),:) = x%grpl_ls(ix(1):ix(2),:)
1262	y%snow_ls(iy(1):iy(2),:) = x%snow_ls(ix(1):ix(2),:)
1263	y%snow_cv(iy(1):iy(2),:) = x%snow_cv(ix(1):ix(2),:)
1264	y%mr_ozone(iy(1):iy(2),:) = x%mr_ozone(ix(1):ix(2),:)
1265	! 3D
1266	y%Reff(iy(1):iy(2),:,:) = x%Reff(ix(1):ix(2),:,:)
1267	y%Np(iy(1):iy(2),:,:) = x%Np(ix(1):ix(2),:,:) ! added by Roj with Quickbeam V3
1268	y%conc_aero(iy(1):iy(2),:,:) = x%conc_aero(ix(1):ix(2),:,:)
1269	y%mr_hydro(iy(1):iy(2),:,:) = x%mr_hydro(ix(1):ix(2),:,:)
1270	! 4D
1271	y%dist_prmts_aero(iy(1):iy(2),:,:,:) = x%dist_prmts_aero(ix(1):ix(2),:,:,:)
1272
1273	END SUBROUTINE COSP_GRIDBOX_CPSECTION
1274
1275	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1276	!------------- SUBROUTINE COSP_SUBGRID_CPSECTION -----------------
1277	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1278	SUBROUTINE COSP_SUBGRID_CPSECTION(ix,iy,x,y)
1279	integer,intent(in),dimension(2) :: ix,iy
1280	type(cosp_subgrid),intent(in) :: x
1281	type(cosp_subgrid),intent(inout) :: y
1282
1283	y%prec_frac(iy(1):iy(2),:,:) = x%prec_frac(ix(1):ix(2),:,:)
1284	y%frac_out(iy(1):iy(2),:,:) = x%frac_out(ix(1):ix(2),:,:)
1285	END SUBROUTINE COSP_SUBGRID_CPSECTION
1286
1287	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1288	!------------- SUBROUTINE COSP_SGRADAR_CPSECTION -----------------
1289	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1290	SUBROUTINE COSP_SGRADAR_CPSECTION(ix,iy,x,y)
1291	integer,intent(in),dimension(2) :: ix,iy
1292	type(cosp_sgradar),intent(in) :: x
1293	type(cosp_sgradar),intent(inout) :: y
1294
1295	y%att_gas(iy(1):iy(2),:) = x%att_gas(ix(1):ix(2),:)
1296	y%Ze_tot(iy(1):iy(2),:,:) = x%Ze_tot(ix(1):ix(2),:,:)
1297	END SUBROUTINE COSP_SGRADAR_CPSECTION
1298
1299	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1300	!------------- SUBROUTINE COSP_SGLIDAR_CPSECTION -----------------
1301	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1302	SUBROUTINE COSP_SGLIDAR_CPSECTION(ix,iy,x,y)
1303	integer,intent(in),dimension(2) :: ix,iy
1304	type(cosp_sglidar),intent(in) :: x
1305	type(cosp_sglidar),intent(inout) :: y
1306
1307	y%temp_tot(iy(1):iy(2),:) = x%temp_tot(ix(1):ix(2),:)
1308	y%betaperp_tot(iy(1):iy(2),:,:) = x%betaperp_tot(ix(1):ix(2),:,:)
1309	y%beta_mol(iy(1):iy(2),:) = x%beta_mol(ix(1):ix(2),:)
1310	y%beta_tot(iy(1):iy(2),:,:) = x%beta_tot(ix(1):ix(2),:,:)
1311	y%tau_tot(iy(1):iy(2),:,:) = x%tau_tot(ix(1):ix(2),:,:)
1312	y%refl(iy(1):iy(2),:,:) = x%refl(ix(1):ix(2),:,:)
1313	END SUBROUTINE COSP_SGLIDAR_CPSECTION
1314
1315	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1316	!------------- SUBROUTINE COSP_ISCCP_CPSECTION -----------------
1317	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1318	SUBROUTINE COSP_ISCCP_CPSECTION(ix,iy,x,y)
1319	integer,intent(in),dimension(2) :: ix,iy
1320	type(cosp_isccp),intent(in) :: x
1321	type(cosp_isccp),intent(inout) :: y
1322
1323	y%fq_isccp(iy(1):iy(2),:,:) = x%fq_isccp(ix(1):ix(2),:,:)
1324	y%totalcldarea(iy(1):iy(2)) = x%totalcldarea(ix(1):ix(2))
1325	y%meantb(iy(1):iy(2)) = x%meantb(ix(1):ix(2))
1326	y%meantbclr(iy(1):iy(2)) = x%meantbclr(ix(1):ix(2))
1327	y%meanptop(iy(1):iy(2)) = x%meanptop(ix(1):ix(2))
1328	y%meantaucld(iy(1):iy(2)) = x%meantaucld(ix(1):ix(2))
1329	y%meanalbedocld(iy(1):iy(2)) = x%meanalbedocld(ix(1):ix(2))
1330	y%boxtau(iy(1):iy(2),:) = x%boxtau(ix(1):ix(2),:)
1331	y%boxptop(iy(1):iy(2),:) = x%boxptop(ix(1):ix(2),:)
1332	END SUBROUTINE COSP_ISCCP_CPSECTION
1333
1334
1335	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1336	!------------- SUBROUTINE COSP_MISR_CPSECTION -----------------
1337	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1338	SUBROUTINE COSP_MISR_CPSECTION(ix,iy,x,y)
1339	integer,intent(in),dimension(2) :: ix,iy
1340	type(cosp_misr),intent(in) :: x
1341	type(cosp_misr),intent(inout) :: y
1342
1343	y%fq_MISR(iy(1):iy(2),:,:) = x%fq_MISR(ix(1):ix(2),:,:)
1344	y%MISR_meanztop(iy(1):iy(2)) = x%MISR_meanztop(ix(1):ix(2))
1345	y%MISR_cldarea(iy(1):iy(2)) = x%MISR_cldarea(ix(1):ix(2))
1346	y%MISR_dist_model_layertops(iy(1):iy(2),:) = x%MISR_dist_model_layertops(ix(1):ix(2),:)
1347	END SUBROUTINE COSP_MISR_CPSECTION
1348
1349	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1350	!------------- SUBROUTINE COSP_RTTOV_CPSECTION -------------------
1351	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1352	SUBROUTINE COSP_RTTOV_CPSECTION(ix,iy,x,y)
1353	integer,intent(in),dimension(2) :: ix,iy
1354	type(cosp_rttov),intent(in) :: x
1355	type(cosp_rttov),intent(inout) :: y
1356
1357	y%tbs(iy(1):iy(2),:) = x%tbs(ix(1):ix(2),:)
1358	END SUBROUTINE COSP_RTTOV_CPSECTION
1359
1360	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1361	!------------- SUBROUTINE COSP_RADARSTATS_CPSECTION --------------
1362	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1363	SUBROUTINE COSP_RADARSTATS_CPSECTION(ix,iy,x,y)
1364	integer,intent(in),dimension(2) :: ix,iy
1365	type(cosp_radarstats),intent(in) :: x
1366	type(cosp_radarstats),intent(inout) :: y
1367
1368	y%cfad_ze(iy(1):iy(2),:,:) = x%cfad_ze(ix(1):ix(2),:,:)
1369	y%radar_lidar_tcc(iy(1):iy(2)) = x%radar_lidar_tcc(ix(1):ix(2))
1370	y%lidar_only_freq_cloud(iy(1):iy(2),:) = x%lidar_only_freq_cloud(ix(1):ix(2),:)
1371	END SUBROUTINE COSP_RADARSTATS_CPSECTION
1372
1373	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1374	!------------- SUBROUTINE COSP_LIDARSTATS_CPSECTION --------------
1375	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1376	SUBROUTINE COSP_LIDARSTATS_CPSECTION(ix,iy,x,y)
1377	integer,intent(in),dimension(2) :: ix,iy
1378	type(cosp_lidarstats),intent(in) :: x
1379	type(cosp_lidarstats),intent(inout) :: y
1380
1381	y%srbval = x%srbval
1382	y%cfad_sr(iy(1):iy(2),:,:) = x%cfad_sr(ix(1):ix(2),:,:)
1383	y%lidarcld(iy(1):iy(2),:) = x%lidarcld(ix(1):ix(2),:)
1384	y%cldlayer(iy(1):iy(2),:) = x%cldlayer(ix(1):ix(2),:)
1385	y%parasolrefl(iy(1):iy(2),:) = x%parasolrefl(ix(1):ix(2),:)
1386	y%lidarcldphase(iy(1):iy(2),:,:) = x%lidarcldphase(ix(1):ix(2),:,:)
1387	y%cldlayerphase(iy(1):iy(2),:,:) = x%cldlayerphase(ix(1):ix(2),:,:)
1388	y%lidarcldtmp(iy(1):iy(2),:,:) = x%lidarcldtmp(ix(1):ix(2),:,:)
1389	y%lidarcldtype(iy(1):iy(2),:,:) = x%lidarcldtype(ix(1):ix(2),:,:) !OPAQ
1390	y%cldtype(iy(1):iy(2),:) = x%cldtype(ix(1):ix(2),:) !OPAQ
1391	y%profSR(iy(1):iy(2),:,:) = x%profSR(ix(1):ix(2),:,:) !TIBO
1392	y%proftemp(iy(1):iy(2),:) = x%proftemp(ix(1):ix(2),:) !TIBO
1393	END SUBROUTINE COSP_LIDARSTATS_CPSECTION
1394	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1395	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1396	!------------- PRINT SUBROUTINES --------------
1397	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1398	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1399	SUBROUTINE COSP_GRIDBOX_PRINT(x)
1400	type(cosp_gridbox),intent(in) :: x
1401
1402	print *, '%%%%----- Information on COSP_GRIDBOX ------'
1403	! Scalars and dimensions
1404	print *, x%Npoints
1405	print *, x%Nlevels
1406	print *, x%Ncolumns
1407	print *, x%Nhydro
1408	print *, x%Nprmts_max_hydro
1409	print *, x%Naero
1410	print *, x%Nprmts_max_aero
1411	print *, x%Npoints_it
1412
1413	! Time [days]
1414	print *, x%time
1415
1416	! Radar ancillary info
1417	print *, x%radar_freq, &
1418	x%k2
1419	print *, x%surface_radar, &
1420	x%use_mie_tables, &
1421	x%use_gas_abs, &
1422	x%do_ray, &
1423	x%melt_lay
1424
1425	! print *, 'shape(x%): ',shape(x%)
1426
1427	! type(class_param) :: hp ! structure used by radar simulator to store Ze and N scaling constants and other information
1428	! type(mie):: mt ! structure used by radar simulator to store mie LUT information
1429	print *, x%nsizes
1430
1431	! Lidar
1432	print *, x%lidar_ice_type
1433
1434	! Radar
1435	print *, x%use_precipitation_fluxes
1436	print *, x%use_reff
1437
1438	! Geolocation (Npoints)
1439	print *, 'shape(x%longitude): ',shape(x%longitude)
1440	print *, 'shape(x%latitude): ',shape(x%latitude)
1441	! Gridbox information (Npoints,Nlevels)
1442	print *, 'shape(x%zlev): ',shape(x%zlev)
1443	print *, 'shape(x%zlev_half): ',shape(x%zlev_half)
1444	print *, 'shape(x%dlev): ',shape(x%dlev)
1445	print *, 'shape(x%p): ',shape(x%p)
1446	print *, 'shape(x%ph): ',shape(x%ph)
1447	print *, 'shape(x%T): ',shape(x%T)
1448	print *, 'shape(x%q): ',shape(x%q)
1449	print *, 'shape(x%sh): ',shape(x%sh)
1450	print *, 'shape(x%dtau_s): ',shape(x%dtau_s)
1451	print *, 'shape(x%dtau_c): ',shape(x%dtau_c)
1452	print *, 'shape(x%dem_s): ',shape(x%dem_s)
1453	print *, 'shape(x%dem_c): ',shape(x%dem_c)
1454	print *, 'shape(x%mr_ozone): ',shape(x%mr_ozone)
1455
1456	! Point information (Npoints)
1457	print *, 'shape(x%land): ',shape(x%land)
1458	print *, 'shape(x%psfc): ',shape(x%psfc)
1459	print *, 'shape(x%sunlit): ',shape(x%sunlit)
1460	print *, 'shape(x%skt): ',shape(x%skt)
1461	print *, 'shape(x%u_wind): ',shape(x%u_wind)
1462	print *, 'shape(x%v_wind): ',shape(x%v_wind)
1463
1464	! TOTAL and CONV cloud fraction for SCOPS
1465	print *, 'shape(x%tca): ',shape(x%tca)
1466	print *, 'shape(x%cca): ',shape(x%cca)
1467	! Precipitation fluxes on model levels
1468	print *, 'shape(x%rain_ls): ',shape(x%rain_ls)
1469	print *, 'shape(x%rain_cv): ',shape(x%rain_cv)
1470	print *, 'shape(x%snow_ls): ',shape(x%snow_ls)
1471	print *, 'shape(x%snow_cv): ',shape(x%snow_cv)
1472	print *, 'shape(x%grpl_ls): ',shape(x%grpl_ls)
1473	! Hydrometeors concentration and distribution parameters
1474	print *, 'shape(x%mr_hydro): ',shape(x%mr_hydro)
1475	print *, 'shape(x%dist_prmts_hydro): ',shape(x%dist_prmts_hydro)
1476	! Effective radius [m]. (Npoints,Nlevels,Nhydro)
1477	print *, 'shape(x%Reff): ',shape(x%Reff)
1478	print *, 'shape(x%Np): ',shape(x%Np) ! added by roj with Quickbeam V3
1479	! Aerosols concentration and distribution parameters
1480	print *, 'shape(x%conc_aero): ',shape(x%conc_aero)
1481	print *, 'shape(x%dist_type_aero): ',shape(x%dist_type_aero)
1482	print *, 'shape(x%dist_prmts_aero): ',shape(x%dist_prmts_aero)
1483	! ISCCP simulator inputs
1484	print *, x%isccp_top_height
1485	print *, x%isccp_top_height_direction
1486	print *, x%isccp_overlap
1487	print *, x%isccp_emsfc_lw
1488
1489	! RTTOV inputs/options
1490	print *, x%plat
1491	print *, x%sat
1492	print *, x%inst
1493	print *, x%Nchan
1494	print *, 'shape(x%Ichan): ',x%Ichan
1495	print *, 'shape(x%Surfem): ',x%Surfem
1496	print *, x%ZenAng
1497	print *, x%co2,x%ch4,x%n2o,x%co
1498
1499	END SUBROUTINE COSP_GRIDBOX_PRINT
1500
1501	SUBROUTINE COSP_MISR_PRINT(x)
1502	type(cosp_misr),intent(in) :: x
1503
1504	print *, '%%%%----- Information on COSP_MISR ------'
1505
1506	! Dimensions
1507	print *, x%Npoints
1508	print *, x%Ntau
1509	print *, x%Nlevels
1510
1511	! --- (npoints,ntau,nlevels)
1512	! the fraction of the model grid box covered by each of the MISR cloud types
1513	print *, 'shape(x%fq_MISR): ',shape(x%fq_MISR)
1514
1515	! --- (npoints)
1516	print *, 'shape(x%MISR_meanztop): ',shape(x%MISR_meanztop)
1517	print *, 'shape(x%MISR_cldarea): ',shape(x%MISR_cldarea)
1518	! --- (npoints,nlevels)
1519	print *, 'shape(x%MISR_dist_model_layertops): ',shape(x%MISR_dist_model_layertops)
1520
1521	END SUBROUTINE COSP_MISR_PRINT
1522
1523	SUBROUTINE COSP_ISCCP_PRINT(x)
1524	type(cosp_isccp),intent(in) :: x
1525
1526	print *, x%Npoints
1527	print *, x%Ncolumns
1528	print *, x%Nlevels
1529
1530	print *, '%%%%----- Information on COSP_ISCCP ------'
1531
1532	print *, 'shape(x%fq_isccp): ',shape(x%fq_isccp)
1533	print *, 'shape(x%totalcldarea): ',shape(x%totalcldarea)
1534	print *, 'shape(x%meantb): ',shape(x%meantb)
1535	print *, 'shape(x%meantbclr): ',shape(x%meantbclr)
1536
1537	print *, 'shape(x%meanptop): ',shape(x%meanptop)
1538	print *, 'shape(x%meantaucld): ',shape(x%meantaucld)
1539	print *, 'shape(x%meanalbedocld): ',shape(x%meanalbedocld)
1540	print *, 'shape(x%boxtau): ',shape(x%boxtau)
1541	print *, 'shape(x%boxptop): ',shape(x%boxptop)
1542	END SUBROUTINE COSP_ISCCP_PRINT
1543
1544	SUBROUTINE COSP_VGRID_PRINT(x)
1545	type(cosp_vgrid),intent(in) :: x
1546
1547	print *, '%%%%----- Information on COSP_VGRID ------'
1548	print *, x%use_vgrid
1549	print *, x%csat_vgrid
1550	print *, x%Npoints
1551	print *, x%Ncolumns
1552	print *, x%Nlevels
1553	print *, x%Nlvgrid
1554	! Array with dimensions (Nlvgrid)
1555	print *, 'shape(x%z): ',shape(x%z)
1556	print *, 'shape(x%zl): ',shape(x%zl)
1557	print *, 'shape(x%zu): ',shape(x%zu)
1558	! Array with dimensions (Nlevels)
1559	print *, 'shape(x%mz): ',shape(x%mz)
1560	print *, 'shape(x%mzl): ',shape(x%mzl)
1561	print *, 'shape(x%mzu): ',shape(x%mzu)
1562	END SUBROUTINE COSP_VGRID_PRINT
1563
1564	SUBROUTINE COSP_SGLIDAR_PRINT(x)
1565	type(cosp_sglidar),intent(in) :: x
1566
1567	print *, '%%%%----- Information on COSP_SGLIDAR ------'
1568	! Dimensions
1569	print *, x%Npoints
1570	print *, x%Ncolumns
1571	print *, x%Nlevels
1572	print *, x%Nhydro
1573	print *, x%Nrefl
1574	! Arrays with dimensions (Npoints,Nlevels)
1575	print *, 'shape(x%beta_mol): ',shape(x%beta_mol)
1576	! Arrays with dimensions (Npoints,Ncolumns,Nlevels)
1577	print *, 'shape(x%beta_tot): ',shape(x%beta_tot)
1578	print *, 'shape(x%tau_tot): ',shape(x%tau_tot)
1579	! Arrays with dimensions (Npoints,Ncolumns,Nrefl)
1580	print *, 'shape(x%refl): ',shape(x%refl)
1581	END SUBROUTINE COSP_SGLIDAR_PRINT
1582
1583	SUBROUTINE COSP_SGRADAR_PRINT(x)
1584	type(cosp_sgradar),intent(in) :: x
1585
1586	print *, '%%%%----- Information on COSP_SGRADAR ------'
1587	print *, x%Npoints
1588	print *, x%Ncolumns
1589	print *, x%Nlevels
1590	print *, x%Nhydro
1591	! output vertical levels: spaceborne radar -> from TOA to SURFACE
1592	! Arrays with dimensions (Npoints,Nlevels)
1593	print *, 'shape(x%att_gas): ', shape(x%att_gas)
1594	! Arrays with dimensions (Npoints,Ncolumns,Nlevels)
1595	print *, 'shape(x%Ze_tot): ', shape(x%Ze_tot)
1596	END SUBROUTINE COSP_SGRADAR_PRINT
1597
1598	SUBROUTINE COSP_RADARSTATS_PRINT(x)
1599	type(cosp_radarstats),intent(in) :: x
1600
1601	print *, '%%%%----- Information on COSP_SGRADAR ------'
1602	print *, x%Npoints
1603	print *, x%Ncolumns
1604	print *, x%Nlevels
1605	print *, x%Nhydro
1606	print *, 'shape(x%cfad_ze): ',shape(x%cfad_ze)
1607	print *, 'shape(x%radar_lidar_tcc): ',shape(x%radar_lidar_tcc)
1608	print *, 'shape(x%lidar_only_freq_cloud): ',shape(x%lidar_only_freq_cloud)
1609	END SUBROUTINE COSP_RADARSTATS_PRINT
1610
1611	SUBROUTINE COSP_LIDARSTATS_PRINT(x)
1612	type(cosp_lidarstats),intent(in) :: x
1613
1614	print *, '%%%%----- Information on COSP_SGLIDAR ------'
1615	print *, x%Npoints
1616	print *, x%Ncolumns
1617	print *, x%Nlevels
1618	print *, x%Nhydro
1619	print *, x%Nrefl
1620
1621	! Arrays with dimensions (SR_BINS)
1622	print *, 'shape(x%srbval): ',shape(x%srbval)
1623	! Arrays with dimensions (Npoints,SR_BINS,Nlevels)
1624	print *, 'shape(x%cfad_sr): ',shape(x%cfad_sr)
1625	! ! Arrays with dimensions (Npoints,Ncolumns,Nlevels) !TIBO
1626	! print *, 'shape(x%profSR): ',shape(x%profSR) !TIBO
1627	! Arrays with dimensions (Npoints,Nlevels,Ncolumns) !TIBO2
1628	print *, 'shape(x%profSR): ',shape(x%profSR) !TIBO2
1629	! Arrays with dimensions (Npoints,Nlevels)
1630	print *, 'shape(x%lidarcld): ',shape(x%lidarcld)
1631	print *, 'shape(x%proftemp): ',shape(x%proftemp) !TIBO
1632	! Arrays with dimensions (Npoints,LIDAR_NCAT)
1633	print *, 'shape(x%cldlayer): ',shape(x%cldlayer)
1634	! Arrays with dimensions (Npoints,LIDAR_NTYPE) !OPAQ
1635	print *, 'shape(x%cldtype): ',shape(x%cldtype) !OPAQ
1636	! Arrays with dimensions (Npoints,PARASOL_NREFL)
1637	print *, 'shape(x%parasolrefl): ',shape(x%parasolrefl)
1638	! Arrays with dimensions (Npoints,Nlevels,Nphase)
1639	print *, 'shape(x%lidarcldphase): ',shape(x%lidarcldphase)
1640	! Arrays with dimensions (Npoints,Nlevels,LIDAR_NTYPE+1) !OPAQ
1641	print *, 'shape(x%lidarcldtype): ',shape(x%lidarcldtype) !OPAQ
1642	! Arrays with dimensions (Npoints,LIDAR_NCAT,Nphase)
1643	print *, 'shape(x%cldlayerphase): ',shape(x%cldlayerphase)
1644	! Arrays with dimensions (Npoints,Ntemps,Nphase)
1645	print *, 'shape(x%lidarcldphase): ',shape(x%lidarcldtmp)
1646
1647	END SUBROUTINE COSP_LIDARSTATS_PRINT
1648
1649	SUBROUTINE COSP_SUBGRID_PRINT(x)
1650	type(cosp_subgrid),intent(in) :: x
1651
1652	print *, '%%%%----- Information on COSP_SUBGRID ------'
1653	print *, x%Npoints
1654	print *, x%Ncolumns
1655	print *, x%Nlevels
1656	print *, x%Nhydro
1657
1658	print *, 'shape(x%prec_frac): ',shape(x%prec_frac)
1659	print *, 'shape(x%frac_out): ',shape(x%frac_out)
1660	END SUBROUTINE COSP_SUBGRID_PRINT
1661
1662	SUBROUTINE COSP_SGHYDRO_PRINT(x)
1663	type(cosp_sghydro),intent(in) :: x
1664
1665	print *, '%%%%----- Information on COSP_SGHYDRO ------'
1666	print *, x%Npoints
1667	print *, x%Ncolumns
1668	print *, x%Nlevels
1669	print *, x%Nhydro
1670
1671	print *, 'shape(x%mr_hydro): ',shape(x%mr_hydro)
1672	print *, 'shape(x%Reff): ',shape(x%Reff)
1673	print *, 'shape(x%Np): ',shape(x%Np) ! added by roj with Quickbeam V3
1674	END SUBROUTINE COSP_SGHYDRO_PRINT
1675
1676	END MODULE MOD_COSP_TYPES

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format