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