Context Navigation

cosp_types.F90

Last change on this file was 1279, checked in by Laurent Fairhead, 15 years ago
Merged LMDZ4-dev branch changes r1241:1278 into the trunk Running trunk and LMDZ4-dev in LMDZOR configuration on local machine (sequential) and SX8 (4-proc) yields identical results (restart and restartphy are identical binarily) Log history from r1241 to r1278 is available by switching to source:LMDZ4/branches/LMDZ4-dev-20091210
File size: 57.0 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	!
26	! History:
27	! Jul 2007 - A. Bodas-Salcedo - Initial version
28	! Feb 2008 - R. Marchand - Added Quickbeam types and initialisation
29	! Oct 2008 - H. Chepfer - Added PARASOL reflectance diagnostic
30	! Nov 2008 - R. Marchand - Added MISR diagnostics
31	! Nov 2008 - V. John - Added RTTOV diagnostics
32	!
33	!
34	MODULE MOD_COSP_TYPES
35	USE MOD_COSP_CONSTANTS
36	USE MOD_COSP_UTILS
37
38	use radar_simulator_types, only: class_param, mie, nd, mt_nd, dmax, dmin, mt_ttl, mt_tti, cnt_liq, cnt_ice ! added by roj Feb 2008
39
40	IMPLICIT NONE
41
42	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
43	!----------------------- DERIVED TYPES ----------------------------
44	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
45
46	! Configuration choices (simulators, variables)
47	TYPE COSP_CONFIG
48	logical :: Lradar_sim,Llidar_sim,Lisccp_sim,Lmisr_sim,Lrttov_sim,Lstats,Lwrite_output, &
49	Lalbisccp,Latb532,Lboxptopisccp,Lboxtauisccp,Lcfad_dbze94, &
50	Lcfad_lidarsr532,Lclcalipso2,Lclcalipso,Lclhcalipso,Lclisccp2,Lcllcalipso, &
51	Lclmcalipso,Lcltcalipso,Lcltlidarradar,Lctpisccp,Ldbze94,Ltauisccp,Ltclisccp, &
52	Llongitude,Llatitude,Lparasol_refl,LclMISR,Lmeantbisccp,Lmeantbclrisccp, &
53	Lfrac_out,Lbeta_mol532,Ltbrttov
54	character(len=32) :: out_list(N_OUT_LIST)
55	END TYPE COSP_CONFIG
56
57	! Outputs from RTTOV
58	TYPE COSP_RTTOV
59	! Dimensions
60	integer :: Npoints ! Number of gridpoints
61	integer :: Nchan ! Number of channels
62
63	! Brightness temperatures (Npoints,Nchan)
64	real,pointer :: tbs(:,:)
65
66	END TYPE COSP_RTTOV
67
68	! Outputs from MISR simulator
69	TYPE COSP_MISR
70	! Dimensions
71	integer :: Npoints ! Number of gridpoints
72	integer :: Ntau ! Number of tau intervals
73	integer :: Nlevels ! Number of cth levels
74
75	! --- (npoints,ntau,nlevels)
76	! the fraction of the model grid box covered by each of the MISR cloud types
77	real,pointer :: fq_MISR(:,:,:)
78
79	! --- (npoints)
80	real,pointer :: MISR_meanztop(:), MISR_cldarea(:)
81	! --- (npoints,nlevels)
82	real,pointer :: MISR_dist_model_layertops(:,:)
83	END TYPE COSP_MISR
84
85	! Outputs from ISCCP simulator
86	TYPE COSP_ISCCP
87	! Dimensions
88	integer :: Npoints ! Number of gridpoints
89	integer :: Ncolumns ! Number of columns
90	integer :: Nlevels ! Number of levels
91
92
93	! --- (npoints,tau=7,pressure=7)
94	! the fraction of the model grid box covered by each of the 49 ISCCP D level cloud types
95	real,pointer :: fq_isccp(:,:,:)
96
97	! --- (npoints) ---
98	! The fraction of model grid box columns with cloud somewhere in them.
99	! This should equal the sum over all entries of fq_isccp
100	real,pointer :: totalcldarea(:)
101	! mean all-sky 10.5 micron brightness temperature
102	real,pointer :: meantb(:)
103	! mean clear-sky 10.5 micron brightness temperature
104	real,pointer :: meantbclr(:)
105
106	! The following three means are averages over the cloudy areas only. If no
107	! clouds are in grid box all three quantities should equal zero.
108
109	! mean cloud top pressure (mb) - linear averaging in cloud top pressure.
110	real,pointer :: meanptop(:)
111	! mean optical thickness linear averaging in albedo performed.
112	real,pointer :: meantaucld(:)
113	! mean cloud albedo. linear averaging in albedo performed
114	real,pointer :: meanalbedocld(:)
115
116	!--- (npoints,ncol) ---
117	! optical thickness in each column
118	real,pointer :: boxtau(:,:)
119	! cloud top pressure (mb) in each column
120	real,pointer :: boxptop(:,:)
121	END TYPE COSP_ISCCP
122
123	! Summary statistics from radar
124	TYPE COSP_VGRID
125	logical :: use_vgrid ! Logical flag that indicates change of grid
126	logical :: csat_vgrid ! Flag for Cloudsat grid
127	integer :: Npoints ! Number of sampled points
128	integer :: Ncolumns ! Number of subgrid columns
129	integer :: Nlevels ! Number of model levels
130	integer :: Nlvgrid ! Number of levels of new grid
131	! Array with dimensions (Nlvgrid)
132	real, dimension(:), pointer :: z,zl,zu ! Height and lower and upper boundaries of new levels
133	! Array with dimensions (Nlevels)
134	real, dimension(:), pointer :: mz,mzl,mzu ! Height and lower and upper boundaries of model levels
135	END TYPE COSP_VGRID
136
137	! Output data from lidar code
138	TYPE COSP_SGLIDAR
139	! Dimensions
140	integer :: Npoints ! Number of gridpoints
141	integer :: Ncolumns ! Number of columns
142	integer :: Nlevels ! Number of levels
143	integer :: Nhydro ! Number of hydrometeors
144	integer :: Nrefl ! Number of parasol reflectances
145	! Arrays with dimensions (Npoints,Nlevels)
146	real,dimension(:,:),pointer :: beta_mol ! Molecular backscatter
147	! Arrays with dimensions (Npoints,Ncolumns,Nlevels)
148	real,dimension(:,:,:),pointer :: beta_tot ! Total backscattered signal
149	real,dimension(:,:,:),pointer :: tau_tot ! Optical thickness integrated from top to level z
150	! Arrays with dimensions (Npoints,Ncolumns,Nrefl)
151	real,dimension(:,:,:),pointer :: refl ! parasol reflectances
152	END TYPE COSP_SGLIDAR
153
154	! Output data from radar code
155	TYPE COSP_SGRADAR
156	! Dimensions
157	integer :: Npoints ! Number of gridpoints
158	integer :: Ncolumns ! Number of columns
159	integer :: Nlevels ! Number of levels
160	integer :: Nhydro ! Number of hydrometeors
161	! output vertical levels: spaceborne radar -> from TOA to SURFACE
162	! Arrays with dimensions (Npoints,Nlevels)
163	real,dimension(:,:),pointer :: att_gas ! 2-way attenuation by gases [dBZ]
164	! Arrays with dimensions (Npoints,Ncolumns,Nlevels)
165	real,dimension(:,:,:),pointer :: Ze_tot ! Effective reflectivity factor [dBZ]
166
167	END TYPE COSP_SGRADAR
168
169
170	! Summary statistics from radar
171	TYPE COSP_RADARSTATS
172	integer :: Npoints ! Number of sampled points
173	integer :: Ncolumns ! Number of subgrid columns
174	integer :: Nlevels ! Number of model levels
175	integer :: Nhydro ! Number of hydrometeors
176	! Array with dimensions (Npoints,dBZe_bins,Nlevels)
177	real, dimension(:,:,:), pointer :: cfad_ze ! Ze CFAD
178	! Array with dimensions (Npoints)
179	real,dimension(:),pointer :: radar_lidar_tcc ! Radar&lidar total cloud amount, grid-box scale
180	! Arrays with dimensions (Npoints,Nlevels)
181	real, dimension(:,:),pointer :: lidar_only_freq_cloud
182	END TYPE COSP_RADARSTATS
183
184	! Summary statistics from lidar
185	TYPE COSP_LIDARSTATS
186	integer :: Npoints ! Number of sampled points
187	integer :: Ncolumns ! Number of subgrid columns
188	integer :: Nlevels ! Number of model levels
189	integer :: Nhydro ! Number of hydrometeors
190	integer :: Nrefl ! Number of parasol reflectances
191
192	! Arrays with dimensions (SR_BINS)
193	real, dimension(:),pointer :: srbval ! SR bins in cfad_sr
194	! Arrays with dimensions (Npoints,SR_BINS,Nlevels)
195	real, dimension(:,:,:),pointer :: cfad_sr ! CFAD of scattering ratio
196	! Arrays with dimensions (Npoints,Nlevels)
197	real, dimension(:,:),pointer :: lidarcld ! 3D "lidar" cloud fraction
198	! Arrays with dimensions (Npoints,LIDAR_NCAT)
199	real, dimension(:,:),pointer :: cldlayer ! low, mid, high-level lidar cloud cover
200	! Arrays with dimensions (Npoints,PARASOL_NREFL)
201	real, dimension(:,:),pointer :: parasolrefl ! mean parasol reflectance
202
203	END TYPE COSP_LIDARSTATS
204
205
206	! Input data for simulator. Subgrid scale.
207	! Input data from SURFACE to TOA
208	TYPE COSP_SUBGRID
209	! Dimensions
210	integer :: Npoints ! Number of gridpoints
211	integer :: Ncolumns ! Number of columns
212	integer :: Nlevels ! Number of levels
213	integer :: Nhydro ! Number of hydrometeors
214
215	real,dimension(:,:,:),pointer :: prec_frac ! Subgrid precip array. Dimensions (Npoints,Ncolumns,Nlevels)
216	real,dimension(:,:,:),pointer :: frac_out ! Subgrid cloud array. Dimensions (Npoints,Ncolumns,Nlevels)
217	END TYPE COSP_SUBGRID
218
219	! Input data for simulator at Subgrid scale.
220	! Used on a reduced number of points
221	TYPE COSP_SGHYDRO
222	! Dimensions
223	integer :: Npoints ! Number of gridpoints
224	integer :: Ncolumns ! Number of columns
225	integer :: Nlevels ! Number of levels
226	integer :: Nhydro ! Number of hydrometeors
227	real,dimension(:,:,:,:),pointer :: mr_hydro ! Mixing ratio of each hydrometeor
228	! (Npoints,Ncolumns,Nlevels,Nhydro) [kg/kg]
229	real,dimension(:,:,:,:),pointer :: Reff ! Effective Radius of each hydrometeor
230	! (Reff==0 means use default size)
231	! (Npoints,Ncolumns,Nlevels,Nhydro) [m]
232	END TYPE COSP_SGHYDRO
233
234	! Input data for simulator. Gridbox scale.
235	TYPE COSP_GRIDBOX
236	! Scalars and dimensions
237	integer :: Npoints ! Number of gridpoints
238	integer :: Nlevels ! Number of levels
239	integer :: Ncolumns ! Number of columns
240	integer :: Nhydro ! Number of hydrometeors
241	integer :: Nprmts_max_hydro ! Max number of parameters for hydrometeor size distributions
242	integer :: Naero ! Number of aerosol species
243	integer :: Nprmts_max_aero ! Max number of parameters for aerosol size distributions
244	integer :: Npoints_it ! Max number of gridpoints to be processed in one iteration
245
246	! Time [days]
247	double precision :: time
248
249	! Radar ancillary info
250	real :: radar_freq, & ! Radar frequency [GHz]
251	k2 ! \|K\|^2, -1=use frequency dependent default
252	integer :: surface_radar, & ! surface=1, spaceborne=0
253	use_mie_tables, & ! use a precomputed loopup table? yes=1,no=0
254	use_gas_abs, & ! include gaseous absorption? yes=1,no=0
255	do_ray, & ! calculate/output Rayleigh refl=1, not=0
256	melt_lay ! melting layer model off=0, on=1
257
258	! 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
259	type(class_param) :: hp ! structure used by radar simulator to store Ze and N scaling constants and other information
260	type(mie):: mt ! structure used by radar simulator to store mie LUT information
261	integer :: nsizes ! number of discrete drop sizes (um) used to represent the distribution
262	real*8, dimension(:), pointer :: D ! array of discrete drop sizes (um) used to represent the distribution
263	real*8, dimension(:), pointer :: mt_ttl, mt_tti ! array of temperatures used with Ze_scaling (also build into mie LUT)
264
265	! Lidar
266	integer :: lidar_ice_type !ice particle shape hypothesis in lidar calculations
267	!(ice_type=0 for spheres, ice_type=1 for non spherical particles)
268
269	! Radar
270	logical :: use_precipitation_fluxes ! True if precipitation fluxes are input to the algorithm
271	logical :: use_reff ! True if Reff is to be used by radar
272
273	! Geolocation (Npoints)
274	real,dimension(:),pointer :: longitude ! longitude [degrees East]
275	real,dimension(:),pointer :: latitude ! latitude [deg North]
276	! Gridbox information (Npoints,Nlevels)
277	real,dimension(:,:),pointer :: zlev ! Height of model levels [m]
278	real,dimension(:,:),pointer :: zlev_half ! Height at half model levels [m] (Bottom of model layer)
279	real,dimension(:,:),pointer :: dlev ! Depth of model levels [m]
280	real,dimension(:,:),pointer :: p ! Pressure at full model levels [Pa]
281	real,dimension(:,:),pointer :: ph ! Pressure at half model levels [Pa]
282	real,dimension(:,:),pointer :: T ! Temperature at model levels [K]
283	real,dimension(:,:),pointer :: q ! Relative humidity to water (%)
284	real,dimension(:,:),pointer :: sh ! Specific humidity to water [kg/kg]
285	real,dimension(:,:),pointer :: dtau_s ! mean 0.67 micron optical depth of stratiform
286	! clouds in each model level
287	! NOTE: this the cloud optical depth of only the
288	! cloudy part of the grid box, it is not weighted
289	! with the 0 cloud optical depth of the clear
290	! part of the grid box
291	real,dimension(:,:),pointer :: dtau_c ! mean 0.67 micron optical depth of convective
292	! clouds in each model level. Same note applies as in dtau_s.
293	real,dimension(:,:),pointer :: dem_s ! 10.5 micron longwave emissivity of stratiform
294	! clouds in each model level. Same note applies as in dtau_s.
295	real,dimension(:,:),pointer :: dem_c ! 10.5 micron longwave emissivity of convective
296	! clouds in each model level. Same note applies as in dtau_s.
297	real,dimension(:,:),pointer :: mr_ozone ! Ozone mass mixing ratio [kg/kg]
298
299	! Point information (Npoints)
300	real,dimension(:),pointer :: land !Landmask [0 - Ocean, 1 - Land]
301	real,dimension(:),pointer :: psfc !Surface pressure [Pa]
302	real,dimension(:),pointer :: sunlit ! (npoints) 1 for day points, 0 for nightime
303	real,dimension(:),pointer :: skt ! Skin temperature (K)
304	real,dimension(:),pointer :: sfc_height ! Surface height [m]
305	real,dimension(:),pointer :: u_wind ! eastward wind [m s-1]
306	real,dimension(:),pointer :: v_wind ! northward wind [m s-1]
307
308	! TOTAL and CONV cloud fraction for SCOPS
309	real,dimension(:,:),pointer :: tca ! Total cloud fraction
310	real,dimension(:,:),pointer :: cca ! Convective cloud fraction
311	! Precipitation fluxes on model levels
312	real,dimension(:,:),pointer :: rain_ls ! large-scale precipitation flux of rain [kg/m2.s]
313	real,dimension(:,:),pointer :: rain_cv ! convective precipitation flux of rain [kg/m2.s]
314	real,dimension(:,:),pointer :: snow_ls ! large-scale precipitation flux of snow [kg/m2.s]
315	real,dimension(:,:),pointer :: snow_cv ! convective precipitation flux of snow [kg/m2.s]
316	real,dimension(:,:),pointer :: grpl_ls ! large-scale precipitation flux of graupel [kg/m2.s]
317	! Hydrometeors concentration and distribution parameters
318	! real,dimension(:,:,:),pointer :: fr_hydro ! Fraction of the gridbox occupied by each hydrometeor (Npoints,Nlevels,Nhydro)
319	real,dimension(:,:,:),pointer :: mr_hydro ! Mixing ratio of each hydrometeor (Npoints,Nlevels,Nhydro) [kg/kg]
320	real,dimension(:,:),pointer :: dist_prmts_hydro !Distributional parameters for hydrometeors (Nprmts_max_hydro,Nhydro)
321	! Effective radius [m]. (Npoints,Nlevels,Nhydro)
322	real,dimension(:,:,:),pointer :: Reff
323	! Aerosols concentration and distribution parameters
324	real,dimension(:,:,:),pointer :: conc_aero ! Aerosol concentration for each species (Npoints,Nlevels,Naero)
325	integer,dimension(:),pointer :: dist_type_aero ! Particle size distribution type for each aerosol species (Naero)
326	real,dimension(:,:,:,:),pointer :: dist_prmts_aero ! Distributional parameters for aerosols
327	! (Npoints,Nlevels,Nprmts_max_aero,Naero)
328	! ISCCP simulator inputs
329	integer :: isccp_top_height ! 1 = adjust top height using both a computed
330	! infrared brightness temperature and the visible
331	! optical depth to adjust cloud top pressure. Note
332	! that this calculation is most appropriate to compare
333	! to ISCCP data during sunlit hours.
334	! 2 = do not adjust top height, that is cloud top
335	! pressure is the actual cloud top pressure
336	! in the model
337	! 3 = adjust top height using only the computed
338	! infrared brightness temperature. Note that this
339	! calculation is most appropriate to compare to ISCCP
340	! IR only algortihm (i.e. you can compare to nighttime
341	! ISCCP data with this option)
342	integer :: isccp_top_height_direction ! direction for finding atmosphere pressure level
343	! with interpolated temperature equal to the radiance
344	! determined cloud-top temperature
345	! 1 = find the lowest altitude (highest pressure) level
346	! with interpolated temperature equal to the radiance
347	! determined cloud-top temperature
348	! 2 = find the highest altitude (lowest pressure) level
349	! with interpolated temperature equal to the radiance
350	! determined cloud-top temperature
351	! ONLY APPLICABLE IF top_height EQUALS 1 or 3
352	! 1 = default setting, and matches all versions of
353	! ISCCP simulator with versions numbers 3.5.1 and lower
354	! 2 = experimental setting
355	integer :: isccp_overlap ! overlap type (1=max, 2=rand, 3=max/rand)
356	real :: isccp_emsfc_lw ! 10.5 micron emissivity of surface (fraction)
357
358	! RTTOV inputs/options
359	integer :: plat ! satellite platform
360	integer :: sat ! satellite
361	integer :: inst ! instrument
362	integer :: Nchan ! Number of channels to be computed
363	integer, dimension(:), pointer :: Ichan ! Channel numbers
364	real, dimension(:), pointer :: Surfem ! Surface emissivity
365	real :: ZenAng ! Satellite Zenith Angles
366	real :: co2,ch4,n2o,co ! Mixing ratios of trace gases
367
368	END TYPE COSP_GRIDBOX
369
370	CONTAINS
371
372	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
373	!------------- SUBROUTINE CONSTRUCT_COSP_RTTOV -------------------
374	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
375	SUBROUTINE CONSTRUCT_COSP_RTTOV(Npoints,Nchan,x)
376	integer,intent(in) :: Npoints ! Number of sampled points
377	integer,intent(in) :: Nchan ! Number of channels
378	type(cosp_rttov),intent(out) :: x
379
380	! Dimensions
381	x%Npoints = Npoints
382	x%Nchan = Nchan
383
384	! --- Allocate arrays ---
385	allocate(x%tbs(Npoints, Nchan))
386	! --- Initialise to zero ---
387	x%tbs = 0.0
388	END SUBROUTINE CONSTRUCT_COSP_RTTOV
389
390	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
391	!------------- SUBROUTINE FREE_COSP_RTTOV ------------------------
392	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
393	SUBROUTINE FREE_COSP_RTTOV(x)
394	type(cosp_rttov),intent(inout) :: x
395
396	! --- Deallocate arrays ---
397	deallocate(x%tbs)
398	END SUBROUTINE FREE_COSP_RTTOV
399
400	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
401	!------------- SUBROUTINE CONSTRUCT_COSP_MISR ------------------
402	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
403	SUBROUTINE CONSTRUCT_COSP_MISR(cfg,Npoints,x)
404	type(cosp_config),intent(in) :: cfg ! Configuration options
405	integer,intent(in) :: Npoints ! Number of gridpoints
406	type(cosp_misr),intent(out) :: x
407	! Local variables
408	integer :: i,j,k
409
410
411	! Allocate minumum storage if simulator not used
412	if (cfg%Lmisr_sim) then
413	i = Npoints
414	j = 7
415	k = MISR_N_CTH
416	else
417	i = 1
418	j = 1
419	k = 1
420	endif
421
422	! Dimensions
423	x%Npoints = i
424	x%Ntau = j
425	x%Nlevels = k
426
427	! allocate space for MISR simulator outputs ...
428	allocate(x%fq_MISR(i,j,k), x%MISR_meanztop(i),x%MISR_cldarea(i), x%MISR_dist_model_layertops(i,k))
429	x%fq_MISR = 0.0
430	x%MISR_meanztop = 0.0
431	x%MISR_cldarea = 0.0
432	x%MISR_dist_model_layertops = 0.0
433
434	END SUBROUTINE CONSTRUCT_COSP_MISR
435	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
436	!------------- SUBROUTINE FREE_COSP_MISR ------------------
437	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
438	SUBROUTINE FREE_COSP_MISR(x)
439	type(cosp_misr),intent(inout) :: x
440	deallocate(x%fq_MISR, x%MISR_meanztop,x%MISR_cldarea, x%MISR_dist_model_layertops)
441
442	END SUBROUTINE FREE_COSP_MISR
443
444	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
445	!------------- SUBROUTINE CONSTRUCT_COSP_ISCCP ------------------
446	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
447	SUBROUTINE CONSTRUCT_COSP_ISCCP(cfg,Npoints,Ncolumns,Nlevels,x)
448	type(cosp_config),intent(in) :: cfg ! Configuration options
449	integer,intent(in) :: Npoints ! Number of sampled points
450	integer,intent(in) :: Ncolumns ! Number of subgrid columns
451	integer,intent(in) :: Nlevels ! Number of model levels
452	type(cosp_isccp),intent(out) :: x
453	! Local variables
454	integer :: i,j,k
455
456	! Allocate minumum storage if simulator not used
457	if (cfg%Lisccp_sim) then
458	i = Npoints
459	j = Ncolumns
460	k = Nlevels
461	else
462	i = 1
463	j = 1
464	k = 1
465	endif
466
467	! Dimensions
468	x%Npoints = i
469	x%Ncolumns = j
470	x%Nlevels = k
471
472	! --- Allocate arrays ---
473	allocate(x%fq_isccp(i,7,7), x%totalcldarea(i), &
474	x%meanptop(i), x%meantaucld(i), &
475	x%meantb(i), x%meantbclr(i), &
476	x%boxtau(i,j), x%boxptop(i,j), &
477	x%meanalbedocld(i))
478	! --- Initialise to zero ---
479	x%fq_isccp = 0.0
480	x%totalcldarea = 0.0
481	x%meanptop = 0.0
482	x%meantaucld = 0.0
483	x%meantb = 0.0
484	x%meantbclr = 0.0
485	x%boxtau = 0.0
486	x%boxptop = 0.0
487	x%meanalbedocld= 0.0
488	END SUBROUTINE CONSTRUCT_COSP_ISCCP
489
490	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
491	!------------- SUBROUTINE FREE_COSP_ISCCP -----------------------
492	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
493	SUBROUTINE FREE_COSP_ISCCP(x)
494	type(cosp_isccp),intent(inout) :: x
495
496	deallocate(x%fq_isccp, x%totalcldarea, &
497	x%meanptop, x%meantaucld, x%meantb, x%meantbclr, &
498	x%boxtau, x%boxptop, x%meanalbedocld)
499	END SUBROUTINE FREE_COSP_ISCCP
500
501	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
502	!------------- SUBROUTINE CONSTRUCT_COSP_VGRID ------------------
503	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
504	SUBROUTINE CONSTRUCT_COSP_VGRID(gbx,Nlvgrid,use_vgrid,cloudsat,x)
505	type(cosp_gridbox),intent(in) :: gbx ! Gridbox information
506	integer,intent(in) :: Nlvgrid ! Number of new levels
507	logical,intent(in) :: use_vgrid! Logical flag that controls the output on a different grid
508	logical,intent(in) :: cloudsat ! TRUE if a CloudSat like grid (480m) is requested
509	type(cosp_vgrid),intent(out) :: x
510
511	! Local variables
512	integer :: i
513	real :: zstep
514
515	x%use_vgrid = use_vgrid
516	x%csat_vgrid = cloudsat
517
518	! Dimensions
519	x%Npoints = gbx%Npoints
520	x%Ncolumns = gbx%Ncolumns
521	x%Nlevels = gbx%Nlevels
522
523	! --- Allocate arrays ---
524	if (use_vgrid) then
525	x%Nlvgrid = Nlvgrid
526	else
527	x%Nlvgrid = gbx%Nlevels
528	endif
529	allocate(x%z(x%Nlvgrid),x%zl(x%Nlvgrid),x%zu(x%Nlvgrid))
530	allocate(x%mz(x%Nlevels),x%mzl(x%Nlevels),x%mzu(x%Nlevels))
531
532	! --- Model vertical levels ---
533	! Use height levels of first model gridbox
534	x%mz = gbx%zlev(1,:)
535	x%mzl = gbx%zlev_half(1,:)
536	x%mzu(1:x%Nlevels-1) = gbx%zlev_half(1,2:x%Nlevels)
537	x%mzu(x%Nlevels) = gbx%zlev(1,x%Nlevels) + (gbx%zlev(1,x%Nlevels) - x%mzl(x%Nlevels))
538
539	if (use_vgrid) then
540	! --- Initialise to zero ---
541	x%z = 0.0
542	x%zl = 0.0
543	x%zu = 0.0
544	if (cloudsat) then ! --- CloudSat grid requested ---
545	zstep = 480.0
546	else
547	! Other grid requested. Constant vertical spacing with top at 20 km
548	zstep = 20000.0/x%Nlvgrid
549	endif
550	do i=1,x%Nlvgrid
551	x%zl(i) = (i-1)*zstep
552	x%zu(i) = i*zstep
553	enddo
554	x%z = (x%zl + x%zu)/2.0
555	else
556	x%z = x%mz
557	x%zl = x%mzl
558	x%zu = x%mzu
559	endif
560
561	END SUBROUTINE CONSTRUCT_COSP_VGRID
562
563	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
564	!------------------ SUBROUTINE FREE_COSP_VGRID ------------------
565	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
566	SUBROUTINE FREE_COSP_VGRID(x)
567	type(cosp_vgrid),intent(inout) :: x
568
569	deallocate(x%z, x%zl, x%zu, x%mz, x%mzl, x%mzu)
570	END SUBROUTINE FREE_COSP_VGRID
571
572	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
573	!------------- SUBROUTINE CONSTRUCT_COSP_SGLIDAR ------------------
574	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
575	SUBROUTINE CONSTRUCT_COSP_SGLIDAR(cfg,Npoints,Ncolumns,Nlevels,Nhydro,Nrefl,x)
576	type(cosp_config),intent(in) :: cfg ! Configuration options
577	integer,intent(in) :: Npoints ! Number of sampled points
578	integer,intent(in) :: Ncolumns ! Number of subgrid columns
579	integer,intent(in) :: Nlevels ! Number of model levels
580	integer,intent(in) :: Nhydro ! Number of hydrometeors
581	integer,intent(in) :: Nrefl ! Number of parasol reflectances ! parasol
582	type(cosp_sglidar),intent(out) :: x
583	! Local variables
584	integer :: i,j,k,l,m
585
586	! Allocate minumum storage if simulator not used
587	if (cfg%Llidar_sim) then
588	i = Npoints
589	j = Ncolumns
590	k = Nlevels
591	l = Nhydro
592	m = Nrefl
593	else
594	i = 1
595	j = 1
596	k = 1
597	l = 1
598	m = 1
599	endif
600
601	! Dimensions
602	x%Npoints = i
603	x%Ncolumns = j
604	x%Nlevels = k
605	x%Nhydro = l
606	x%Nrefl = m
607
608	! --- Allocate arrays ---
609	allocate(x%beta_mol(i,k), x%beta_tot(i,j,k), &
610	x%tau_tot(i,j,k),x%refl(i,j,m))
611	! --- Initialise to zero ---
612	x%beta_mol = 0.0
613	x%beta_tot = 0.0
614	x%tau_tot = 0.0
615	x%refl = 0.0 ! parasol
616	END SUBROUTINE CONSTRUCT_COSP_SGLIDAR
617
618	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
619	!------------------ SUBROUTINE FREE_COSP_SGLIDAR ------------------
620	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
621	SUBROUTINE FREE_COSP_SGLIDAR(x)
622	type(cosp_sglidar),intent(inout) :: x
623
624	deallocate(x%beta_mol, x%beta_tot, x%tau_tot, x%refl)
625	END SUBROUTINE FREE_COSP_SGLIDAR
626
627	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
628	!------------- SUBROUTINE CONSTRUCT_COSP_SGRADAR ------------------
629	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
630	SUBROUTINE CONSTRUCT_COSP_SGRADAR(cfg,Npoints,Ncolumns,Nlevels,Nhydro,x)
631	type(cosp_config),intent(in) :: cfg ! Configuration options
632	integer,intent(in) :: Npoints ! Number of sampled points
633	integer,intent(in) :: Ncolumns ! Number of subgrid columns
634	integer,intent(in) :: Nlevels ! Number of model levels
635	integer,intent(in) :: Nhydro ! Number of hydrometeors
636	type(cosp_sgradar),intent(out) :: x
637	! Local variables
638	integer :: i,j,k,l
639
640	if (cfg%Lradar_sim) then
641	i = Npoints
642	j = Ncolumns
643	k = Nlevels
644	l = Nhydro
645	else ! Allocate minumum storage if simulator not used
646	i = 1
647	j = 1
648	k = 1
649	l = 1
650	endif
651
652	! Dimensions
653	x%Npoints = i
654	x%Ncolumns = j
655	x%Nlevels = k
656	x%Nhydro = l
657
658	! --- Allocate arrays ---
659	allocate(x%att_gas(i,k), x%Ze_tot(i,j,k))
660	! --- Initialise to zero ---
661	x%att_gas = 0.0
662	x%Ze_tot = 0.0
663	! The following line give a compilation error on the Met Office NEC
664	! call zero_real(x%Z_hydro, x%att_hydro)
665	! f90: error(666): cosp_types.f90, line nnn:
666	! Actual argument corresponding to dummy
667	! argument of ELEMENTAL subroutine
668	! "zero_real" with INTENET(OUT) attribute
669	! is not array.
670	END SUBROUTINE CONSTRUCT_COSP_SGRADAR
671
672	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
673	!------------------ SUBROUTINE FREE_COSP_SGRADAR ----------------
674	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
675	SUBROUTINE FREE_COSP_SGRADAR(x)
676	type(cosp_sgradar),intent(inout) :: x
677
678	deallocate(x%att_gas, x%Ze_tot)
679	END SUBROUTINE FREE_COSP_SGRADAR
680
681	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
682	!----------- SUBROUTINE CONSTRUCT_COSP_RADARSTATS ---------------
683	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
684	SUBROUTINE CONSTRUCT_COSP_RADARSTATS(cfg,Npoints,Ncolumns,Nlevels,Nhydro,x)
685	type(cosp_config),intent(in) :: cfg ! Configuration options
686	integer,intent(in) :: Npoints ! Number of sampled points
687	integer,intent(in) :: Ncolumns ! Number of subgrid columns
688	integer,intent(in) :: Nlevels ! Number of model levels
689	integer,intent(in) :: Nhydro ! Number of hydrometeors
690	type(cosp_radarstats),intent(out) :: x
691	! Local variables
692	integer :: i,j,k,l
693
694	! Allocate minumum storage if simulator not used
695	if (cfg%Lradar_sim) then
696	i = Npoints
697	j = Ncolumns
698	k = Nlevels
699	l = Nhydro
700	else
701	i = 1
702	j = 1
703	k = 1
704	l = 1
705	endif
706
707	! Dimensions
708	x%Npoints = i
709	x%Ncolumns = j
710	x%Nlevels = k
711	x%Nhydro = l
712
713	! --- Allocate arrays ---
714	allocate(x%cfad_ze(i,DBZE_BINS,k),x%lidar_only_freq_cloud(i,k))
715	allocate(x%radar_lidar_tcc(i))
716	! --- Initialise to zero ---
717	x%cfad_ze = 0.0
718	x%lidar_only_freq_cloud = 0.0
719	x%radar_lidar_tcc = 0.0
720	END SUBROUTINE CONSTRUCT_COSP_RADARSTATS
721
722	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
723	!------------------ SUBROUTINE FREE_COSP_RADARSTATS -------------
724	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
725	SUBROUTINE FREE_COSP_RADARSTATS(x)
726	type(cosp_radarstats),intent(inout) :: x
727
728	deallocate(x%cfad_ze,x%lidar_only_freq_cloud,x%radar_lidar_tcc)
729	END SUBROUTINE FREE_COSP_RADARSTATS
730
731	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
732	!----------- SUBROUTINE CONSTRUCT_COSP_LIDARSTATS ---------------
733	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
734	SUBROUTINE CONSTRUCT_COSP_LIDARSTATS(cfg,Npoints,Ncolumns,Nlevels,Nhydro,Nrefl,x)
735	type(cosp_config),intent(in) :: cfg ! Configuration options
736	integer,intent(in) :: Npoints ! Number of sampled points
737	integer,intent(in) :: Ncolumns ! Number of subgrid columns
738	integer,intent(in) :: Nlevels ! Number of model levels
739	integer,intent(in) :: Nhydro ! Number of hydrometeors
740	integer,intent(in) :: Nrefl ! Number of parasol reflectance
741	type(cosp_lidarstats),intent(out) :: x
742	! Local variables
743	integer :: i,j,k,l,m
744
745	! Allocate minumum storage if simulator not used
746	if (cfg%Llidar_sim) then
747	i = Npoints
748	j = Ncolumns
749	k = Nlevels
750	l = Nhydro
751	m = Nrefl
752	else
753	i = 1
754	j = 1
755	k = 1
756	l = 1
757	m = 1
758	endif
759
760	! Dimensions
761	x%Npoints = i
762	x%Ncolumns = j
763	x%Nlevels = k
764	x%Nhydro = l
765	x%Nrefl = m
766
767	! --- Allocate arrays ---
768	allocate(x%srbval(SR_BINS),x%cfad_sr(i,SR_BINS,k), &
769	x%lidarcld(i,k), x%cldlayer(i,LIDAR_NCAT), x%parasolrefl(i,m))
770	! --- Initialise to zero ---
771	x%srbval = 0.0
772	x%cfad_sr = 0.0
773	x%lidarcld = 0.0
774	x%cldlayer = 0.0
775	x%parasolrefl = 0.0
776	END SUBROUTINE CONSTRUCT_COSP_LIDARSTATS
777
778	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
779	!------------------ SUBROUTINE FREE_COSP_LIDARSTATS -------------
780	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
781	SUBROUTINE FREE_COSP_LIDARSTATS(x)
782	type(cosp_lidarstats),intent(inout) :: x
783
784	deallocate(x%srbval, x%cfad_sr, x%lidarcld, x%cldlayer, x%parasolrefl)
785	END SUBROUTINE FREE_COSP_LIDARSTATS
786
787
788	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
789	!------------- SUBROUTINE CONSTRUCT_COSP_SUBGRID ------------------
790	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
791	SUBROUTINE CONSTRUCT_COSP_SUBGRID(Npoints,Ncolumns,Nlevels,y)
792	integer,intent(in) :: Npoints, & ! Number of gridpoints
793	Ncolumns, & ! Number of columns
794	Nlevels ! Number of levels
795	type(cosp_subgrid),intent(out) :: y
796
797	! Dimensions
798	y%Npoints = Npoints
799	y%Ncolumns = Ncolumns
800	y%Nlevels = Nlevels
801
802	! --- Allocate arrays ---
803	allocate(y%frac_out(Npoints,Ncolumns,Nlevels))
804	if (Ncolumns > 1) then
805	allocate(y%prec_frac(Npoints,Ncolumns,Nlevels))
806	else ! CRM mode, not needed
807	allocate(y%prec_frac(1,1,1))
808	endif
809	! --- Initialise to zero ---
810	y%prec_frac = 0.0
811	y%frac_out = 0.0
812	! The following line gives a compilation error on the Met Office NEC
813	! call zero_real(y%mr_hydro)
814	! f90: error(666): cosp_types.f90, line nnn:
815	! Actual argument corresponding to dummy
816	! argument of ELEMENTAL subroutine
817	! "zero_real" with INTENET(OUT) attribute
818	! is not array.
819
820	END SUBROUTINE CONSTRUCT_COSP_SUBGRID
821
822	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
823	!------------- SUBROUTINE FREE_COSP_SUBGRID -----------------------
824	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
825	SUBROUTINE FREE_COSP_SUBGRID(y)
826	type(cosp_subgrid),intent(inout) :: y
827
828	! --- Deallocate arrays ---
829	deallocate(y%prec_frac, y%frac_out)
830
831	END SUBROUTINE FREE_COSP_SUBGRID
832
833	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
834	!------------- SUBROUTINE CONSTRUCT_COSP_SGHYDRO -----------------
835	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
836	SUBROUTINE CONSTRUCT_COSP_SGHYDRO(Npoints,Ncolumns,Nlevels,Nhydro,y)
837	integer,intent(in) :: Npoints, & ! Number of gridpoints
838	Ncolumns, & ! Number of columns
839	Nhydro, & ! Number of hydrometeors
840	Nlevels ! Number of levels
841	type(cosp_sghydro),intent(out) :: y
842
843	! Dimensions
844	y%Npoints = Npoints
845	y%Ncolumns = Ncolumns
846	y%Nlevels = Nlevels
847	y%Nhydro = Nhydro
848
849	! --- Allocate arrays ---
850	allocate(y%mr_hydro(Npoints,Ncolumns,Nlevels,Nhydro), &
851	y%Reff(Npoints,Ncolumns,Nlevels,Nhydro))
852	! --- Initialise to zero ---
853	y%mr_hydro = 0.0
854	y%Reff = 0.0
855
856	END SUBROUTINE CONSTRUCT_COSP_SGHYDRO
857
858	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
859	!------------- SUBROUTINE FREE_COSP_SGHYDRO -----------------------
860	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
861	SUBROUTINE FREE_COSP_SGHYDRO(y)
862	type(cosp_sghydro),intent(inout) :: y
863
864	! --- Deallocate arrays ---
865	deallocate(y%mr_hydro, y%Reff)
866
867	END SUBROUTINE FREE_COSP_SGHYDRO
868
869	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
870	!------------- SUBROUTINE CONSTRUCT_COSP_GRIDBOX ------------------
871	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
872	SUBROUTINE CONSTRUCT_COSP_GRIDBOX(time,radar_freq,surface_radar,use_mie_tables,use_gas_abs,do_ray,melt_lay,k2, &
873	Npoints,Nlevels,Ncolumns,Nhydro,Nprmts_max_hydro,Naero,Nprmts_max_aero,Npoints_it, &
874	lidar_ice_type,isccp_top_height,isccp_top_height_direction,isccp_overlap,isccp_emsfc_lw, &
875	use_precipitation_fluxes,use_reff, &
876	! RTTOV inputs
877	Plat,Sat,Inst,Nchan,ZenAng,Ichan,SurfEm,co2,ch4,n2o,co,&
878	y)
879	double precision,intent(in) :: time ! Time since start of run [days]
880	real,intent(in) :: radar_freq, & ! Radar frequency [GHz]
881	k2 ! \|K\|^2, -1=use frequency dependent default
882	integer,intent(in) :: &
883	surface_radar, & ! surface=1,spaceborne=0
884	use_mie_tables, & ! use a precomputed lookup table? yes=1,no=0,2=use first column everywhere
885	use_gas_abs, & ! include gaseous absorption? yes=1,no=0
886	do_ray, & ! calculate/output Rayleigh refl=1, not=0
887	melt_lay ! melting layer model off=0, on=1
888	integer,intent(in) :: Npoints ! Number of gridpoints
889	integer,intent(in) :: Nlevels ! Number of levels
890	integer,intent(in) :: Ncolumns ! Number of columns
891	integer,intent(in) :: Nhydro ! Number of hydrometeors
892	integer,intent(in) :: Nprmts_max_hydro ! Max number of parameters for hydrometeor size distributions
893	integer,intent(in) :: Naero ! Number of aerosol species
894	integer,intent(in) :: Nprmts_max_aero ! Max number of parameters for aerosol size distributions
895	integer,intent(in) :: Npoints_it ! Number of gridpoints processed in one iteration
896	integer,intent(in) :: lidar_ice_type ! Ice particle shape in lidar calculations (0=ice-spheres ; 1=ice-non-spherical)
897	integer,intent(in) :: isccp_top_height
898	integer,intent(in) :: isccp_top_height_direction
899	integer,intent(in) :: isccp_overlap
900	real,intent(in) :: isccp_emsfc_lw
901	logical,intent(in) :: use_precipitation_fluxes,use_reff
902	integer,intent(in) :: Plat
903	integer,intent(in) :: Sat
904	integer,intent(in) :: Inst
905	integer,intent(in) :: Nchan
906	integer,intent(in) :: Ichan(Nchan)
907	real,intent(in) :: SurfEm(Nchan)
908	real,intent(in) :: ZenAng
909	real,intent(in) :: co2,ch4,n2o,co
910	type(cosp_gridbox),intent(out) :: y
911
912
913	! local variables
914	integer i, cnt_ice, cnt_liq
915	character*200 :: mie_table_name ! Mie table name
916	real*8 :: delt, deltp
917
918	! Dimensions and scalars
919	y%radar_freq = radar_freq
920	y%surface_radar = surface_radar
921	y%use_mie_tables = use_mie_tables
922	y%use_gas_abs = use_gas_abs
923	y%do_ray = do_ray
924	y%melt_lay = melt_lay
925	y%k2 = k2
926	y%Npoints = Npoints
927	y%Nlevels = Nlevels
928	y%Ncolumns = Ncolumns
929	y%Nhydro = Nhydro
930	y%Nprmts_max_hydro = Nprmts_max_hydro
931	y%Naero = Naero
932	y%Nprmts_max_aero = Nprmts_max_aero
933	y%Npoints_it = Npoints_it
934	y%lidar_ice_type = lidar_ice_type
935	y%isccp_top_height = isccp_top_height
936	y%isccp_top_height_direction = isccp_top_height_direction
937	y%isccp_overlap = isccp_overlap
938	y%isccp_emsfc_lw = isccp_emsfc_lw
939	y%use_precipitation_fluxes = use_precipitation_fluxes
940	y%use_reff = use_reff
941
942	y%time = time
943
944	! RTTOV parameters
945	y%Plat = Plat
946	y%Sat = Sat
947	y%Inst = Inst
948	y%Nchan = Nchan
949	y%ZenAng = ZenAng
950	y%co2 = co2
951	y%ch4 = ch4
952	y%n2o = n2o
953	y%co = co
954
955	! --- Allocate arrays ---
956	! Gridbox information (Npoints,Nlevels)
957	allocate(y%zlev(Npoints,Nlevels), y%zlev_half(Npoints,Nlevels), y%dlev(Npoints,Nlevels), &
958	y%p(Npoints,Nlevels), y%ph(Npoints,Nlevels), y%T(Npoints,Nlevels), &
959	y%q(Npoints,Nlevels), y%sh(Npoints,Nlevels), &
960	y%dtau_s(Npoints,Nlevels), y%dtau_c(Npoints,Nlevels), &
961	y%dem_s(Npoints,Nlevels), y%dem_c(Npoints,Nlevels), &
962	y%tca(Npoints,Nlevels), y%cca(Npoints,Nlevels), &
963	y%rain_ls(Npoints,Nlevels), y%rain_cv(Npoints,Nlevels), y%grpl_ls(Npoints,Nlevels), &
964	y%snow_ls(Npoints,Nlevels), y%snow_cv(Npoints,Nlevels),y%mr_ozone(Npoints,Nlevels))
965
966
967	! Surface information and geolocation (Npoints)
968	allocate(y%longitude(Npoints),y%latitude(Npoints),y%psfc(Npoints), y%land(Npoints), &
969	y%sunlit(Npoints),y%skt(Npoints),y%sfc_height(Npoints),y%u_wind(Npoints),y%v_wind(Npoints))
970	! Hydrometeors concentration and distribution parameters
971	allocate(y%mr_hydro(Npoints,Nlevels,Nhydro), &
972	y%dist_prmts_hydro(Nprmts_max_hydro,Nhydro), &
973	y%Reff(Npoints,Nlevels,Nhydro))
974	! Aerosols concentration and distribution parameters
975	allocate(y%conc_aero(Npoints,Nlevels,Naero), y%dist_type_aero(Naero), &
976	y%dist_prmts_aero(Npoints,Nlevels,Nprmts_max_aero,Naero))
977
978	! RTTOV channels and sfc. emissivity
979	allocate(y%ichan(Nchan),y%surfem(Nchan))
980
981	! RTTOV parameters
982	y%ichan = ichan
983	y%surfem = surfem
984
985	! --- Initialise to zero ---
986	y%zlev = 0.0
987	y%zlev_half = 0.0
988	y%dlev = 0.0
989	y%p = 0.0
990	y%ph = 0.0
991	y%T = 0.0
992	y%q = 0.0
993	y%sh = 0.0
994	y%dtau_s = 0.0
995	y%dtau_c = 0.0
996	y%dem_s = 0.0
997	y%dem_c = 0.0
998	y%tca = 0.0
999	y%cca = 0.0
1000	y%rain_ls = 0.0
1001	y%rain_cv = 0.0
1002	y%grpl_ls = 0.0
1003	y%snow_ls = 0.0
1004	y%snow_cv = 0.0
1005	y%Reff = 0.0
1006	y%mr_ozone = 0.0
1007	y%u_wind = 0.0
1008	y%v_wind = 0.0
1009
1010
1011	! (Npoints)
1012	! call zero_real(y%psfc, y%land)
1013	y%longitude = 0.0
1014	y%latitude = 0.0
1015	y%psfc = 0.0
1016	y%land = 0.0
1017	y%sunlit = 0.0
1018	y%skt = 0.0
1019	y%sfc_height = 0.0
1020	! (Npoints,Nlevels,Nhydro)
1021	! y%fr_hydro = 0.0
1022	y%mr_hydro = 0.0
1023	! Others
1024	y%dist_prmts_hydro = 0.0 ! (Nprmts_max_hydro,Nhydro)
1025	y%conc_aero = 0.0 ! (Npoints,Nlevels,Naero)
1026	y%dist_type_aero = 0 ! (Naero)
1027	y%dist_prmts_aero = 0.0 ! (Npoints,Nlevels,Nprmts_max_aero,Naero)
1028
1029	y%hp%p1 = 0.0
1030	y%hp%p2 = 0.0
1031	y%hp%p3 = 0.0
1032	y%hp%dmin = 0.0
1033	y%hp%dmax = 0.0
1034	y%hp%apm = 0.0
1035	y%hp%bpm = 0.0
1036	y%hp%rho = 0.0
1037	y%hp%dtype = 0
1038	y%hp%col = 0
1039	y%hp%cp = 0
1040	y%hp%phase = 0
1041	y%hp%scaled = .false.
1042	y%hp%z_flag = .false.
1043	y%hp%Ze_scaled = 0.0
1044	y%hp%Zr_scaled = 0.0
1045	y%hp%kr_scaled = 0.0
1046	y%hp%fc = 0.0
1047	y%hp%rho_eff = 0.0
1048	y%hp%ifc = 0
1049	y%hp%idd = 0
1050	y%mt%freq = 0.0
1051	y%mt%tt = 0.0
1052	y%mt%f = 0.0
1053	y%mt%D = 0.0
1054	y%mt%qext = 0.0
1055	y%mt%qbsca = 0.0
1056	y%mt%phase = 0
1057
1058
1059	! --- Initialize the distributional parameters for hydrometeors
1060	y%dist_prmts_hydro( 1,:) = HCLASS_TYPE(:)
1061	y%dist_prmts_hydro( 2,:) = HCLASS_COL(:)
1062	y%dist_prmts_hydro( 3,:) = HCLASS_PHASE(:)
1063	y%dist_prmts_hydro( 4,:) = HCLASS_CP(:)
1064	y%dist_prmts_hydro( 5,:) = HCLASS_DMIN(:)
1065	y%dist_prmts_hydro( 6,:) = HCLASS_DMAX(:)
1066	y%dist_prmts_hydro( 7,:) = HCLASS_APM(:)
1067	y%dist_prmts_hydro( 8,:) = HCLASS_BPM(:)
1068	y%dist_prmts_hydro( 9,:) = HCLASS_RHO(:)
1069	y%dist_prmts_hydro(10,:) = HCLASS_P1(:)
1070	y%dist_prmts_hydro(11,:) = HCLASS_P2(:)
1071	y%dist_prmts_hydro(12,:) = HCLASS_P3(:)
1072
1073	! the following code added by roj to initialize structures used by radar simulator, Feb 2008
1074	call load_hydrometeor_classes(y%Nprmts_max_hydro,y%dist_prmts_hydro(:,:),y%hp,y%Nhydro)
1075
1076	! load mie tables ?
1077	if (y%use_mie_tables == 1) then
1078
1079	! ----- Mie tables ----
1080	mie_table_name='mie_table.dat'
1081	call load_mie_table(mie_table_name,y%mt)
1082
1083	! :: D specified by table ... not must match that used when mie LUT generated!
1084	y%nsizes = mt_nd
1085	allocate(y%D(y%nsizes))
1086	y%D = y%mt%D
1087
1088	else
1089	! otherwise we still need to initialize temperature arrays for Ze scaling (which is only done when not using mie table)
1090
1091	cnt_ice=19
1092	cnt_liq=20
1093	if (.not.(allocated(mt_ttl).and.allocated(mt_tti))) then
1094	allocate(mt_ttl(cnt_liq),mt_tti(cnt_ice)) ! note needed as this is global array ...
1095	! which should be changed in the future
1096	endif
1097
1098	do i=1,cnt_ice
1099	mt_tti(i)=(i-1)*5-90
1100	enddo
1101
1102	do i=1,cnt_liq
1103	mt_ttl(i)=(i-1)*5 - 60
1104	enddo
1105
1106	allocate(y%mt_ttl(cnt_liq),y%mt_tti(cnt_ice))
1107
1108	y%mt_ttl = mt_ttl
1109	y%mt_tti = mt_tti
1110
1111	! !------ OLD code in v0.1 ---------------------------
1112	! allocate(mt_ttl(2),mt_tti(2))
1113	! allocate(y%mt_ttl(2),y%mt_tti(2))
1114	! mt_ttl = 0.0
1115	! mt_tti = 0.0
1116	! y%mt_ttl = mt_ttl
1117	! y%mt_tti = mt_tti
1118	! !---------------------------------------------------
1119
1120	! :: D created on a log-linear scale
1121	y%nsizes = nd
1122	delt = (log(dmax)-log(dmin))/(y%nsizes-1)
1123	deltp = exp(delt)
1124	allocate(y%D(y%nsizes))
1125	y%D(1) = dmin
1126	do i=2,y%nsizes
1127	y%D(i) = y%D(i-1)*deltp
1128	enddo
1129
1130	endif
1131
1132
1133	END SUBROUTINE CONSTRUCT_COSP_GRIDBOX
1134
1135
1136	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1137	!------------- SUBROUTINE FREE_COSP_GRIDBOX -----------------------
1138	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1139	SUBROUTINE FREE_COSP_GRIDBOX(y,dglobal)
1140	type(cosp_gridbox),intent(inout) :: y
1141	logical,intent(in),optional :: dglobal
1142
1143	! --- Free arrays ---
1144	deallocate(y%D,y%mt_ttl,y%mt_tti) ! added by roj Feb 2008
1145	if (.not.present(dglobal)) deallocate(mt_ttl,mt_tti)
1146
1147	! deallocate(y%hp%p1,y%hp%p2,y%hp%p3,y%hp%dmin,y%hp%dmax,y%hp%apm,y%hp%bpm,y%hp%rho, &
1148	! y%hp%dtype,y%hp%col,y%hp%cp,y%hp%phase,y%hp%scaled, &
1149	! y%hp%z_flag,y%hp%Ze_scaled,y%hp%Zr_scaled,y%hp%kr_scaled, &
1150	! y%hp%fc, y%hp%rho_eff, y%hp%ifc, y%hp%idd)
1151	! deallocate(y%mt%freq, y%mt%tt, y%mt%f, y%mt%D, y%mt%qext, y%mt%qbsca, y%mt%phase)
1152
1153	deallocate(y%zlev, y%zlev_half, y%dlev, y%p, y%ph, y%T, y%q, &
1154	y%sh, y%dtau_s, y%dtau_c, y%dem_s, y%dem_c, &
1155	y%longitude,y%latitude,y%psfc, y%land, y%tca, y%cca, &
1156	y%mr_hydro, y%dist_prmts_hydro, &
1157	y%conc_aero, y%dist_type_aero, y%dist_prmts_aero, &
1158	y%rain_ls, y%rain_cv, y%snow_ls, y%snow_cv, y%grpl_ls, &
1159	y%sunlit, y%skt, y%sfc_height, y%Reff,y%ichan,y%surfem, &
1160	y%mr_ozone,y%u_wind,y%v_wind)
1161
1162	END SUBROUTINE FREE_COSP_GRIDBOX
1163
1164
1165	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1166	!------------- SUBROUTINE COSP_GRIDBOX_CPHP ----------------------
1167	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1168	SUBROUTINE COSP_GRIDBOX_CPHP(x,y)
1169	type(cosp_gridbox),intent(in) :: x
1170	type(cosp_gridbox),intent(inout) :: y
1171
1172	integer :: i,j,k,sz(3)
1173	double precision :: tny
1174
1175	tny = tiny(tny)
1176	y%hp%p1 = x%hp%p1
1177	y%hp%p2 = x%hp%p2
1178	y%hp%p3 = x%hp%p3
1179	y%hp%dmin = x%hp%dmin
1180	y%hp%dmax = x%hp%dmax
1181	y%hp%apm = x%hp%apm
1182	y%hp%bpm = x%hp%bpm
1183	y%hp%rho = x%hp%rho
1184	y%hp%dtype = x%hp%dtype
1185	y%hp%col = x%hp%col
1186	y%hp%cp = x%hp%cp
1187	y%hp%phase = x%hp%phase
1188
1189	y%hp%fc = x%hp%fc
1190	y%hp%rho_eff = x%hp%rho_eff
1191	y%hp%ifc = x%hp%ifc
1192	y%hp%idd = x%hp%idd
1193	sz = shape(x%hp%z_flag)
1194	do k=1,sz(3)
1195	do j=1,sz(2)
1196	do i=1,sz(1)
1197	if (x%hp%scaled(i,k)) y%hp%scaled(i,k) = .true.
1198	if (x%hp%z_flag(i,j,k)) y%hp%z_flag(i,j,k) = .true.
1199	if (abs(x%hp%Ze_scaled(i,j,k)) > tny) y%hp%Ze_scaled(i,j,k) = x%hp%Ze_scaled(i,j,k)
1200	if (abs(x%hp%Zr_scaled(i,j,k)) > tny) y%hp%Zr_scaled(i,j,k) = x%hp%Zr_scaled(i,j,k)
1201	if (abs(x%hp%kr_scaled(i,j,k)) > tny) y%hp%kr_scaled(i,j,k) = x%hp%kr_scaled(i,j,k)
1202	enddo
1203	enddo
1204	enddo
1205
1206	END SUBROUTINE COSP_GRIDBOX_CPHP
1207
1208	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1209	!------------- SUBROUTINE COSP_GRIDBOX_CPSECTION -----------------
1210	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1211	SUBROUTINE COSP_GRIDBOX_CPSECTION(ix,iy,x,y)
1212	integer,intent(in),dimension(2) :: ix,iy
1213	type(cosp_gridbox),intent(in) :: x
1214	type(cosp_gridbox),intent(inout) :: y
1215
1216	integer :: i,j,k,sz(3)
1217
1218	! --- Copy arrays without Npoints as dimension ---
1219	y%dist_prmts_hydro = x%dist_prmts_hydro
1220	y%dist_type_aero = x%dist_type_aero
1221	y%D = x%D
1222	y%mt_ttl = x%mt_ttl
1223	y%mt_tti = x%mt_tti
1224
1225
1226	! call cosp_gridbox_cphp(x,y)
1227
1228	! 1D
1229	y%longitude(iy(1):iy(2)) = x%longitude(ix(1):ix(2))
1230	y%latitude(iy(1):iy(2)) = x%latitude(ix(1):ix(2))
1231	y%psfc(iy(1):iy(2)) = x%psfc(ix(1):ix(2))
1232	y%land(iy(1):iy(2)) = x%land(ix(1):ix(2))
1233	y%sunlit(iy(1):iy(2)) = x%sunlit(ix(1):ix(2))
1234	y%skt(iy(1):iy(2)) = x%skt(ix(1):ix(2))
1235	y%sfc_height(iy(1):iy(2)) = x%sfc_height(ix(1):ix(2))
1236	y%u_wind(iy(1):iy(2)) = x%u_wind(ix(1):ix(2))
1237	y%v_wind(iy(1):iy(2)) = x%v_wind(ix(1):ix(2))
1238	! 2D
1239	y%zlev(iy(1):iy(2),:) = x%zlev(ix(1):ix(2),:)
1240	y%zlev_half(iy(1):iy(2),:) = x%zlev_half(ix(1):ix(2),:)
1241	y%dlev(iy(1):iy(2),:) = x%dlev(ix(1):ix(2),:)
1242	y%p(iy(1):iy(2),:) = x%p(ix(1):ix(2),:)
1243	y%ph(iy(1):iy(2),:) = x%ph(ix(1):ix(2),:)
1244	y%T(iy(1):iy(2),:) = x%T(ix(1):ix(2),:)
1245	y%q(iy(1):iy(2),:) = x%q(ix(1):ix(2),:)
1246	y%sh(iy(1):iy(2),:) = x%sh(ix(1):ix(2),:)
1247	y%dtau_s(iy(1):iy(2),:) = x%dtau_s(ix(1):ix(2),:)
1248	y%dtau_c(iy(1):iy(2),:) = x%dtau_c(ix(1):ix(2),:)
1249	y%dem_s(iy(1):iy(2),:) = x%dem_s(ix(1):ix(2),:)
1250	y%dem_c(iy(1):iy(2),:) = x%dem_c(ix(1):ix(2),:)
1251	y%tca(iy(1):iy(2),:) = x%tca(ix(1):ix(2),:)
1252	y%cca(iy(1):iy(2),:) = x%cca(ix(1):ix(2),:)
1253	y%rain_ls(iy(1):iy(2),:) = x%rain_ls(ix(1):ix(2),:)
1254	y%rain_cv(iy(1):iy(2),:) = x%rain_cv(ix(1):ix(2),:)
1255	y%grpl_ls(iy(1):iy(2),:) = x%grpl_ls(ix(1):ix(2),:)
1256	y%snow_ls(iy(1):iy(2),:) = x%snow_ls(ix(1):ix(2),:)
1257	y%snow_cv(iy(1):iy(2),:) = x%snow_cv(ix(1):ix(2),:)
1258	y%mr_ozone(iy(1):iy(2),:) = x%mr_ozone(ix(1):ix(2),:)
1259	! 3D
1260	y%Reff(iy(1):iy(2),:,:) = x%Reff(ix(1):ix(2),:,:)
1261	y%conc_aero(iy(1):iy(2),:,:) = x%conc_aero(ix(1):ix(2),:,:)
1262	y%mr_hydro(iy(1):iy(2),:,:) = x%mr_hydro(ix(1):ix(2),:,:)
1263	! 4D
1264	y%dist_prmts_aero(iy(1):iy(2),:,:,:) = x%dist_prmts_aero(ix(1):ix(2),:,:,:)
1265
1266	END SUBROUTINE COSP_GRIDBOX_CPSECTION
1267
1268	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1269	!------------- SUBROUTINE COSP_SUBGRID_CPSECTION -----------------
1270	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1271	SUBROUTINE COSP_SUBGRID_CPSECTION(ix,iy,x,y)
1272	integer,intent(in),dimension(2) :: ix,iy
1273	type(cosp_subgrid),intent(in) :: x
1274	type(cosp_subgrid),intent(inout) :: y
1275
1276	y%prec_frac(iy(1):iy(2),:,:) = x%prec_frac(ix(1):ix(2),:,:)
1277	y%frac_out(iy(1):iy(2),:,:) = x%frac_out(ix(1):ix(2),:,:)
1278	END SUBROUTINE COSP_SUBGRID_CPSECTION
1279
1280	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1281	!------------- SUBROUTINE COSP_SGRADAR_CPSECTION -----------------
1282	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1283	SUBROUTINE COSP_SGRADAR_CPSECTION(ix,iy,x,y)
1284	integer,intent(in),dimension(2) :: ix,iy
1285	type(cosp_sgradar),intent(in) :: x
1286	type(cosp_sgradar),intent(inout) :: y
1287
1288	y%att_gas(iy(1):iy(2),:) = x%att_gas(ix(1):ix(2),:)
1289	y%Ze_tot(iy(1):iy(2),:,:) = x%Ze_tot(ix(1):ix(2),:,:)
1290	END SUBROUTINE COSP_SGRADAR_CPSECTION
1291
1292	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1293	!------------- SUBROUTINE COSP_SGLIDAR_CPSECTION -----------------
1294	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1295	SUBROUTINE COSP_SGLIDAR_CPSECTION(ix,iy,x,y)
1296	integer,intent(in),dimension(2) :: ix,iy
1297	type(cosp_sglidar),intent(in) :: x
1298	type(cosp_sglidar),intent(inout) :: y
1299
1300	y%beta_mol(iy(1):iy(2),:) = x%beta_mol(ix(1):ix(2),:)
1301	y%beta_tot(iy(1):iy(2),:,:) = x%beta_tot(ix(1):ix(2),:,:)
1302	y%tau_tot(iy(1):iy(2),:,:) = x%tau_tot(ix(1):ix(2),:,:)
1303	y%refl(iy(1):iy(2),:,:) = x%refl(ix(1):ix(2),:,:)
1304	END SUBROUTINE COSP_SGLIDAR_CPSECTION
1305
1306	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1307	!------------- SUBROUTINE COSP_ISCCP_CPSECTION -----------------
1308	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1309	SUBROUTINE COSP_ISCCP_CPSECTION(ix,iy,x,y)
1310	integer,intent(in),dimension(2) :: ix,iy
1311	type(cosp_isccp),intent(in) :: x
1312	type(cosp_isccp),intent(inout) :: y
1313
1314	y%fq_isccp(iy(1):iy(2),:,:) = x%fq_isccp(ix(1):ix(2),:,:)
1315	y%totalcldarea(iy(1):iy(2)) = x%totalcldarea(ix(1):ix(2))
1316	y%meantb(iy(1):iy(2)) = x%meantb(ix(1):ix(2))
1317	y%meantbclr(iy(1):iy(2)) = x%meantbclr(ix(1):ix(2))
1318	y%meanptop(iy(1):iy(2)) = x%meanptop(ix(1):ix(2))
1319	y%meantaucld(iy(1):iy(2)) = x%meantaucld(ix(1):ix(2))
1320	y%meanalbedocld(iy(1):iy(2)) = x%meanalbedocld(ix(1):ix(2))
1321	y%boxtau(iy(1):iy(2),:) = x%boxtau(ix(1):ix(2),:)
1322	y%boxptop(iy(1):iy(2),:) = x%boxptop(ix(1):ix(2),:)
1323	END SUBROUTINE COSP_ISCCP_CPSECTION
1324
1325
1326	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1327	!------------- SUBROUTINE COSP_MISR_CPSECTION -----------------
1328	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1329	SUBROUTINE COSP_MISR_CPSECTION(ix,iy,x,y)
1330	integer,intent(in),dimension(2) :: ix,iy
1331	type(cosp_misr),intent(in) :: x
1332	type(cosp_misr),intent(inout) :: y
1333
1334	y%fq_MISR(iy(1):iy(2),:,:) = x%fq_MISR(ix(1):ix(2),:,:)
1335	y%MISR_meanztop(iy(1):iy(2)) = x%MISR_meanztop(ix(1):ix(2))
1336	y%MISR_cldarea(iy(1):iy(2)) = x%MISR_cldarea(ix(1):ix(2))
1337	y%MISR_dist_model_layertops(iy(1):iy(2),:) = x%MISR_dist_model_layertops(ix(1):ix(2),:)
1338	END SUBROUTINE COSP_MISR_CPSECTION
1339
1340	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1341	!------------- SUBROUTINE COSP_RTTOV_CPSECTION -------------------
1342	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1343	SUBROUTINE COSP_RTTOV_CPSECTION(ix,iy,x,y)
1344	integer,intent(in),dimension(2) :: ix,iy
1345	type(cosp_rttov),intent(in) :: x
1346	type(cosp_rttov),intent(inout) :: y
1347
1348	y%tbs(iy(1):iy(2),:) = x%tbs(ix(1):ix(2),:)
1349	END SUBROUTINE COSP_RTTOV_CPSECTION
1350
1351	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1352	!------------- SUBROUTINE COSP_RADARSTATS_CPSECTION --------------
1353	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1354	SUBROUTINE COSP_RADARSTATS_CPSECTION(ix,iy,x,y)
1355	integer,intent(in),dimension(2) :: ix,iy
1356	type(cosp_radarstats),intent(in) :: x
1357	type(cosp_radarstats),intent(inout) :: y
1358
1359	y%cfad_ze(iy(1):iy(2),:,:) = x%cfad_ze(ix(1):ix(2),:,:)
1360	y%radar_lidar_tcc(iy(1):iy(2)) = x%radar_lidar_tcc(ix(1):ix(2))
1361	y%lidar_only_freq_cloud(iy(1):iy(2),:) = x%lidar_only_freq_cloud(ix(1):ix(2),:)
1362	END SUBROUTINE COSP_RADARSTATS_CPSECTION
1363
1364	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1365	!------------- SUBROUTINE COSP_LIDARSTATS_CPSECTION --------------
1366	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1367	SUBROUTINE COSP_LIDARSTATS_CPSECTION(ix,iy,x,y)
1368	integer,intent(in),dimension(2) :: ix,iy
1369	type(cosp_lidarstats),intent(in) :: x
1370	type(cosp_lidarstats),intent(inout) :: y
1371
1372	y%srbval = x%srbval
1373	y%cfad_sr(iy(1):iy(2),:,:) = x%cfad_sr(ix(1):ix(2),:,:)
1374	y%lidarcld(iy(1):iy(2),:) = x%lidarcld(ix(1):ix(2),:)
1375	y%cldlayer(iy(1):iy(2),:) = x%cldlayer(ix(1):ix(2),:)
1376	y%parasolrefl(iy(1):iy(2),:) = x%parasolrefl(ix(1):ix(2),:)
1377	END SUBROUTINE COSP_LIDARSTATS_CPSECTION
1378
1379	END MODULE MOD_COSP_TYPES

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

Download in other formats:

Original Format