Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

cosp_types.F90 @ 3331

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

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

Download in other formats:

Original Format