Line data Source code
1 : module cospsimulator_intr
2 : ! ######################################################################################
3 : ! Purpose: CAM interface to
4 : ! Name: CFMIP Observational Simulator Package Version 2 (COSP2)
5 : ! What: Simulate ISCCP/CloudSat/CALIPSO/MISR/MODIS cloud products from
6 : ! GCM inputs
7 : ! Version: v2.1.4 (August 2019)
8 : ! Authors: Dustin Swales (dustin.swales@noaa.gov)
9 : !
10 : ! Modifications:
11 : !
12 : ! ######################################################################################
13 : use shr_kind_mod, only: r8 => shr_kind_r8
14 : use spmd_utils, only: masterproc
15 : use ppgrid, only: pcols, pver, pverp, begchunk, endchunk
16 : use perf_mod, only: t_startf, t_stopf
17 : use cam_abortutils, only: endrun
18 : use phys_control, only: cam_physpkg_is
19 : use cam_logfile, only: iulog
20 : #ifdef USE_COSP
21 : use quickbeam, only: radar_cfg
22 : use mod_quickbeam_optics, only: size_distribution
23 : use mod_cosp, only: cosp_outputs,cosp_optical_inputs,cosp_column_inputs
24 : use mod_cosp_config, only: pres_binCenters, pres_binEdges, tau_binCenters, &
25 : tau_binEdges, cloudsat_binCenters, cloudsat_binEdges, calipso_binCenters, &
26 : calipso_binEdges, misr_histHgtCenters, misr_histHgtEdges, PARASOL_SZA, &
27 : R_UNDEF, PARASOL_NREFL, LIDAR_NCAT,SR_BINS, N_HYDRO, RTTOV_MAX_CHANNELS, &
28 : numMISRHgtBins, CLOUDSAT_DBZE_BINS, LIDAR_NTEMP, calipso_histBsct, &
29 : numMODISTauBins, numMODISPresBins, numMODISReffIceBins, numMODISReffLiqBins, &
30 : numISCCPTauBins, numISCCPPresBins, numMISRTauBins, reffICE_binEdges, &
31 : reffICE_binCenters, reffLIQ_binEdges, reffLIQ_binCenters, LIDAR_NTYPE, &
32 : nCloudsatPrecipClass, &
33 : nsza_cosp => PARASOL_NREFL, &
34 : nprs_cosp => npres, &
35 : ntau_cosp => ntau, &
36 : ntau_cosp_modis => ntau, &
37 : nsr_cosp => SR_BINS, &
38 : nhtmisr_cosp => numMISRHgtBins, &
39 : nhydro => N_HYDRO, &
40 : cloudsat_preclvl
41 : use mod_cosp_stats, only: cosp_change_vertical_grid
42 : #endif
43 : implicit none
44 : private
45 : save
46 :
47 : ! Public functions/subroutines
48 : public :: &
49 : cospsimulator_intr_readnl, &
50 : cospsimulator_intr_register,&
51 : cospsimulator_intr_init, &
52 : cospsimulator_intr_run
53 :
54 : ! ######################################################################################
55 : ! Public declarations
56 : ! ######################################################################################
57 : ! Whether to do COSP calcs and I/O, default is false. If docosp is specified in
58 : ! the atm_in namelist, this value is overwritten and cosp is run
59 : logical, public :: docosp = .false.
60 :
61 : ! Frequency at which cosp is called, every cosp_nradsteps radiation timestep
62 : integer, public :: cosp_nradsteps = 1! CAM namelist variable default, not in COSP namelist
63 :
64 : #ifdef USE_COSP
65 :
66 : ! ######################################################################################
67 : ! Local declarations
68 : ! ######################################################################################
69 : integer, parameter :: &
70 : nhtml_cosp = pver ! Mumber of model levels is pver
71 : integer :: &
72 : nscol_cosp, & ! Number of subcolumns, use namelist input Ncolumns to set.
73 : nht_cosp ! Number of height for COSP radar and calipso simulator outputs.
74 : ! *set to 40 if csat_vgrid=.true., else set to Nlr*
75 :
76 : ! ######################################################################################
77 : ! Bin-boundaries for mixed dimensions. Calculated in cospsetupvales OR in cosp_config.F90
78 : ! ######################################################################################
79 : real(r8), target :: prsmid_cosp(nprs_cosp) ! pressure midpoints of COSP ISCCP output
80 : real(r8), target :: prslim_cosp(2,nprs_cosp)
81 : real(r8), target :: taumid_cosp(ntau_cosp) ! optical depth midpoints of COSP ISCCP output
82 : real(r8), target :: taulim_cosp(2,ntau_cosp)
83 : real(r8), target :: srmid_cosp(nsr_cosp) ! sr midpoints of COSP lidar output
84 : real(r8), target :: srlim_cosp(2,nsr_cosp)
85 : real(r8), target :: sza_cosp(nsza_cosp)
86 : real(r8), target :: dbzemid_cosp(CLOUDSAT_DBZE_BINS) ! dbze midpoints of COSP radar output
87 : real(r8), target :: dbzelim_cosp(2,CLOUDSAT_DBZE_BINS)
88 : real(r8), target :: htmisrmid_cosp(nhtmisr_cosp) ! htmisr midpoints of COSP misr simulator output
89 : real(r8), target :: htmisrlim_cosp(2,nhtmisr_cosp)
90 : real(r8), target :: taumid_cosp_modis(ntau_cosp_modis)! optical depth midpoints of COSP MODIS output
91 : real(r8), target :: taulim_cosp_modis(2,ntau_cosp_modis)
92 : real(r8), target :: reffICE_binEdges_cosp(2,numMODISReffIceBins)
93 : real(r8), target :: reffLIQ_binEdges_cosp(2,numMODISReffLiqBins)
94 : real(r8), target :: reffICE_binCenters_cosp(numMODISReffIceBins)
95 : real(r8), target :: reffLIQ_binCenters_cosp(numMODISReffLiqBins)
96 :
97 : real(r8) :: htmlmid_cosp(nhtml_cosp) ! Model level height midpoints for output
98 : integer :: prstau_cosp(nprs_cosp*ntau_cosp) ! ISCCP mixed output dimension index
99 : integer :: prstau_cosp_modis(nprs_cosp*ntau_cosp_modis) ! MODIS mixed output dimension index
100 : integer :: htmisrtau_cosp(nhtmisr_cosp*ntau_cosp) ! MISR mixed output dimension index
101 : real(r8) :: prstau_prsmid_cosp(nprs_cosp*ntau_cosp)
102 : real(r8) :: prstau_taumid_cosp(nprs_cosp*ntau_cosp)
103 : real(r8) :: prstau_prsmid_cosp_modis(nprs_cosp*ntau_cosp_modis)
104 : real(r8) :: prstau_taumid_cosp_modis(nprs_cosp*ntau_cosp_modis)
105 : real(r8) :: htmisrtau_htmisrmid_cosp(nhtmisr_cosp*ntau_cosp)
106 : real(r8) :: htmisrtau_taumid_cosp(nhtmisr_cosp*ntau_cosp)
107 : real(r8),allocatable, public :: htdbze_dbzemid_cosp(:) ! (nht_cosp*CLOUDSAT_DBZE_BINS)
108 : real(r8),allocatable, target :: htlim_cosp(:,:) ! height limits for COSP outputs (nht_cosp+1)
109 : real(r8),allocatable, target :: htmid_cosp(:) ! height midpoints of COSP radar/lidar output (nht_cosp)
110 : real(r8),allocatable :: htlim_cosp_1d(:) ! height limits for COSP outputs (nht_cosp+1)
111 : real(r8),allocatable :: htdbze_htmid_cosp(:) ! (nht_cosp*CLOUDSAT_DBZE_BINS)
112 : real(r8),allocatable :: htsr_htmid_cosp(:) ! (nht_cosp*nsr_cosp)
113 : real(r8),allocatable :: htsr_srmid_cosp(:) ! (nht_cosp*nsr_cosp)
114 : real(r8),allocatable :: htmlscol_htmlmid_cosp(:) ! (nhtml_cosp*nscol_cosp)
115 : real(r8),allocatable :: htmlscol_scol_cosp(:) ! (nhtml_cosp*nscol_cosp)
116 : integer, allocatable, target :: scol_cosp(:) ! sub-column number (nscol_cosp)
117 : integer, allocatable :: htdbze_cosp(:) ! radar CFAD mixed output dimension index (nht_cosp*CLOUDSAT_DBZE_BINS)
118 : integer, allocatable :: htsr_cosp(:) ! lidar CFAD mixed output dimension index (nht_cosp*nsr_cosp)
119 : integer, allocatable :: htmlscol_cosp(:) ! html-subcolumn mixed output dimension index (nhtml_cosp*nscol_cosp)
120 :
121 : ! ######################################################################################
122 : ! Default namelists
123 : ! The CAM and COSP namelists defaults are set below. Some of the COSP namelist
124 : ! variables are part of the CAM namelist - they all begin with "cosp_" to keep their
125 : ! names specific to COSP. I set their CAM namelist defaults here, not in namelist_defaults_cam.xml
126 : ! Variables identified as namelist variables are defined in
127 : ! ../models/atm/cam/bld/namelist_files/namelist_definition.xml
128 : ! ######################################################################################
129 : ! CAM
130 : logical :: cosp_amwg = .false. ! CAM namelist variable default, not in COSP namelist
131 : logical :: cosp_lite = .false. ! CAM namelist variable default, not in COSP namelist
132 : logical :: cosp_passive = .false. ! CAM namelist variable default, not in COSP namelist
133 : logical :: cosp_active = .false. ! CAM namelist variable default, not in COSP namelist
134 : logical :: cosp_isccp = .false. ! CAM namelist variable default, not in COSP namelist
135 : logical :: cosp_lradar_sim = .false. ! CAM namelist variable default
136 : logical :: cosp_llidar_sim = .false. ! CAM namelist variable default
137 : logical :: cosp_lisccp_sim = .false. ! CAM namelist variable default
138 : logical :: cosp_lmisr_sim = .false. ! CAM namelist variable default
139 : logical :: cosp_lmodis_sim = .false. ! CAM namelist variable default
140 : logical :: cosp_histfile_aux = .false. ! CAM namelist variable default
141 : logical :: cosp_lfrac_out = .false. ! CAM namelist variable default
142 : logical :: cosp_runall = .false. ! flag to run all of the cosp simulator package
143 : integer :: cosp_ncolumns = 50 ! CAM namelist variable default
144 : integer :: cosp_histfile_num =1 ! CAM namelist variable default, not in COSP namelist
145 : integer :: cosp_histfile_aux_num =-1 ! CAM namelist variable default, not in COSP namelist
146 :
147 : ! COSP
148 : logical :: lradar_sim = .false. ! COSP namelist variable, can be changed from default by CAM namelist
149 : logical :: llidar_sim = .false. !
150 : logical :: lparasol_sim = .false. !
151 : logical :: lgrLidar532 = .false. !
152 : logical :: latlid = .false. !
153 : logical :: lisccp_sim = .false. ! ""
154 : logical :: lmisr_sim = .false. ! ""
155 : logical :: lmodis_sim = .false. ! ""
156 : logical :: lrttov_sim = .false. ! not running rttov, always set to .false.
157 : logical :: lfrac_out = .false. ! COSP namelist variable, can be changed from default by CAM namelist
158 :
159 : ! ######################################################################################
160 : ! COSP parameters
161 : ! ######################################################################################
162 : ! Note: Unless otherwise specified, these are parameters that cannot be set by the CAM namelist.
163 : integer, parameter :: Npoints_it = 10000 ! Max # gridpoints to be processed in one iteration (10,000)
164 : integer :: ncolumns = 50 ! Number of subcolumns in SCOPS (50), can be changed from default by CAM namelist
165 : integer :: nlr = 40 ! Number of levels in statistical outputs
166 : ! (only used if USE_VGRID=.true.) (40)
167 : logical :: use_vgrid = .true. ! Use fixed vertical grid for outputs?
168 : ! (if .true. then define # of levels with nlr) (.true.)
169 : logical :: csat_vgrid = .true. ! CloudSat vertical grid?
170 : ! (if .true. then the CloudSat standard grid is used.
171 : ! If set, overides use_vgrid.) (.true.)
172 : ! namelist variables for COSP input related to radar simulator
173 : real(r8) :: radar_freq = 94.0_r8 ! CloudSat radar frequency (GHz) (94.0)
174 : integer :: surface_radar = 0 ! surface=1, spaceborne=0 (0)
175 : integer :: use_mie_tables = 0 ! use a precomputed lookup table? yes=1,no=0 (0)
176 : integer :: use_gas_abs = 1 ! include gaseous absorption? yes=1,no=0 (1)
177 : integer :: do_ray = 0 ! calculate/output Rayleigh refl=1, not=0 (0)
178 : integer :: melt_lay = 0 ! melting layer model off=0, on=1 (0)
179 : real(r8) :: k2 = -1 ! |K|^2, -1=use frequency dependent default (-1)
180 : ! namelist variables for COSP input related to lidar simulator
181 : integer, parameter :: Nprmts_max_hydro = 12 ! Max # params for hydrometeor size distributions (12)
182 : integer, parameter :: Naero = 1 ! Number of aerosol species (Not used) (1)
183 : integer, parameter :: Nprmts_max_aero = 1 ! Max # params for aerosol size distributions (not used) (1)
184 : integer :: lidar_ice_type = 0 ! Ice particle shape in lidar calculations
185 : ! (0=ice-spheres ; 1=ice-non-spherical) (0)
186 : integer, parameter :: overlap = 3 ! overlap type: 1=max, 2=rand, 3=max/rand (3)
187 :
188 : !! namelist variables for COSP input related to ISCCP simulator
189 : integer :: isccp_topheight = 1 ! 1 = adjust top height using both a computed infrared
190 : ! brightness temperature and the visible
191 : ! optical depth to adjust cloud top pressure.
192 : ! Note that this calculation is most appropriate to compare
193 : ! to ISCCP data during sunlit hours.
194 : ! 2 = do not adjust top height, that is cloud top pressure
195 : ! is the actual cloud top pressure in the model
196 : ! 3 = adjust top height using only the computed infrared
197 : ! brightness temperature. Note that this calculation is most
198 : ! appropriate to compare to ISCCP IR only algortihm (i.e.
199 : ! you can compare to nighttime ISCCP data with this option) (1)
200 : integer :: isccp_topheight_direction = 2 ! direction for finding atmosphere pressure level with
201 : ! interpolated temperature equal to the radiance
202 : ! determined cloud-top temperature
203 : ! 1 = find the *lowest* altitude (highest pressure) level
204 : ! with interpolated temperature
205 : ! equal to the radiance determined cloud-top temperature
206 : ! 2 = find the *highest* altitude (lowest pressure) level
207 : ! with interpolated temperature
208 : ! equal to the radiance determined cloud-top temperature
209 : ! ONLY APPLICABLE IF top_height EQUALS 1 or 3
210 : ! 1 = default setting in COSP v1.1, matches all versions of
211 : ! ISCCP simulator with versions numbers 3.5.1 and lower
212 : ! 2 = default setting in COSP v1.3. default since V4.0 of ISCCP simulator
213 :
214 : ! ######################################################################################
215 : ! Other variables
216 : ! ######################################################################################
217 : logical,allocatable :: first_run_cosp(:) !.true. if run_cosp has been populated (allocatable->begchunk:endchunk)
218 : logical,allocatable :: run_cosp(:,:) !.true. if cosp should be run by column and
219 : ! chunk (allocatable->1:pcols,begchunk:endchunk)
220 : ! pbuf indices
221 : integer :: cld_idx, concld_idx, lsreffrain_idx, lsreffsnow_idx, cvreffliq_idx
222 : integer :: cvreffice_idx, dpcldliq_idx, dpcldice_idx
223 : integer :: shcldliq1_idx, shcldice1_idx, dpflxprc_idx
224 : integer :: dpflxsnw_idx, shflxprc_idx, shflxsnw_idx, lsflxprc_idx, lsflxsnw_idx
225 : integer :: rei_idx, rel_idx
226 :
227 : ! ######################################################################################
228 : ! Declarations specific to COSP2
229 : ! ######################################################################################
230 : type(radar_cfg) :: rcfg_cloudsat ! Radar configuration (Cloudsat)
231 : type(radar_cfg), allocatable :: rcfg_cs(:) ! chunked version of rcfg_cloudsat
232 : type(size_distribution) :: sd ! Size distribution used by radar simulator
233 : type(size_distribution), allocatable :: sd_cs(:) ! chunked version of sd
234 : character(len=64) :: cloudsat_micro_scheme = 'MMF_v3.5_single_moment'
235 :
236 : integer,parameter :: &
237 : I_LSCLIQ = 1, & ! Large-scale (stratiform) liquid
238 : I_LSCICE = 2, & ! Large-scale (stratiform) ice
239 : I_LSRAIN = 3, & ! Large-scale (stratiform) rain
240 : I_LSSNOW = 4, & ! Large-scale (stratiform) snow
241 : I_CVCLIQ = 5, & ! Convective liquid
242 : I_CVCICE = 6, & ! Convective ice
243 : I_CVRAIN = 7, & ! Convective rain
244 : I_CVSNOW = 8, & ! Convective snow
245 : I_LSGRPL = 9 ! Large-scale (stratiform) groupel
246 :
247 : ! Stratiform and convective clouds in frac_out (scops output).
248 : integer, parameter :: &
249 : I_LSC = 1, & ! Large-scale clouds
250 : I_CVC = 2 ! Convective clouds
251 :
252 : ! Microphysical settings for the precipitation flux to mixing ratio conversion
253 : real(r8),parameter,dimension(nhydro) :: &
254 : ! LSL LSI LSR LSS CVL CVI CVR CVS LSG
255 : N_ax = (/-1._r8, -1._r8, 8.e6_r8, 3.e6_r8, -1._r8, -1._r8, 8.e6_r8, 3.e6_r8, 4.e6_r8/),&
256 : N_bx = (/-1._r8, -1._r8, 0.0_r8, 0.0_r8, -1._r8, -1._r8, 0.0_r8, 0.0_r8, 0.0_r8/),&
257 : alpha_x = (/-1._r8, -1._r8, 0.0_r8, 0.0_r8, -1._r8, -1._r8, 0.0_r8, 0.0_r8, 0.0_r8/),&
258 : c_x = (/-1._r8, -1._r8, 842.0_r8, 4.84_r8, -1._r8, -1._r8, 842.0_r8, 4.84_r8, 94.5_r8/),&
259 : d_x = (/-1._r8, -1._r8, 0.8_r8, 0.25_r8, -1._r8, -1._r8, 0.8_r8, 0.25_r8, 0.5_r8/),&
260 : g_x = (/-1._r8, -1._r8, 0.5_r8, 0.5_r8, -1._r8, -1._r8, 0.5_r8, 0.5_r8, 0.5_r8/),&
261 : a_x = (/-1._r8, -1._r8, 524.0_r8, 52.36_r8, -1._r8, -1._r8, 524.0_r8, 52.36_r8, 209.44_r8/),&
262 : b_x = (/-1._r8, -1._r8, 3.0_r8, 3.0_r8, -1._r8, -1._r8, 3.0_r8, 3.0_r8, 3.0_r8/),&
263 : gamma_1 = (/-1._r8, -1._r8, 17.83725_r8, 8.284701_r8, -1._r8, -1._r8, 17.83725_r8, 8.284701_r8, 11.63230_r8/),&
264 : gamma_2 = (/-1._r8, -1._r8, 6.0_r8, 6.0_r8, -1._r8, -1._r8, 6.0_r8, 6.0_r8, 6.0_r8/),&
265 : gamma_3 = (/-1._r8, -1._r8, 2.0_r8, 2.0_r8, -1._r8, -1._r8, 2.0_r8, 2.0_r8, 2.0_r8/),&
266 : gamma_4 = (/-1._r8, -1._r8, 6.0_r8, 6.0_r8, -1._r8, -1._r8, 6.0_r8, 6.0_r8, 6.0_r8/)
267 : #endif
268 :
269 : CONTAINS
270 :
271 : ! ######################################################################################
272 : ! SUBROUTINE setcosp2values
273 : ! ######################################################################################
274 : #ifdef USE_COSP
275 : subroutine setcosp2values(Nlr_in,use_vgrid_in,csat_vgrid_in,Ncolumns_in,cosp_nradsteps_in)
276 : use mod_cosp, only: cosp_init
277 : use mod_cosp_config, only: vgrid_zl, vgrid_zu, vgrid_z
278 : use mod_quickbeam_optics, only: hydro_class_init, quickbeam_optics_init
279 : ! Inputs
280 : integer, intent(in) :: Nlr_in ! Number of vertical levels for CALIPSO and Cloudsat products
281 : integer, intent(in) :: Ncolumns_in ! Number of sub-columns
282 : integer, intent(in) :: cosp_nradsteps_in ! How often to call COSP?
283 : logical, intent(in) :: use_vgrid_in ! Logical switch to use interpolated, to Nlr_in, grid for CALIPSO and Cloudsat
284 : logical, intent(in) :: csat_vgrid_in !
285 :
286 : ! Local
287 : logical :: ldouble=.false.
288 : logical :: lsingle=.true. ! Default is to use single moment
289 : integer :: i,k
290 :
291 : prsmid_cosp = pres_binCenters
292 : prslim_cosp = pres_binEdges
293 : taumid_cosp = tau_binCenters
294 : taulim_cosp = tau_binEdges
295 : srmid_cosp = calipso_binCenters
296 : srlim_cosp = calipso_binEdges
297 : sza_cosp = parasol_sza
298 : dbzemid_cosp = cloudsat_binCenters
299 : dbzelim_cosp = cloudsat_binEdges
300 : htmisrmid_cosp = misr_histHgtCenters
301 : htmisrlim_cosp = misr_histHgtEdges
302 : taumid_cosp_modis = tau_binCenters
303 : taulim_cosp_modis = tau_binEdges
304 : reffICE_binCenters_cosp = reffICE_binCenters
305 : reffICE_binEdges_cosp = reffICE_binEdges
306 : reffLIQ_binCenters_cosp = reffLIQ_binCenters
307 : reffLIQ_binEdges_cosp = reffLIQ_binEdges
308 :
309 : ! Initialize the distributional parameters for hydrometeors in radar simulator. In COSPv1.4, this was declared in
310 : ! cosp_defs.f.
311 : if (cloudsat_micro_scheme == 'MMF_v3.5_two_moment') then
312 : ldouble = .true.
313 : lsingle = .false.
314 : endif
315 : call hydro_class_init(lsingle,ldouble,sd)
316 : call quickbeam_optics_init()
317 :
318 : ! DS2017: The setting up of the vertical grid for regridding the CALIPSO and Cloudsat products is
319 : ! now donein cosp_init, but these fields are stored in cosp_config.F90.
320 : ! Additionally all static fields used by the individual simulators are set up by calls
321 : ! to _init functions in cosp_init.
322 : ! DS2019: Add logicals, default=.false., for new Lidar simuldators (Earthcare (atlid) and ground-based
323 : ! lidar at 532nm)
324 : call COSP_INIT(Lisccp_sim, Lmodis_sim, Lmisr_sim, Lradar_sim, Llidar_sim, LgrLidar532, &
325 : Latlid, Lparasol_sim, Lrttov_sim, radar_freq, k2, use_gas_abs, do_ray, &
326 : isccp_topheight, isccp_topheight_direction, surface_radar, rcfg_cloudsat, &
327 : use_vgrid_in, csat_vgrid_in, Nlr_in, pver, cloudsat_micro_scheme)
328 :
329 : ! Set number of sub-columns, from namelist
330 : nscol_cosp = Ncolumns_in
331 :
332 : if (use_vgrid_in) then !! using fixed vertical grid
333 : if (csat_vgrid_in) then
334 : nht_cosp = 40
335 : else
336 : nht_cosp = Nlr_in
337 : endif
338 : endif
339 :
340 : ! Set COSP call frequency, from namelist.
341 : cosp_nradsteps = cosp_nradsteps_in
342 :
343 : ! DJS2017: In COSP2, most of the bin boundaries, centers, and edges are declared in src/cosp_config.F90.
344 : ! Above I just assign them accordingly in the USE statement. Other bin bounds needed by CAM
345 : ! are calculated here.
346 : ! Allocate
347 : allocate(htlim_cosp(2,nht_cosp),htlim_cosp_1d(nht_cosp+1),htmid_cosp(nht_cosp),scol_cosp(nscol_cosp), &
348 : htdbze_cosp(nht_cosp*CLOUDSAT_DBZE_BINS),htsr_cosp(nht_cosp*nsr_cosp),htmlscol_cosp(nhtml_cosp*nscol_cosp),&
349 : htdbze_htmid_cosp(nht_cosp*CLOUDSAT_DBZE_BINS),htdbze_dbzemid_cosp(nht_cosp*CLOUDSAT_DBZE_BINS), &
350 : htsr_htmid_cosp(nht_cosp*nsr_cosp),htsr_srmid_cosp(nht_cosp*nsr_cosp), &
351 : htmlscol_htmlmid_cosp(nhtml_cosp*nscol_cosp),htmlscol_scol_cosp(nhtml_cosp*nscol_cosp))
352 :
353 : ! DJS2017: Just pull from cosp_config
354 : if (use_vgrid_in) then
355 : htlim_cosp_1d(1) = vgrid_zu(1)
356 : htlim_cosp_1d(2:nht_cosp+1) = vgrid_zl
357 : endif
358 : htmid_cosp = vgrid_z
359 : htlim_cosp(1,:) = vgrid_zu
360 : htlim_cosp(2,:) = vgrid_zl
361 :
362 : scol_cosp(:) = (/(k,k=1,nscol_cosp)/)
363 :
364 : ! Just using an index here, model height is a prognostic variable
365 : htmlmid_cosp(:) = (/(k,k=1,nhtml_cosp)/)
366 :
367 : ! assign mixed dimensions an integer index for cam_history.F90
368 : do k=1,nprs_cosp*ntau_cosp
369 : prstau_cosp(k) = k
370 : end do
371 : do k=1,nprs_cosp*ntau_cosp_modis
372 : prstau_cosp_modis(k) = k
373 : end do
374 : do k=1,nht_cosp*CLOUDSAT_DBZE_BINS
375 : htdbze_cosp(k) = k
376 : end do
377 : do k=1,nht_cosp*nsr_cosp
378 : htsr_cosp(k) = k
379 : end do
380 : do k=1,nhtml_cosp*nscol_cosp
381 : htmlscol_cosp(k) = k
382 : end do
383 : do k=1,nhtmisr_cosp*ntau_cosp
384 : htmisrtau_cosp(k) = k
385 : end do
386 :
387 : ! next, assign collapsed reference vectors for cam_history.F90
388 : ! convention for saving output = prs1,tau1 ... prs1,tau7 ; prs2,tau1 ... prs2,tau7 etc.
389 : ! actual output is specified in cospsimulator1_intr.F90
390 : do k=1,nprs_cosp
391 : prstau_taumid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=taumid_cosp(1:ntau_cosp)
392 : prstau_prsmid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=prsmid_cosp(k)
393 : prstau_taumid_cosp_modis(ntau_cosp_modis*(k-1)+1:k*ntau_cosp_modis)=taumid_cosp_modis(1:ntau_cosp_modis)
394 : prstau_prsmid_cosp_modis(ntau_cosp_modis*(k-1)+1:k*ntau_cosp_modis)=prsmid_cosp(k)
395 : enddo
396 :
397 : do k=1,nht_cosp
398 : htdbze_dbzemid_cosp(CLOUDSAT_DBZE_BINS*(k-1)+1:k*CLOUDSAT_DBZE_BINS)=dbzemid_cosp(1:CLOUDSAT_DBZE_BINS)
399 : htdbze_htmid_cosp(CLOUDSAT_DBZE_BINS*(k-1)+1:k*CLOUDSAT_DBZE_BINS)=htmid_cosp(k)
400 : enddo
401 :
402 : do k=1,nht_cosp
403 : htsr_srmid_cosp(nsr_cosp*(k-1)+1:k*nsr_cosp)=srmid_cosp(1:nsr_cosp)
404 : htsr_htmid_cosp(nsr_cosp*(k-1)+1:k*nsr_cosp)=htmid_cosp(k)
405 : enddo
406 :
407 : do k=1,nhtml_cosp
408 : htmlscol_scol_cosp(nscol_cosp*(k-1)+1:k*nscol_cosp)=scol_cosp(1:nscol_cosp)
409 : htmlscol_htmlmid_cosp(nscol_cosp*(k-1)+1:k*nscol_cosp)=htmlmid_cosp(k)
410 : enddo
411 :
412 : do k=1,nhtmisr_cosp
413 : htmisrtau_taumid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=taumid_cosp(1:ntau_cosp)
414 : htmisrtau_htmisrmid_cosp(ntau_cosp*(k-1)+1:k*ntau_cosp)=htmisrmid_cosp(k)
415 : enddo
416 :
417 : end subroutine setcosp2values
418 : #endif
419 :
420 : ! ######################################################################################
421 : ! SUBROUTINE cospsimulator_intr_readnl
422 : !
423 : ! PURPOSE: to read namelist variables and run setcospvalues subroutine.note: cldfrc_readnl
424 : ! is a good template in cloud_fraction.F90. Make sure that this routine is reading in a
425 : ! namelist. models/atm/cam/bld/build-namelist is the perl script to check.
426 : ! ######################################################################################
427 1536 : subroutine cospsimulator_intr_readnl(nlfile)
428 : use namelist_utils, only: find_group_name
429 : use units, only: getunit, freeunit
430 : #ifdef SPMD
431 : use mpishorthand, only: mpicom, mpilog, mpiint, mpichar
432 : #endif
433 :
434 : character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input (nlfile=atm_in)
435 :
436 : ! Local variables
437 : integer :: unitn, ierr
438 : character(len=*), parameter :: subname = 'cospsimulator_intr_readnl'
439 :
440 : #ifdef USE_COSP
441 : !!! this list should include any variable that you might want to include in the namelist
442 : !!! philosophy is to not include COSP output flags but just important COSP settings and cfmip controls.
443 : namelist /cospsimulator_nl/ docosp, cosp_active, cosp_amwg, &
444 : cosp_histfile_num, cosp_histfile_aux, cosp_histfile_aux_num, cosp_isccp, cosp_lfrac_out, &
445 : cosp_lite, cosp_lradar_sim, cosp_llidar_sim, cosp_lisccp_sim, cosp_lmisr_sim, cosp_lmodis_sim, cosp_ncolumns, &
446 : cosp_nradsteps, cosp_passive, cosp_runall
447 :
448 : !! read in the namelist
449 : if (masterproc) then
450 : unitn = getunit()
451 : open( unitn, file=trim(nlfile), status='old' ) !! presumably opens the namelist file "nlfile"
452 : !! position the file to write to the cospsimulator portion of the cam_in namelist
453 : call find_group_name(unitn, 'cospsimulator_nl', status=ierr)
454 : if (ierr == 0) then
455 : read(unitn, cospsimulator_nl, iostat=ierr)
456 : if (ierr /= 0) then
457 : call endrun(subname // ':: ERROR reading namelist')
458 : end if
459 : end if
460 : close(unitn)
461 : call freeunit(unitn)
462 : end if
463 :
464 : #ifdef SPMD
465 : ! Broadcast namelist variables
466 : call mpibcast(docosp, 1, mpilog, 0, mpicom)
467 : call mpibcast(cosp_amwg, 1, mpilog, 0, mpicom)
468 : call mpibcast(cosp_lite, 1, mpilog, 0, mpicom)
469 : call mpibcast(cosp_passive, 1, mpilog, 0, mpicom)
470 : call mpibcast(cosp_active, 1, mpilog, 0, mpicom)
471 : call mpibcast(cosp_isccp, 1, mpilog, 0, mpicom)
472 : call mpibcast(cosp_runall, 1, mpilog, 0, mpicom)
473 : call mpibcast(cosp_lfrac_out, 1, mpilog, 0, mpicom)
474 : call mpibcast(cosp_lradar_sim, 1, mpilog, 0, mpicom)
475 : call mpibcast(cosp_llidar_sim, 1, mpilog, 0, mpicom)
476 : call mpibcast(cosp_lisccp_sim, 1, mpilog, 0, mpicom)
477 : call mpibcast(cosp_lmisr_sim, 1, mpilog, 0, mpicom)
478 : call mpibcast(cosp_lmodis_sim, 1, mpilog, 0, mpicom)
479 : call mpibcast(cosp_ncolumns, 1, mpiint, 0, mpicom)
480 : call mpibcast(cosp_histfile_num, 1, mpiint, 0, mpicom)
481 : call mpibcast(cosp_histfile_aux_num,1, mpiint, 0, mpicom)
482 : call mpibcast(cosp_histfile_aux, 1, mpilog, 0, mpicom)
483 : call mpibcast(cosp_nradsteps, 1, mpiint, 0, mpicom)
484 : #endif
485 :
486 : if (cosp_lfrac_out) then
487 : lfrac_out = .true.
488 : end if
489 : if (cosp_lradar_sim) then
490 : lradar_sim = .true.
491 : end if
492 : if (cosp_llidar_sim) then
493 : llidar_sim = .true.
494 : lparasol_sim = .true.
495 : end if
496 : if (cosp_lisccp_sim) then
497 : lisccp_sim = .true.
498 : end if
499 : if (cosp_lmisr_sim) then
500 : lmisr_sim = .true.
501 : end if
502 : if (cosp_lmodis_sim) then
503 : lmodis_sim = .true.
504 : end if
505 :
506 : if (cosp_histfile_aux .and. cosp_histfile_aux_num == -1) then
507 : cosp_histfile_aux_num = cosp_histfile_num
508 : end if
509 :
510 : if (cosp_lite) then
511 : llidar_sim = .true.
512 : lparasol_sim = .true.
513 : lisccp_sim = .true.
514 : lmisr_sim = .true.
515 : lmodis_sim = .true.
516 : cosp_ncolumns = 10
517 : cosp_nradsteps = 3
518 : end if
519 :
520 : if (cosp_passive) then
521 : lisccp_sim = .true.
522 : lmisr_sim = .true.
523 : lmodis_sim = .true.
524 : cosp_ncolumns = 10
525 : cosp_nradsteps = 3
526 : end if
527 :
528 : if (cosp_active) then
529 : lradar_sim = .true.
530 : llidar_sim = .true.
531 : lparasol_sim = .true.
532 : cosp_ncolumns = 10
533 : cosp_nradsteps = 3
534 : end if
535 :
536 : if (cosp_isccp) then
537 : lisccp_sim = .true.
538 : cosp_ncolumns = 10
539 : cosp_nradsteps = 3
540 : end if
541 :
542 : if (cosp_runall) then
543 : lradar_sim = .true.
544 : llidar_sim = .true.
545 : lparasol_sim = .true.
546 : lisccp_sim = .true.
547 : lmisr_sim = .true.
548 : lmodis_sim = .true.
549 : lfrac_out = .true.
550 : end if
551 :
552 : !! if no simulators are turned on at all and docosp is, set cosp_amwg = .true.
553 : if((docosp) .and. (.not.lradar_sim) .and. (.not.llidar_sim) .and. (.not.lisccp_sim) .and. &
554 : (.not.lmisr_sim) .and. (.not.lmodis_sim)) then
555 : cosp_amwg = .true.
556 : end if
557 : if (cosp_amwg) then
558 : lradar_sim = .true.
559 : llidar_sim = .true.
560 : lparasol_sim = .true.
561 : lisccp_sim = .true.
562 : lmisr_sim = .true.
563 : lmodis_sim = .true.
564 : cosp_ncolumns = 10
565 : cosp_nradsteps = 3
566 : end if
567 :
568 : !! reset COSP namelist variables based on input from cam namelist variables
569 : if (cosp_ncolumns .ne. ncolumns) then
570 : ncolumns = cosp_ncolumns
571 : end if
572 :
573 : ! *NOTE* COSP is configured in CAM such that if a simulator is requested, all diagnostics
574 : ! are output. So no need turn on/aff outputs if simulator is requested.
575 :
576 : ! Set vertical coordinate, subcolumn, and calculation frequency cosp options based on namelist inputs
577 : call setcosp2values(nlr,use_vgrid,csat_vgrid,ncolumns,cosp_nradsteps)
578 :
579 : if (masterproc) then
580 : if (docosp) then
581 : write(iulog,*)'COSP configuration:'
582 : write(iulog,*)' Number of COSP subcolumns = ', cosp_ncolumns
583 : write(iulog,*)' Frequency at which cosp is called = ', cosp_nradsteps
584 : write(iulog,*)' Enable radar simulator = ', lradar_sim
585 : write(iulog,*)' Enable calipso simulator = ', llidar_sim
586 : write(iulog,*)' Enable ISCCP simulator = ', lisccp_sim
587 : write(iulog,*)' Enable MISR simulator = ', lmisr_sim
588 : write(iulog,*)' Enable MODIS simulator = ', lmodis_sim
589 : write(iulog,*)' RADAR_SIM microphysics scheme = ', trim(cloudsat_micro_scheme)
590 : write(iulog,*)' Write COSP output to history file = ', cosp_histfile_num
591 : write(iulog,*)' Write COSP input fields = ', cosp_histfile_aux
592 : write(iulog,*)' Write COSP input fields to history file = ', cosp_histfile_aux_num
593 : write(iulog,*)' Write COSP subcolumn fields = ', cosp_lfrac_out
594 : else
595 : write(iulog,*)'COSP not enabled'
596 : end if
597 : end if
598 : #endif
599 1536 : end subroutine cospsimulator_intr_readnl
600 :
601 : ! ######################################################################################
602 : ! SUBROUTINE cospsimulator_intr_register
603 : ! ######################################################################################
604 1536 : subroutine cospsimulator_intr_register()
605 :
606 : use cam_history_support, only: add_hist_coord
607 :
608 : #ifdef USE_COSP
609 : ! register non-standard variable dimensions
610 : if (lisccp_sim .or. lmodis_sim) then
611 : call add_hist_coord('cosp_prs', nprs_cosp, 'COSP Mean ISCCP pressure', &
612 : 'hPa', prsmid_cosp, bounds_name='cosp_prs_bnds', bounds=prslim_cosp)
613 : end if
614 :
615 : if (lisccp_sim .or. lmisr_sim) then
616 : call add_hist_coord('cosp_tau', ntau_cosp, &
617 : 'COSP Mean ISCCP optical depth', '1', taumid_cosp, &
618 : bounds_name='cosp_tau_bnds', bounds=taulim_cosp)
619 : end if
620 :
621 : if (lisccp_sim .or. llidar_sim .or. lradar_sim .or. lmisr_sim) then
622 : call add_hist_coord('cosp_scol', nscol_cosp, 'COSP subcolumn', &
623 : values=scol_cosp)
624 : end if
625 :
626 : if (llidar_sim .or. lradar_sim) then
627 : call add_hist_coord('cosp_ht', nht_cosp, &
628 : 'COSP Mean Height for calipso and radar simulator outputs', 'm', &
629 : htmid_cosp, bounds_name='cosp_ht_bnds', bounds=htlim_cosp, &
630 : vertical_coord=.true.)
631 : end if
632 :
633 : if (llidar_sim) then
634 : call add_hist_coord('cosp_sr', nsr_cosp, &
635 : 'COSP Mean Scattering Ratio for calipso simulator CFAD output', '1', &
636 : srmid_cosp, bounds_name='cosp_sr_bnds', bounds=srlim_cosp)
637 : end if
638 :
639 : if (llidar_sim) then
640 : call add_hist_coord('cosp_sza', nsza_cosp, 'COSP Parasol SZA', &
641 : 'degrees', sza_cosp)
642 : end if
643 :
644 : if (lradar_sim) then
645 : call add_hist_coord('cosp_dbze', CLOUDSAT_DBZE_BINS, &
646 : 'COSP Mean dBZe for radar simulator CFAD output', 'dBZ', &
647 : dbzemid_cosp, bounds_name='cosp_dbze_bnds', bounds=dbzelim_cosp)
648 : end if
649 :
650 : if (lmisr_sim) then
651 : call add_hist_coord('cosp_htmisr', nhtmisr_cosp, 'COSP MISR height', &
652 : 'km', htmisrmid_cosp, &
653 : bounds_name='cosp_htmisr_bnds', bounds=htmisrlim_cosp)
654 : end if
655 :
656 : if (lmodis_sim) then
657 : call add_hist_coord('cosp_tau_modis', ntau_cosp_modis, &
658 : 'COSP Mean MODIS optical depth', '1', taumid_cosp_modis, &
659 : bounds_name='cosp_tau_modis_bnds', bounds=taulim_cosp_modis)
660 : call add_hist_coord('cosp_reffice',numMODISReffIceBins, &
661 : 'COSP Mean MODIS effective radius (ice)', 'microns', reffICE_binCenters_cosp, &
662 : bounds_name='cosp_reffice_bnds',bounds=reffICE_binEdges_cosp)
663 : call add_hist_coord('cosp_reffliq',numMODISReffLiqBins, &
664 : 'COSP Mean MODIS effective radius (liquid)', 'microns', reffLIQ_binCenters_cosp, &
665 : bounds_name='cosp_reffliq_bnds',bounds=reffLIQ_binEdges_cosp)
666 : end if
667 :
668 : #endif
669 1536 : end subroutine cospsimulator_intr_register
670 :
671 : ! ######################################################################################
672 : ! SUBROUTINE cospsimulator_intr_init
673 : ! ######################################################################################
674 0 : subroutine cospsimulator_intr_init()
675 :
676 : #ifdef USE_COSP
677 :
678 : use cam_history, only: addfld, add_default, horiz_only
679 : #ifdef SPMD
680 : use mpishorthand, only : mpir8, mpiint, mpicom
681 : #endif
682 : use netcdf, only : nf90_open, nf90_inq_varid, nf90_get_var, nf90_close, nf90_nowrite
683 : use error_messages, only : handle_ncerr, alloc_err
684 :
685 : use physics_buffer, only: pbuf_get_index
686 :
687 : use mod_cosp_config, only : R_UNDEF
688 :
689 : integer :: ncid,latid,lonid,did,hrid,minid,secid, istat
690 : integer :: i, ierr
691 :
692 : ! ISCCP OUTPUTS
693 : if (lisccp_sim) then
694 : !! addfld calls for all
695 : !*cfMon,cfDa* clisccp2 (time,tau,plev,profile), CFMIP wants 7 p bins, 7 tau bins
696 : call addfld('FISCCP1_COSP',(/'cosp_tau','cosp_prs'/),'A','percent', &
697 : 'Grid-box fraction covered by each ISCCP D level cloud type',&
698 : flag_xyfill=.true., fill_value=R_UNDEF)
699 :
700 : !*cfMon,cfDa* tclisccp (time,profile), CFMIP wants "gridbox mean cloud cover from ISCCP"
701 : call addfld('CLDTOT_ISCCP', horiz_only,'A','percent', &
702 : 'Total Cloud Fraction Calculated by the ISCCP Simulator ',flag_xyfill=.true., fill_value=R_UNDEF)
703 : !*cfMon,cfDa* albisccp (time,profile)
704 : ! Per CFMIP request - weight by ISCCP Total Cloud Fraction (divide by CLDTOT_ISSCP in history file to get weighted average)
705 : call addfld('MEANCLDALB_ISCCP',horiz_only,'A','1','Mean cloud albedo*CLDTOT_ISCCP',flag_xyfill=.true., fill_value=R_UNDEF)
706 : !*cfMon,cfDa* ctpisccp (time,profile)
707 : ! Per CFMIP request - weight by ISCCP Total Cloud Fraction (divide by CLDTOT_ISSCP in history file to get weighted average)
708 : call addfld('MEANPTOP_ISCCP',horiz_only,'A','Pa','Mean cloud top pressure*CLDTOT_ISCCP',flag_xyfill=.true., &
709 : fill_value=R_UNDEF)
710 : ! tauisccp (time,profile)
711 : ! For averaging, weight by ISCCP Total Cloud Fraction (divide by CLDTOT_ISSCP in history file to get weighted average)
712 : call addfld ('MEANTAU_ISCCP',horiz_only,'A','1','Mean optical thickness*CLDTOT_ISCCP',flag_xyfill=.true., &
713 : fill_value=R_UNDEF)
714 : ! meantbisccp (time,profile), at 10.5 um
715 : call addfld ('MEANTB_ISCCP',horiz_only,'A','K','Mean Infrared Tb from ISCCP simulator',flag_xyfill=.true., &
716 : fill_value=R_UNDEF)
717 : ! meantbclrisccp (time,profile)
718 : call addfld ('MEANTBCLR_ISCCP',horiz_only,'A','K','Mean Clear-sky Infrared Tb from ISCCP simulator', &
719 : flag_xyfill=.true., fill_value=R_UNDEF)
720 : ! boxtauisccp (time,column,profile)
721 : call addfld ('TAU_ISCCP',(/'cosp_scol'/),'I','1','Optical Depth in each Subcolumn',flag_xyfill=.true., fill_value=R_UNDEF)
722 : ! boxptopisccp (time,column,profile)
723 : call addfld ('CLDPTOP_ISCCP',(/'cosp_scol'/),'I','Pa','Cloud Top Pressure in each Subcolumn', &
724 : flag_xyfill=.true., fill_value=R_UNDEF)
725 :
726 : !! add all isccp outputs to the history file specified by the CAM namelist variable cosp_histfile_num
727 : call add_default ('FISCCP1_COSP',cosp_histfile_num,' ')
728 : call add_default ('CLDTOT_ISCCP',cosp_histfile_num,' ')
729 : call add_default ('MEANCLDALB_ISCCP',cosp_histfile_num,' ')
730 : call add_default ('MEANPTOP_ISCCP',cosp_histfile_num,' ')
731 : call add_default ('MEANTAU_ISCCP',cosp_histfile_num,' ')
732 : call add_default ('MEANTB_ISCCP',cosp_histfile_num,' ')
733 : call add_default ('MEANTBCLR_ISCCP',cosp_histfile_num,' ')
734 :
735 : end if
736 :
737 : ! CALIPSO SIMULATOR OUTPUTS
738 : if (llidar_sim) then
739 : !! addfld calls for all
740 : !*cfMon,cfOff,cfDa,cf3hr* cllcalipso (time,profile)
741 : call addfld('CLDLOW_CAL',horiz_only,'A','percent','Calipso Low-level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF)
742 : !*cfMon,cfOff,cfDa,cf3hr* clmcalipso (time,profile)
743 : call addfld('CLDMED_CAL',horiz_only,'A','percent','Calipso Mid-level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF)
744 : !*cfMon,cfOff,cfDa,cf3hr* clhcalipso (time,profile)
745 : call addfld('CLDHGH_CAL',horiz_only,'A','percent','Calipso High-level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF)
746 : !*cfMon,cfOff,cfDa,cf3hr* cltcalipso (time,profile)
747 : call addfld('CLDTOT_CAL',horiz_only,'A','percent','Calipso Total Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF)
748 : !*cfMon,cfOff,cfDa,cf3hr* clcalipso (time,height,profile)
749 : call addfld('CLD_CAL',(/'cosp_ht'/),'A','percent','Calipso Cloud Fraction (532 nm)', flag_xyfill=.true., fill_value=R_UNDEF)
750 : !*cfMon,cfOff,cfDa,cf3hr* parasol_refl (time,sza,profile)
751 : call addfld ('RFL_PARASOL',(/'cosp_sza'/),'A','fraction','PARASOL-like mono-directional reflectance ', &
752 : flag_xyfill=.true., fill_value=R_UNDEF)
753 : !*cfOff,cf3hr* cfad_calipsosr532 (time,height,scat_ratio,profile), %11%, default is 40 vert levs, 15 SR bins
754 : call addfld('CFAD_SR532_CAL',(/'cosp_sr','cosp_ht'/),'A','fraction', &
755 : 'Calipso Scattering Ratio CFAD (532 nm)', &
756 : flag_xyfill=.true., fill_value=R_UNDEF)
757 : ! beta_mol532 (time,height_mlev,profile)
758 : call addfld ('MOL532_CAL',(/'lev'/),'A','m-1sr-1','Calipso Molecular Backscatter (532 nm) ', &
759 : flag_xyfill=.true., fill_value=R_UNDEF)
760 : ! atb532 (time,height_mlev,column,profile)
761 : call addfld ('ATB532_CAL',(/'cosp_scol','lev '/),'I','no_unit_log10(x)', &
762 : 'Calipso Attenuated Total Backscatter (532 nm) in each Subcolumn', &
763 : flag_xyfill=.true., fill_value=R_UNDEF)
764 : ! lclcalipsoliq (time,alt40,loc) !!+cosp1.4
765 : call addfld('CLD_CAL_LIQ', (/'cosp_ht'/), 'A','percent', 'Calipso Liquid Cloud Fraction', &
766 : flag_xyfill=.true., fill_value=R_UNDEF)
767 : ! lclcalipsoice (time,alt40,loc)
768 : call addfld('CLD_CAL_ICE', (/'cosp_ht'/), 'A','percent', 'Calipso Ice Cloud Fraction', &
769 : flag_xyfill=.true., fill_value=R_UNDEF)
770 : ! lclcalipsoun (time,alt40,loc)
771 : call addfld('CLD_CAL_UN', (/'cosp_ht'/),'A','percent', 'Calipso Undefined-Phase Cloud Fraction', &
772 : flag_xyfill=.true., fill_value=R_UNDEF)
773 : ! lclcalipsotmp (time,alt40,loc)
774 : call addfld('CLD_CAL_TMP', (/'cosp_ht'/), 'A','percent', 'NOT SURE WHAT THIS IS Cloud Fraction', &
775 : flag_xyfill=.true., fill_value=R_UNDEF)
776 : ! lclcalipsotmpliq (time,alt40,loc)
777 : call addfld('CLD_CAL_TMPLIQ', (/'cosp_ht'/), 'A','percent', 'NOT SURE WHAT THIS IS Cloud Fraction', &
778 : flag_xyfill=.true., fill_value=R_UNDEF)
779 : ! lclcalipsotmpice (time,alt40,loc)
780 : call addfld('CLD_CAL_TMPICE', (/'cosp_ht'/), 'A','percent', 'NOT SURE WHAT THIS IS Cloud Fraction', &
781 : flag_xyfill=.true., fill_value=R_UNDEF)
782 : ! lclcalipsotmpun (time,alt40,loc)
783 : call addfld('CLD_CAL_TMPUN', (/'cosp_ht'/), 'A','percent', 'NOT SURE WHAT THIS IS Cloud Fraction', &
784 : flag_xyfill=.true., fill_value=R_UNDEF)
785 : ! lcltcalipsoice (time,loc)
786 : call addfld('CLDTOT_CAL_ICE', horiz_only,'A','percent','Calipso Total Ice Cloud Fraction', &
787 : flag_xyfill=.true., fill_value=R_UNDEF)
788 : ! lcltcalipsoliq (time,loc)
789 : call addfld('CLDTOT_CAL_LIQ', horiz_only,'A','percent','Calipso Total Liquid Cloud Fraction', &
790 : flag_xyfill=.true., fill_value=R_UNDEF)
791 : ! lcltcalipsoun (time,loc)
792 : call addfld('CLDTOT_CAL_UN',horiz_only,'A','percent','Calipso Total Undefined-Phase Cloud Fraction', &
793 : flag_xyfill=.true., fill_value=R_UNDEF)
794 : ! lclhcalipsoice (time,loc)
795 : call addfld('CLDHGH_CAL_ICE',horiz_only,'A','percent','Calipso High-level Ice Cloud Fraction', &
796 : flag_xyfill=.true., fill_value=R_UNDEF)
797 : ! lclhcalipsoliq (time,loc)
798 : call addfld('CLDHGH_CAL_LIQ',horiz_only,'A','percent','Calipso High-level Liquid Cloud Fraction', &
799 : flag_xyfill=.true., fill_value=R_UNDEF)
800 : ! lclhcalipsoun (time,loc)
801 : call addfld('CLDHGH_CAL_UN',horiz_only,'A','percent','Calipso High-level Undefined-Phase Cloud Fraction', &
802 : flag_xyfill=.true., fill_value=R_UNDEF)
803 : ! lclmcalipsoice (time,loc)
804 : call addfld('CLDMED_CAL_ICE',horiz_only,'A','percent','Calipso Mid-level Ice Cloud Fraction', &
805 : flag_xyfill=.true., fill_value=R_UNDEF)
806 : ! lclmcalipsoliq (time,loc)
807 : call addfld('CLDMED_CAL_LIQ',horiz_only,'A','percent','Calipso Mid-level Liquid Cloud Fraction', &
808 : flag_xyfill=.true., fill_value=R_UNDEF)
809 : ! lclmcalipsoun (time,loc)
810 : call addfld('CLDMED_CAL_UN',horiz_only,'A','percent','Calipso Mid-level Undefined-Phase Cloud Fraction', &
811 : flag_xyfill=.true., fill_value=R_UNDEF)
812 : ! lcllcalipsoice (time,loc)
813 : call addfld('CLDLOW_CAL_ICE',horiz_only,'A','percent','Calipso Low-level Ice Cloud Fraction', &
814 : flag_xyfill=.true., fill_value=R_UNDEF)
815 : ! lcllcalipsoliq (time,loc)
816 : call addfld('CLDLOW_CAL_LIQ',horiz_only,'A','percent','Calipso Low-level Liquid Cloud Fraction', &
817 : flag_xyfill=.true., fill_value=R_UNDEF)
818 : ! lcllcalipsoun (time,loc) !+cosp1.4
819 : call addfld('CLDLOW_CAL_UN',horiz_only,'A','percent','Calipso Low-level Undefined-Phase Cloud Fraction', &
820 : flag_xyfill=.true., fill_value=R_UNDEF)
821 :
822 : ! ! Calipso Opaque/thin cloud diagnostics
823 : ! call addfld('CLDOPQ_CAL', horiz_only, 'A', 'percent', 'CALIPSO Opaque Cloud Cover', &
824 : ! flag_xyfill=.true., fill_value=R_UNDEF)
825 : ! call addfld('CLDTHN_CAL', horiz_only, 'A', 'percent', 'CALIPSO Thin Cloud Cover', &
826 : ! flag_xyfill=.true., fill_value=R_UNDEF)
827 : ! call addfld('CLDZOPQ_CAL', horiz_only, 'A', 'm', 'CALIPSO z_opaque Altitude', &
828 : ! flag_xyfill=.true., fill_value=R_UNDEF)
829 : ! call addfld('CLDOPQ_CAL_2D', (/'cosp_ht'/), 'A', 'percent', 'CALIPSO Opaque Cloud Fraction', &
830 : ! flag_xyfill=.true., fill_value=R_UNDEF)
831 : ! call addfld('CLDTHN_CAL_2D', (/'cosp_ht'/), 'A', 'percent', 'CALIPSO Thin Cloud Fraction', &
832 : ! flag_xyfill=.true., fill_value=R_UNDEF)
833 : ! call addfld('CLDZOPQ_CAL_2D', (/'cosp_ht'/), 'A', 'percent', 'CALIPSO z_opaque Fraction', &
834 : ! flag_xyfill=.true., fill_value=R_UNDEF)
835 : ! call addfld('OPACITY_CAL_2D', (/'cosp_ht'/), 'A', 'percent', 'CALIPSO opacity Fraction', &
836 : ! flag_xyfill=.true., fill_value=R_UNDEF)
837 : ! call addfld('CLDOPQ_CAL_TMP', horiz_only, 'A', 'K', 'CALIPSO Opaque Cloud Temperature', &
838 : ! flag_xyfill=.true., fill_value=R_UNDEF)
839 : ! call addfld('CLDTHN_CAL_TMP', horiz_only, 'A', 'K', 'CALIPSO Thin Cloud Temperature', &
840 : ! flag_xyfill=.true., fill_value=R_UNDEF)
841 : ! call addfld('CLDZOPQ_CAL_TMP', horiz_only, 'A', 'K', 'CALIPSO z_opaque Temperature', &
842 : ! flag_xyfill=.true., fill_value=R_UNDEF)
843 : ! call addfld('CLDOPQ_CAL_Z', horiz_only, 'A', 'm', 'CALIPSO Opaque Cloud Altitude', &
844 : ! flag_xyfill=.true., fill_value=R_UNDEF)
845 : ! call addfld('CLDTHN_CAL_Z', horiz_only, 'A', 'm', 'CALIPSO Thin Cloud Altitude', &
846 : ! flag_xyfill=.true., fill_value=R_UNDEF)
847 : ! call addfld('CLDTHN_CAL_EMIS', horiz_only, 'A', '1', 'CALIPSO Thin Cloud Emissivity', &
848 : ! flag_xyfill=.true., fill_value=R_UNDEF)
849 : ! call addfld('CLDOPQ_CAL_SE', horiz_only, 'A', 'm', 'CALIPSO Opaque Cloud Altitude with respect to surface-elevation', &
850 : ! flag_xyfill=.true., fill_value=R_UNDEF)
851 : ! call addfld('CLDTHN_CAL_SE', horiz_only, 'A', 'm', 'CALIPSO Thin Cloud Altitude with respect to surface-elevation', &
852 : ! flag_xyfill=.true., fill_value=R_UNDEF)
853 : ! call addfld('CLDZOPQ_CAL_SE', horiz_only, 'A', 'm', 'CALIPSO z_opaque Altitude with respect to surface-elevation', &
854 : ! flag_xyfill=.true., fill_value=R_UNDEF)
855 :
856 : ! add_default calls for CFMIP experiments or else all fields are added to history file
857 : ! except those with sub-column dimension/experimental variables
858 : !! add all calipso outputs to the history file specified by the CAM namelist variable cosp_histfile_num
859 : call add_default ('CLDLOW_CAL',cosp_histfile_num,' ')
860 : call add_default ('CLDMED_CAL',cosp_histfile_num,' ')
861 : call add_default ('CLDHGH_CAL',cosp_histfile_num,' ')
862 : call add_default ('CLDTOT_CAL',cosp_histfile_num,' ')
863 : call add_default ('CLD_CAL',cosp_histfile_num,' ')
864 : call add_default ('RFL_PARASOL',cosp_histfile_num,' ')
865 : call add_default ('CFAD_SR532_CAL',cosp_histfile_num,' ')
866 : call add_default ('CLD_CAL_LIQ',cosp_histfile_num,' ') !+COSP1.4
867 : call add_default ('CLD_CAL_ICE',cosp_histfile_num,' ')
868 : call add_default ('CLD_CAL_UN',cosp_histfile_num,' ')
869 : call add_default ('CLDTOT_CAL_ICE',cosp_histfile_num,' ')
870 : call add_default ('CLDTOT_CAL_LIQ',cosp_histfile_num,' ')
871 : call add_default ('CLDTOT_CAL_UN',cosp_histfile_num,' ')
872 : call add_default ('CLDHGH_CAL_ICE',cosp_histfile_num,' ')
873 : call add_default ('CLDHGH_CAL_LIQ',cosp_histfile_num,' ')
874 : call add_default ('CLDHGH_CAL_UN',cosp_histfile_num,' ')
875 : call add_default ('CLDMED_CAL_ICE',cosp_histfile_num,' ')
876 : call add_default ('CLDMED_CAL_LIQ',cosp_histfile_num,' ')
877 : call add_default ('CLDMED_CAL_UN',cosp_histfile_num,' ')
878 : call add_default ('CLDLOW_CAL_ICE',cosp_histfile_num,' ')
879 : call add_default ('CLDLOW_CAL_LIQ',cosp_histfile_num,' ')
880 : call add_default ('CLDLOW_CAL_UN',cosp_histfile_num,' ')
881 : ! call add_default ('CLDOPQ_CAL',cosp_histfile_num,' ')
882 : ! call add_default ('CLDTHN_CAL',cosp_histfile_num,' ')
883 : ! call add_default ('CLDZOPQ_CAL',cosp_histfile_num,' ')
884 : ! call add_default ('CLDOPQ_CAL_2D',cosp_histfile_num,' ')
885 : ! call add_default ('CLDTHN_CAL_2D',cosp_histfile_num,' ')
886 : ! call add_default ('CLDZOPQ_CAL_2D',cosp_histfile_num,' ')
887 : ! call add_default ('OPACITY_CAL_2D',cosp_histfile_num,' ')
888 : ! call add_default ('CLDOPQ_CAL_TMP',cosp_histfile_num,' ')
889 : ! call add_default ('CLDTHN_CAL_TMP',cosp_histfile_num,' ')
890 : ! call add_default ('CLDZOPQ_CAL_TMP',cosp_histfile_num,' ')
891 : ! call add_default ('CLDOPQ_CAL_Z',cosp_histfile_num,' ')
892 : ! call add_default ('CLDTHN_CAL_Z',cosp_histfile_num,' ')
893 : ! call add_default ('CLDTHN_CAL_EMIS',cosp_histfile_num,' ')
894 : ! call add_default ('CLDOPQ_CAL_SE',cosp_histfile_num,' ')
895 : ! call add_default ('CLDTHN_CAL_SE',cosp_histfile_num,' ')
896 : ! call add_default ('CLDZOPQ_CAL_SE',cosp_histfile_num,' ')
897 :
898 : if ((.not.cosp_amwg) .and. (.not.cosp_lite) .and. (.not.cosp_passive) .and. (.not.cosp_active) &
899 : .and. (.not.cosp_isccp)) then
900 : call add_default ('MOL532_CAL',cosp_histfile_num,' ')
901 : end if
902 : end if
903 :
904 : ! RADAR SIMULATOR OUTPUTS
905 : if (lradar_sim) then
906 :
907 : allocate(sd_cs(begchunk:endchunk), rcfg_cs(begchunk:endchunk))
908 : do i = begchunk, endchunk
909 : sd_cs(i) = sd
910 : rcfg_cs(i) = rcfg_cloudsat
911 : end do
912 :
913 : ! addfld calls
914 : !*cfOff,cf3hr* cfad_dbze94 (time,height,dbze,profile), default is 40 vert levs, 15 dBZ bins
915 : call addfld('CFAD_DBZE94_CS',(/'cosp_dbze','cosp_ht '/),'A','fraction',&
916 : 'Radar Reflectivity Factor CFAD (94 GHz)',&
917 : flag_xyfill=.true., fill_value=R_UNDEF)
918 : !*cfOff,cf3hr* clcalipso2 (time,height,profile)
919 : call addfld ('CLD_CAL_NOTCS',(/'cosp_ht'/),'A','percent','Cloud occurrence seen by CALIPSO but not CloudSat ', &
920 : flag_xyfill=.true., fill_value=R_UNDEF)
921 : ! cltcalipsoradar (time,profile)
922 : call addfld ('CLDTOT_CALCS',horiz_only,'A','percent',' Calipso and Radar Total Cloud Fraction ',flag_xyfill=.true., &
923 : fill_value=R_UNDEF)
924 : call addfld ('CLDTOT_CS',horiz_only,'A','percent',' Radar total cloud amount ',flag_xyfill=.true., fill_value=R_UNDEF)
925 : call addfld ('CLDTOT_CS2',horiz_only,'A','percent', &
926 : ' Radar total cloud amount without the data for the first kilometer above surface ', &
927 : flag_xyfill=.true., fill_value=R_UNDEF)
928 : ! dbze94 (time,height_mlev,column,profile),! height_mlevel = height when vgrid_in = .true. (default)
929 : call addfld ('DBZE_CS',(/'cosp_scol','lev '/),'I','dBZe',' Radar dBZe (94 GHz) in each Subcolumn',&
930 : flag_xyfill=.true., fill_value=R_UNDEF)
931 :
932 : ! Cloudsat near-sfc precipitation diagnostics
933 : call addfld('CS_NOPRECIP', horiz_only, 'A', '1', 'CloudSat No Rain Fraction', flag_xyfill=.true., fill_value=R_UNDEF)
934 : call addfld('CS_RAINPOSS', horiz_only, 'A', '1', 'Cloudsat Rain Possible Fraction', flag_xyfill=.true., fill_value=R_UNDEF)
935 : call addfld('CS_RAINPROB', horiz_only, 'A', '1', 'CloudSat Rain Probable Fraction', flag_xyfill=.true., fill_value=R_UNDEF)
936 : call addfld('CS_RAINCERT', horiz_only, 'A', '1', 'CloudSat Rain Certain Fraction', flag_xyfill=.true., fill_value=R_UNDEF)
937 : call addfld('CS_SNOWPOSS', horiz_only, 'A', '1', 'CloudSat Snow Possible Fraction', flag_xyfill=.true., fill_value=R_UNDEF)
938 : call addfld('CS_SNOWCERT', horiz_only, 'A', '1', 'CloudSat Snow Certain Fraction', flag_xyfill=.true., fill_value=R_UNDEF)
939 : call addfld('CS_MIXPOSS', horiz_only, 'A', '1', 'CloudSat Mixed Possible Fraction', flag_xyfill=.true., fill_value=R_UNDEF)
940 : call addfld('CS_MIXCERT', horiz_only, 'A', '1', 'CloudSat Mixed Certain Fraction', flag_xyfill=.true., fill_value=R_UNDEF)
941 : call addfld('CS_RAINHARD', horiz_only, 'A', '1', 'CloudSat Heavy Rain Fraction', flag_xyfill=.true., fill_value=R_UNDEF)
942 : call addfld('CS_UN', horiz_only, 'A', '1', 'CloudSat Unclassified Precipitation Fraction',flag_xyfill=.true., fill_value=R_UNDEF)
943 : call addfld('CS_PIA', horiz_only, 'A', 'dBZ', 'CloudSat Radar Path Integrated Attenuation', flag_xyfill=.true., fill_value=R_UNDEF)
944 : ! Associated CAM microphysics
945 : !call addfld('CAM_MP_CVRAIN',horiz_only, 'A', 'kg/kg','CAM Microphysics Convective Rain', flag_xyfill=.true., fill_value=R_UNDEF)
946 : !call addfld('CAM_MP_CVSNOW',horiz_only, 'A', 'kg/kg','CAM Microphysics Convective Snow', flag_xyfill=.true., fill_value=R_UNDEF)
947 : !call addfld('CAM_MP_LSRAIN',horiz_only, 'A', 'kg/kg','CAM Microphysics Large-Scale Rain', flag_xyfill=.true., fill_value=R_UNDEF)
948 : !call addfld('CAM_MP_LSSNOW',horiz_only, 'A', 'kg/kg','CAM Microphysics Large-Scale Snow', flag_xyfill=.true., fill_value=R_UNDEF)
949 : !call addfld('CAM_MP_LSGRPL',horiz_only, 'A', 'kg/kg','CAM Microphysics Large-Scale Graupel', flag_xyfill=.true., fill_value=R_UNDEF)
950 :
951 :
952 : ! add_default calls for CFMIP experiments or else all fields are added to history file except those with sub-column dimension
953 : !! add all radar outputs to the history file specified by the CAM namelist variable cosp_histfile_num
954 : call add_default ('CFAD_DBZE94_CS',cosp_histfile_num,' ')
955 : call add_default ('CLD_CAL_NOTCS', cosp_histfile_num,' ')
956 : call add_default ('CLDTOT_CALCS', cosp_histfile_num,' ')
957 : call add_default ('CLDTOT_CS', cosp_histfile_num,' ')
958 : call add_default ('CLDTOT_CS2', cosp_histfile_num,' ')
959 : call add_default ('CS_NOPRECIP', cosp_histfile_num,' ')
960 : call add_default ('CS_RAINPOSS', cosp_histfile_num,' ')
961 : call add_default ('CS_RAINPROB', cosp_histfile_num,' ')
962 : call add_default ('CS_RAINCERT', cosp_histfile_num,' ')
963 : call add_default ('CS_SNOWPOSS', cosp_histfile_num,' ')
964 : call add_default ('CS_SNOWCERT', cosp_histfile_num,' ')
965 : call add_default ('CS_MIXPOSS', cosp_histfile_num,' ')
966 : call add_default ('CS_MIXCERT', cosp_histfile_num,' ')
967 : call add_default ('CS_RAINHARD', cosp_histfile_num,' ')
968 : call add_default ('CS_UN', cosp_histfile_num,' ')
969 : call add_default ('CS_PIA', cosp_histfile_num,' ')
970 : end if
971 :
972 : ! MISR SIMULATOR OUTPUTS
973 : if (lmisr_sim) then
974 : ! clMISR (time,tau,CTH_height_bin,profile)
975 : call addfld ('CLD_MISR',(/'cosp_tau ','cosp_htmisr'/),'A','percent','Cloud Fraction from MISR Simulator', &
976 : flag_xyfill=.true., fill_value=R_UNDEF)
977 : !! add all misr outputs to the history file specified by the CAM namelist variable cosp_histfile_num
978 : call add_default ('CLD_MISR',cosp_histfile_num,' ')
979 : end if
980 :
981 : ! MODIS OUTPUT
982 : if (lmodis_sim) then
983 : ! float cltmodis ( time, loc )
984 : call addfld ('CLTMODIS',horiz_only,'A','%','MODIS Total Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF)
985 : ! float clwmodis ( time, loc )
986 : call addfld ('CLWMODIS',horiz_only,'A','%','MODIS Liquid Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF)
987 : ! float climodis ( time, loc )
988 : call addfld ('CLIMODIS',horiz_only,'A','%','MODIS Ice Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF)
989 : ! float clhmodis ( time, loc )
990 : call addfld ('CLHMODIS',horiz_only,'A','%','MODIS High Level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF)
991 : ! float clmmodis ( time, loc )
992 : call addfld ('CLMMODIS',horiz_only,'A','%','MODIS Mid Level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF)
993 : ! float cllmodis ( time, loc )
994 : call addfld ('CLLMODIS',horiz_only,'A','%','MODIS Low Level Cloud Fraction',flag_xyfill=.true., fill_value=R_UNDEF)
995 : ! float tautmodis ( time, loc )
996 : call addfld ('TAUTMODIS',horiz_only,'A','1','MODIS Total Cloud Optical Thickness*CLTMODIS', &
997 : flag_xyfill=.true., fill_value=R_UNDEF)
998 : ! float tauwmodis ( time, loc )
999 : call addfld ('TAUWMODIS',horiz_only,'A','1','MODIS Liquid Cloud Optical Thickness*CLWMODIS', &
1000 : flag_xyfill=.true., fill_value=R_UNDEF)
1001 : ! float tauimodis ( time, loc )
1002 : call addfld ('TAUIMODIS',horiz_only,'A','1','MODIS Ice Cloud Optical Thickness*CLIMODIS', &
1003 : flag_xyfill=.true., fill_value=R_UNDEF)
1004 : ! float tautlogmodis ( time, loc )
1005 : call addfld ('TAUTLOGMODIS',horiz_only,'A','1','MODIS Total Cloud Optical Thickness (Log10 Mean)*CLTMODIS', &
1006 : flag_xyfill=.true., fill_value=R_UNDEF)
1007 : ! float tauwlogmodis ( time, loc )
1008 : call addfld ('TAUWLOGMODIS',horiz_only,'A','1','MODIS Liquid Cloud Optical Thickness (Log10 Mean)*CLWMODIS', &
1009 : flag_xyfill=.true., fill_value=R_UNDEF)
1010 : ! float tauilogmodis ( time, loc )
1011 : call addfld ('TAUILOGMODIS',horiz_only,'A','1','MODIS Ice Cloud Optical Thickness (Log10 Mean)*CLIMODIS', &
1012 : flag_xyfill=.true., fill_value=R_UNDEF)
1013 : ! float reffclwmodis ( time, loc )
1014 : call addfld ('REFFCLWMODIS',horiz_only,'A','m','MODIS Liquid Cloud Particle Size*CLWMODIS', &
1015 : flag_xyfill=.true., fill_value=R_UNDEF)
1016 : ! float reffclimodis ( time, loc )
1017 : call addfld ('REFFCLIMODIS',horiz_only,'A','m','MODIS Ice Cloud Particle Size*CLIMODIS', &
1018 : flag_xyfill=.true., fill_value=R_UNDEF)
1019 : ! float pctmodis ( time, loc )
1020 : call addfld ('PCTMODIS',horiz_only,'A','Pa','MODIS Cloud Top Pressure*CLTMODIS',flag_xyfill=.true., fill_value=R_UNDEF)
1021 : ! float lwpmodis ( time, loc )
1022 : call addfld ('LWPMODIS',horiz_only,'A','kg m-2','MODIS Cloud Liquid Water Path*CLWMODIS', &
1023 : flag_xyfill=.true., fill_value=R_UNDEF)
1024 : ! float iwpmodis ( time, loc )
1025 : call addfld ('IWPMODIS',horiz_only,'A','kg m-2','MODIS Cloud Ice Water Path*CLIMODIS',flag_xyfill=.true., fill_value=R_UNDEF)
1026 : ! float clmodis ( time, plev, tau, loc )
1027 : call addfld ('CLMODIS',(/'cosp_tau_modis','cosp_prs '/),'A','%','MODIS Cloud Area Fraction', &
1028 : flag_xyfill=.true., fill_value=R_UNDEF)
1029 : ! float clrimodis ( time, plev, tau, loc )
1030 : call addfld ('CLRIMODIS',(/'cosp_tau_modis','cosp_reffice '/),'A','%','MODIS Cloud Area Fraction', &
1031 : flag_xyfill=.true., fill_value=R_UNDEF)
1032 : ! float clrlmodis ( time, plev, tau, loc )
1033 : call addfld ('CLRLMODIS',(/'cosp_tau_modis','cosp_reffliq '/),'A','%','MODIS Cloud Area Fraction', &
1034 : flag_xyfill=.true., fill_value=R_UNDEF)
1035 :
1036 : !! add MODIS output to history file specified by the CAM namelist variable cosp_histfile_num
1037 : call add_default ('CLTMODIS',cosp_histfile_num,' ')
1038 : call add_default ('CLWMODIS',cosp_histfile_num,' ')
1039 : call add_default ('CLIMODIS',cosp_histfile_num,' ')
1040 : call add_default ('CLHMODIS',cosp_histfile_num,' ')
1041 : call add_default ('CLMMODIS',cosp_histfile_num,' ')
1042 : call add_default ('CLLMODIS',cosp_histfile_num,' ')
1043 : call add_default ('TAUTMODIS',cosp_histfile_num,' ')
1044 : call add_default ('TAUWMODIS',cosp_histfile_num,' ')
1045 : call add_default ('TAUIMODIS',cosp_histfile_num,' ')
1046 : call add_default ('TAUTLOGMODIS',cosp_histfile_num,' ')
1047 : call add_default ('TAUWLOGMODIS',cosp_histfile_num,' ')
1048 : call add_default ('TAUILOGMODIS',cosp_histfile_num,' ')
1049 : call add_default ('REFFCLWMODIS',cosp_histfile_num,' ')
1050 : call add_default ('REFFCLIMODIS',cosp_histfile_num,' ')
1051 : call add_default ('PCTMODIS',cosp_histfile_num,' ')
1052 : call add_default ('LWPMODIS',cosp_histfile_num,' ')
1053 : call add_default ('IWPMODIS',cosp_histfile_num,' ')
1054 : call add_default ('CLMODIS',cosp_histfile_num,' ')
1055 : call add_default ('CLRIMODIS',cosp_histfile_num,' ')
1056 : call add_default ('CLRLMODIS',cosp_histfile_num,' ')
1057 : end if
1058 :
1059 : ! SUB-COLUMN OUTPUT
1060 : if (lfrac_out) then
1061 : ! frac_out (time,height_mlev,column,profile)
1062 : call addfld ('SCOPS_OUT',(/'cosp_scol','lev '/),'I','0=nocld,1=strcld,2=cnvcld','SCOPS Subcolumn output', &
1063 : flag_xyfill=.true., fill_value=R_UNDEF)
1064 : !! add scops ouptut to history file specified by the CAM namelist variable cosp_histfile_num
1065 : call add_default ('SCOPS_OUT',cosp_histfile_num,' ')
1066 : ! save sub-column outputs from ISCCP if ISCCP is run
1067 : if (lisccp_sim) then
1068 : call add_default ('TAU_ISCCP',cosp_histfile_num,' ')
1069 : call add_default ('CLDPTOP_ISCCP',cosp_histfile_num,' ')
1070 : end if
1071 : ! save sub-column outputs from calipso if calipso is run
1072 : if (llidar_sim) then
1073 : call add_default ('ATB532_CAL',cosp_histfile_num,' ')
1074 : end if
1075 : ! save sub-column outputs from radar if radar is run
1076 : if (lradar_sim) then
1077 : call add_default ('DBZE_CS',cosp_histfile_num,' ')
1078 : end if
1079 : end if
1080 :
1081 : !! ADDFLD, ADD_DEFAULT, OUTFLD CALLS FOR COSP OUTPUTS IF RUNNING COSP OFF-LINE
1082 : !! Note: A suggestion was to add all of the CAM variables needed to add to make it possible to run COSP off-line
1083 : !! These fields are available and can be called from the namelist though. Here, when the cosp_runall mode is invoked
1084 : !! all of the inputs are saved on the cam history file. This is good de-bugging functionality we should maintain.
1085 : if (cosp_histfile_aux) then
1086 : call addfld ('PS_COSP', horiz_only, 'I','Pa', 'PS_COSP', &
1087 : flag_xyfill=.true., fill_value=R_UNDEF)
1088 : call addfld ('TS_COSP', horiz_only, 'I','K', 'TS_COSP', &
1089 : flag_xyfill=.true., fill_value=R_UNDEF)
1090 : call addfld ('P_COSP', (/ 'lev'/), 'I','Pa', 'P_COSP', &
1091 : flag_xyfill=.true., fill_value=R_UNDEF)
1092 : call addfld ('PH_COSP', (/ 'lev'/), 'I','Pa', 'PH_COSP', &
1093 : flag_xyfill=.true., fill_value=R_UNDEF)
1094 : call addfld ('ZLEV_COSP', (/ 'lev'/), 'I','m', 'ZLEV_COSP', &
1095 : flag_xyfill=.true., fill_value=R_UNDEF)
1096 : call addfld ('ZLEV_HALF_COSP', (/ 'lev'/), 'I','m', 'ZLEV_HALF_COSP', &
1097 : flag_xyfill=.true., fill_value=R_UNDEF)
1098 : call addfld ('T_COSP', (/ 'lev'/), 'I','K', 'T_COSP', &
1099 : flag_xyfill=.true., fill_value=R_UNDEF)
1100 : call addfld ('RH_COSP', (/ 'lev'/), 'I','percent','RH_COSP', &
1101 : flag_xyfill=.true., fill_value=R_UNDEF)
1102 : call addfld ('Q_COSP', (/ 'lev'/), 'I','kg/kg', 'Q_COSP', &
1103 : flag_xyfill=.true., fill_value=R_UNDEF)
1104 : call addfld ('TAU_067', (/'cosp_scol','lev '/), 'I','1', 'Subcolumn 0.67micron optical depth', &
1105 : flag_xyfill=.true., fill_value=R_UNDEF)
1106 : call addfld ('EMISS_11', (/'cosp_scol','lev '/), 'I','1', 'Subcolumn 11micron emissivity', &
1107 : flag_xyfill=.true., fill_value=R_UNDEF)
1108 : call addfld ('MODIS_fracliq', (/'cosp_scol','lev '/), 'I','1', 'Fraction of tau from liquid water', &
1109 : flag_xyfill=.true., fill_value=R_UNDEF)
1110 : call addfld ('MODIS_asym', (/'cosp_scol','lev '/), 'I','1', 'Asymmetry parameter (MODIS)', &
1111 : flag_xyfill=.true., fill_value=R_UNDEF)
1112 : call addfld ('MODIS_ssa', (/'cosp_scol','lev '/), 'I','1', 'Single-scattering albedo (MODIS)', &
1113 : flag_xyfill=.true., fill_value=R_UNDEF)
1114 : call addfld ('CAL_betatot', (/'cosp_scol','lev '/), 'I','1', 'Backscatter coefficient (CALIPSO)', &
1115 : flag_xyfill=.true., fill_value=R_UNDEF)
1116 : call addfld ('CAL_betatot_ice', (/'cosp_scol','lev '/), 'I','1', 'Backscatter coefficient (CALIPSO)', &
1117 : flag_xyfill=.true., fill_value=R_UNDEF)
1118 : call addfld ('CAL_betatot_liq', (/'cosp_scol','lev '/), 'I','1', 'Backscatter coefficient (CALIPSO)', &
1119 : flag_xyfill=.true., fill_value=R_UNDEF)
1120 : call addfld ('CAL_tautot', (/'cosp_scol','lev '/), 'I','1', 'Vertically integrated ptical-depth (CALIPSO)', &
1121 : flag_xyfill=.true., fill_value=R_UNDEF)
1122 : call addfld ('CAL_tautot_ice', (/'cosp_scol','lev '/), 'I','1', 'Vertically integrated ptical-depth (CALIPSO)', &
1123 : flag_xyfill=.true., fill_value=R_UNDEF)
1124 : call addfld ('CAL_tautot_liq', (/'cosp_scol','lev '/), 'I','1', 'Vertically integrated ptical-depth (CALIPSO)', &
1125 : flag_xyfill=.true., fill_value=R_UNDEF)
1126 : call addfld ('CS_z_vol', (/'cosp_scol','lev '/), 'I','1', 'Effective reflectivity factor (CLOUDSAT)', &
1127 : flag_xyfill=.true., fill_value=R_UNDEF)
1128 : call addfld ('CS_kr_vol', (/'cosp_scol','lev '/), 'I','1', 'Attenuation coefficient (hydro) (CLOUDSAT)', &
1129 : flag_xyfill=.true., fill_value=R_UNDEF)
1130 : call addfld ('CS_g_vol', (/'cosp_scol','lev '/), 'I','1', 'Attenuation coefficient (gases) (CLOUDSAT)', &
1131 : flag_xyfill=.true., fill_value=R_UNDEF)
1132 :
1133 : call add_default ('PS_COSP', cosp_histfile_aux_num,' ')
1134 : call add_default ('TS_COSP', cosp_histfile_aux_num,' ')
1135 : call add_default ('P_COSP', cosp_histfile_aux_num,' ')
1136 : call add_default ('PH_COSP', cosp_histfile_aux_num,' ')
1137 : call add_default ('ZLEV_COSP', cosp_histfile_aux_num,' ')
1138 : call add_default ('ZLEV_HALF_COSP', cosp_histfile_aux_num,' ')
1139 : call add_default ('T_COSP', cosp_histfile_aux_num,' ')
1140 : call add_default ('RH_COSP', cosp_histfile_aux_num,' ')
1141 : call add_default ('TAU_067', cosp_histfile_aux_num,' ')
1142 : call add_default ('EMISS_11', cosp_histfile_aux_num,' ')
1143 : call add_default ('MODIS_fracliq', cosp_histfile_aux_num,' ')
1144 : call add_default ('MODIS_asym', cosp_histfile_aux_num,' ')
1145 : call add_default ('MODIS_ssa', cosp_histfile_aux_num,' ')
1146 : call add_default ('CAL_betatot', cosp_histfile_aux_num,' ')
1147 : call add_default ('CAL_betatot_ice', cosp_histfile_aux_num,' ')
1148 : call add_default ('CAL_betatot_liq', cosp_histfile_aux_num,' ')
1149 : call add_default ('CAL_tautot', cosp_histfile_aux_num,' ')
1150 : call add_default ('CAL_tautot_ice', cosp_histfile_aux_num,' ')
1151 : call add_default ('CAL_tautot_liq', cosp_histfile_aux_num,' ')
1152 : call add_default ('CS_z_vol', cosp_histfile_aux_num,' ')
1153 : call add_default ('CS_kr_vol', cosp_histfile_aux_num,' ')
1154 : call add_default ('CS_g_vol', cosp_histfile_aux_num,' ')
1155 : end if
1156 :
1157 : rei_idx = pbuf_get_index('REI')
1158 : rel_idx = pbuf_get_index('REL')
1159 : cld_idx = pbuf_get_index('CLD')
1160 : concld_idx = pbuf_get_index('CONCLD')
1161 : lsreffrain_idx = pbuf_get_index('LS_REFFRAIN')
1162 : lsreffsnow_idx = pbuf_get_index('LS_REFFSNOW')
1163 : cvreffliq_idx = pbuf_get_index('CV_REFFLIQ')
1164 : cvreffice_idx = pbuf_get_index('CV_REFFICE')
1165 : dpcldliq_idx = pbuf_get_index('DP_CLDLIQ')
1166 : dpcldice_idx = pbuf_get_index('DP_CLDICE')
1167 : shcldliq1_idx = pbuf_get_index('SH_CLDLIQ1')
1168 : shcldice1_idx = pbuf_get_index('SH_CLDICE1')
1169 : dpflxprc_idx = pbuf_get_index('DP_FLXPRC')
1170 : dpflxsnw_idx = pbuf_get_index('DP_FLXSNW')
1171 : shflxprc_idx = pbuf_get_index('SH_FLXPRC', errcode=ierr)
1172 : shflxsnw_idx = pbuf_get_index('SH_FLXSNW', errcode=ierr)
1173 : lsflxprc_idx = pbuf_get_index('LS_FLXPRC')
1174 : lsflxsnw_idx = pbuf_get_index('LS_FLXSNW')
1175 :
1176 : allocate(first_run_cosp(begchunk:endchunk))
1177 : first_run_cosp(begchunk:endchunk)=.true.
1178 : allocate(run_cosp(1:pcols,begchunk:endchunk))
1179 : run_cosp(1:pcols,begchunk:endchunk)=.false.
1180 :
1181 : #endif
1182 1536 : end subroutine cospsimulator_intr_init
1183 :
1184 : ! ######################################################################################
1185 : ! SUBROUTINE cospsimulator_intr_run
1186 : ! ######################################################################################
1187 0 : subroutine cospsimulator_intr_run(state,pbuf, cam_in,emis,coszrs,cld_swtau_in,snow_tau_in,snow_emis_in)
1188 : use physics_types, only: physics_state
1189 : use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx
1190 : use camsrfexch, only: cam_in_t
1191 : use constituents, only: cnst_get_ind
1192 : use rad_constituents, only: rad_cnst_get_gas
1193 : use wv_saturation, only: qsat_water
1194 : use interpolate_data, only: lininterp_init,lininterp,lininterp_finish,interp_type
1195 : use physconst, only: pi, gravit
1196 : use cam_history, only: outfld,hist_fld_col_active
1197 : use cam_history_support, only: max_fieldname_len
1198 : use cmparray_mod, only: CmpDayNite, ExpDayNite
1199 : #ifdef USE_COSP
1200 : use mod_cosp_config, only: R_UNDEF,parasol_nrefl, Nlvgrid, vgrid_zl, vgrid_zu
1201 : use mod_cosp, only: cosp_simulator
1202 : use mod_quickbeam_optics, only: size_distribution
1203 : #endif
1204 :
1205 : ! ######################################################################################
1206 : ! Inputs
1207 : ! ######################################################################################
1208 : type(physics_state), intent(in),target :: state
1209 : type(physics_buffer_desc), pointer :: pbuf(:)
1210 : type(cam_in_t), intent(in) :: cam_in
1211 : real(r8), intent(in) :: emis(pcols,pver) ! cloud longwave emissivity
1212 : real(r8), intent(in) :: coszrs(pcols) ! cosine solar zenith angle (to tell if day or night)
1213 : real(r8), intent(in),optional :: cld_swtau_in(pcols,pver) ! RRTM cld_swtau_in, read in using this variable
1214 : real(r8), intent(in),optional :: snow_tau_in(pcols,pver) ! RRTM grid-box mean SW snow optical depth, used for CAM5 simulations
1215 : real(r8), intent(in),optional :: snow_emis_in(pcols,pver) ! RRTM grid-box mean LW snow optical depth, used for CAM5 simulations
1216 :
1217 : #ifdef USE_COSP
1218 : ! ######################################################################################
1219 : ! Local variables
1220 : ! ######################################################################################
1221 : integer :: lchnk ! chunk identifier
1222 : integer :: ncol ! number of active atmospheric columns
1223 : integer :: i,k,ip,it,ipt,ih,id,ihd,is,ihs,isc,ihsc,ihm,ihmt,ihml,itim_old,ifld
1224 :
1225 : ! Variables for day/nite and orbital subsetting
1226 : ! Gathered indicies of day and night columns
1227 : ! chunk_column_index = IdxDay(daylight_column_index)
1228 : integer :: Nday ! Number of daylight columns
1229 : integer :: Nno ! Number of columns not using for simulator
1230 : integer, dimension(pcols) :: IdxDay ! Indices of daylight columns
1231 : integer, dimension(pcols) :: IdxNo ! Indices of columns not using for simulator
1232 : real(r8) :: tmp(pcols) ! tempororary variable for array expansion
1233 : real(r8) :: tmp1(pcols,pver) ! tempororary variable for array expansion
1234 : real(r8) :: tmp2(pcols,pver) ! tempororary variable for array expansion
1235 : real(r8) :: lon_cosp_day(pcols) ! tempororary variable for sunlit lons
1236 : real(r8) :: lat_cosp_day(pcols) ! tempororary variable for sunlit lats
1237 : real(r8) :: ptop_day(pcols,pver) ! tempororary variable for sunlit ptop
1238 : real(r8) :: pmid_day(pcols,pver) ! tempororary variable for sunlit pmid
1239 : real(r8) :: ztop_day(pcols,pver) ! tempororary variable for sunlit ztop
1240 : real(r8) :: zmid_day(pcols,pver) ! tempororary variable for sunlit zmid
1241 : real(r8) :: t_day(pcols,pver) ! tempororary variable for sunlit t
1242 : real(r8) :: rh_day(pcols,pver) ! tempororary variable for sunlit rh
1243 : real(r8) :: q_day(pcols,pver) ! tempororary variable for sunlit q
1244 : real(r8) :: concld_day(pcols,pver) ! tempororary variable for sunlit concld
1245 : real(r8) :: cld_day(pcols,pver) ! tempororary variable for sunlit cld
1246 : real(r8) :: ps_day(pcols) ! tempororary variable for sunlit ps
1247 : real(r8) :: ts_day(pcols) ! tempororary variable for sunlit ts
1248 : real(r8) :: landmask_day(pcols) ! tempororary variable for sunlit landmask
1249 : real(r8) :: o3_day(pcols,pver) ! tempororary variable for sunlit o3
1250 : real(r8) :: us_day(pcols) ! tempororary variable for sunlit us
1251 : real(r8) :: vs_day(pcols) ! tempororary variable for sunlit vs
1252 : real(r8) :: mr_lsliq_day(pcols,pver) ! tempororary variable for sunlit mr_lsliq
1253 : real(r8) :: mr_lsice_day(pcols,pver) ! tempororary variable for sunlit mr_lsice
1254 : real(r8) :: mr_ccliq_day(pcols,pver) ! tempororary variable for sunlit mr_ccliq
1255 : real(r8) :: mr_ccice_day(pcols,pver) ! tempororary variable for sunlit mr_ccice
1256 : real(r8) :: rain_ls_interp_day(pcols,pver) ! tempororary variable for sunlit rain_ls_interp
1257 : real(r8) :: snow_ls_interp_day(pcols,pver) ! tempororary variable for sunlit snow_ls_interp
1258 : real(r8) :: grpl_ls_interp_day(pcols,pver) ! tempororary variable for sunlit grpl_ls_interp
1259 : real(r8) :: rain_cv_interp_day(pcols,pver) ! tempororary variable for sunlit rain_cv_interp
1260 : real(r8) :: snow_cv_interp_day(pcols,pver) ! tempororary variable for sunlit snow_cv_interp
1261 : real(r8) :: reff_cosp_day(pcols,pver,nhydro) ! tempororary variable for sunlit reff_cosp(:,:,:)
1262 : real(r8) :: dtau_s_day(pcols,pver) ! tempororary variable for sunlit dtau_s
1263 : real(r8) :: dtau_c_day(pcols,pver) ! tempororary variable for sunlit dtau_c
1264 : real(r8) :: dtau_s_snow_day(pcols,pver) ! tempororary variable for sunlit dtau_s_snow
1265 : real(r8) :: dem_s_day(pcols,pver) ! tempororary variable for sunlit dem_s
1266 : real(r8) :: dem_c_day(pcols,pver) ! tempororary variable for sunlit dem_c
1267 : real(r8) :: dem_s_snow_day(pcols,pver) ! tempororary variable for sunlit dem_s_snow
1268 :
1269 : ! Constants for optical depth calculation (from radcswmx.F90)
1270 : real(r8), parameter :: abarl = 2.817e-02_r8 ! A coefficient for extinction optical depth
1271 : real(r8), parameter :: bbarl = 1.305_r8 ! b coefficient for extinction optical depth
1272 : real(r8), parameter :: abari = 3.448e-03_r8 ! A coefficient for extinction optical depth
1273 : real(r8), parameter :: bbari = 2.431_r8 ! b coefficient for extinction optical depth
1274 : real(r8), parameter :: cldmin = 1.0e-80_r8 ! note: cldmin much less than cldmin from cldnrh
1275 : real(r8), parameter :: cldeps = 0.0_r8
1276 :
1277 : ! Microphysics variables
1278 : integer, parameter :: ncnstmax=4 ! number of constituents
1279 : character(len=8), dimension(ncnstmax), parameter :: & ! constituent names
1280 : cnst_names = (/'CLDLIQ', 'CLDICE','NUMLIQ','NUMICE'/)
1281 : integer :: ncnst ! number of constituents (can vary)
1282 : integer :: ixcldliq ! cloud liquid amount index for state%q
1283 : integer :: ixcldice ! cloud ice amount index
1284 : integer :: ixnumliq ! cloud liquid number index
1285 : integer :: ixnumice ! cloud ice water index
1286 :
1287 : ! COSP-related local vars
1288 : type(cosp_outputs) :: cospOUT ! COSP simulator outputs
1289 : type(cosp_optical_inputs) :: cospIN ! COSP optical (or derived?) fields needed by simulators
1290 : type(cosp_column_inputs) :: cospstateIN ! COSP model fields needed by simulators
1291 :
1292 : ! COSP input variables that depend on CAM
1293 : ! 1) Npoints = number of gridpoints COSP will process (without subsetting, Npoints=ncol)
1294 : ! 2) Nlevels = number of model levels (Nlevels=pver)
1295 : real(r8), parameter :: time = 1.0_r8 ! time ! Time since start of run [days], set to 1 bc running over single CAM timestep
1296 : real(r8), parameter :: time_bnds(2)=(/0.5_r8,1.5_r8/) ! time_bnds ! Time boundaries - new in cosp v1.3, set following cosp_test.f90 line 121
1297 : integer :: Npoints ! Number of gridpoints COSP will process
1298 : integer :: Nlevels ! Nlevels
1299 : logical :: use_reff ! True if effective radius to be used by radar simulator
1300 : ! (always used by lidar)
1301 : logical :: use_precipitation_fluxes ! True if precipitation fluxes are input to the algorithm
1302 : real(r8), parameter :: emsfc_lw = 0.99_r8 ! longwave emissivity of surface at 10.5 microns
1303 : ! set value same as in cloudsimulator.F90
1304 :
1305 : ! Local vars related to calculations to go from CAM input to COSP input
1306 : ! cosp convective value includes both deep and shallow convection
1307 : real(r8) :: ptop(pcols,pver) ! top interface pressure (Pa)
1308 : real(r8) :: ztop(pcols,pver) ! top interface height asl (m)
1309 : real(r8) :: pbot(pcols,pver) ! bottom interface pressure (Pa)
1310 : real(r8) :: zbot(pcols,pver) ! bottom interface height asl (m)
1311 : real(r8) :: zmid(pcols,pver) ! middle interface height asl (m)
1312 : real(r8) :: lat_cosp(pcols) ! lat for cosp (degrees_north)
1313 : real(r8) :: lon_cosp(pcols) ! lon for cosp (degrees_east)
1314 : real(r8) :: landmask(pcols) ! landmask (0 or 1)
1315 : real(r8) :: mr_lsliq(pcols,pver) ! mixing_ratio_large_scale_cloud_liquid (kg/kg)
1316 : real(r8) :: mr_lsice(pcols,pver) ! mixing_ratio_large_scale_cloud_ice (kg/kg)
1317 : real(r8) :: mr_ccliq(pcols,pver) ! mixing_ratio_convective_cloud_liquid (kg/kg)
1318 : real(r8) :: mr_ccice(pcols,pver) ! mixing_ratio_convective_cloud_ice (kg/kg)
1319 : real(r8) :: rain_cv(pcols,pverp) ! interface flux_convective_cloud_rain (kg m^-2 s^-1)
1320 : real(r8) :: snow_cv(pcols,pverp) ! interface flux_convective_cloud_snow (kg m^-2 s^-1)
1321 : real(r8) :: rain_cv_interp(pcols,pver) ! midpoint flux_convective_cloud_rain (kg m^-2 s^-1)
1322 : real(r8) :: snow_cv_interp(pcols,pver) ! midpoint flux_convective_cloud_snow (kg m^-2 s^-1)
1323 : real(r8) :: grpl_ls_interp(pcols,pver) ! midpoint ls grp flux, should be 0
1324 : real(r8) :: rain_ls_interp(pcols,pver) ! midpoint ls rain flux (kg m^-2 s^-1)
1325 : real(r8) :: snow_ls_interp(pcols,pver) ! midpoint ls snow flux
1326 : real(r8) :: reff_cosp(pcols,pver,nhydro) ! effective radius for cosp input
1327 : real(r8) :: rh(pcols,pver) ! relative_humidity_liquid_water (%)
1328 : real(r8) :: es(pcols,pver) ! saturation vapor pressure
1329 : real(r8) :: qs(pcols,pver) ! saturation mixing ratio (kg/kg), saturation specific humidity
1330 : real(r8) :: cld_swtau(pcols,pver) ! incloud sw tau for input to COSP
1331 : real(r8) :: dtau_s(pcols,pver) ! dtau_s - Optical depth of stratiform cloud at 0.67 um
1332 : real(r8) :: dtau_c(pcols,pver) ! dtau_c - Optical depth of convective cloud at 0.67 um
1333 : real(r8) :: dtau_s_snow(pcols,pver) ! dtau_s_snow - Grid-box mean Optical depth of stratiform snow at 0.67 um
1334 : real(r8) :: dem_s(pcols,pver) ! dem_s - Longwave emis of stratiform cloud at 10.5 um
1335 : real(r8) :: dem_c(pcols,pver) ! dem_c - Longwave emis of convective cloud at 10.5 um
1336 : real(r8) :: dem_s_snow(pcols,pver) ! dem_s_snow - Grid-box mean Optical depth of stratiform snow at 10.5 um
1337 : integer :: cam_sunlit(pcols) ! cam_sunlit - Sunlit flag(1-sunlit/0-dark).
1338 : integer :: nSunLit,nNoSunLit ! Number of sunlit (not sunlit) scenes.
1339 :
1340 : ! ######################################################################################
1341 : ! Simulator output info
1342 : ! ######################################################################################
1343 : integer, parameter :: nf_radar=17 ! number of radar outputs
1344 : integer, parameter :: nf_calipso=28 ! number of calipso outputs
1345 : integer, parameter :: nf_isccp=9 ! number of isccp outputs
1346 : integer, parameter :: nf_misr=1 ! number of misr outputs
1347 : integer, parameter :: nf_modis=20 ! number of modis outputs
1348 :
1349 : ! Cloudsat outputs
1350 : character(len=max_fieldname_len),dimension(nf_radar),parameter :: &
1351 : fname_radar = (/'CFAD_DBZE94_CS', 'CLD_CAL_NOTCS ', 'DBZE_CS ', &
1352 : 'CLDTOT_CALCS ', 'CLDTOT_CS ', 'CLDTOT_CS2 ', &
1353 : 'CS_NOPRECIP ', 'CS_RAINPOSS ', 'CS_RAINPROB ', &
1354 : 'CS_RAINCERT ', 'CS_SNOWPOSS ', 'CS_SNOWCERT ', &
1355 : 'CS_MIXPOSS ', 'CS_MIXCERT ', 'CS_RAINHARD ', &
1356 : 'CS_UN ', 'CS_PIA '/)!, 'CAM_MP_CVRAIN ', &
1357 : !'CAM_MP_CVSNOW ', 'CAM_MP_LSRAIN ', 'CAM_MP_LSSNOW ', &
1358 : !'CAM_MP_LSGRPL '/)
1359 :
1360 : ! CALIPSO outputs
1361 : character(len=max_fieldname_len),dimension(nf_calipso),parameter :: &
1362 : fname_calipso=(/'CLDLOW_CAL ','CLDMED_CAL ','CLDHGH_CAL ','CLDTOT_CAL ','CLD_CAL ',&
1363 : 'RFL_PARASOL ','CFAD_SR532_CAL ','ATB532_CAL ','MOL532_CAL ','CLD_CAL_LIQ ',&
1364 : 'CLD_CAL_ICE ','CLD_CAL_UN ','CLD_CAL_TMP ','CLD_CAL_TMPLIQ ','CLD_CAL_TMPICE ',&
1365 : 'CLD_CAL_TMPUN ','CLDTOT_CAL_ICE ','CLDTOT_CAL_LIQ ','CLDTOT_CAL_UN ','CLDHGH_CAL_ICE ',&
1366 : 'CLDHGH_CAL_LIQ ','CLDHGH_CAL_UN ','CLDMED_CAL_ICE ','CLDMED_CAL_LIQ ','CLDMED_CAL_UN ',&
1367 : 'CLDLOW_CAL_ICE ','CLDLOW_CAL_LIQ ','CLDLOW_CAL_UN '/)!, &
1368 : ! 'CLDOPQ_CAL ','CLDTHN_CAL ','CLDZOPQ_CAL ','CLDOPQ_CAL_2D ','CLDTHN_CAL_2D ',&
1369 : ! 'CLDZOPQ_CAL_2D ','OPACITY_CAL_2D ','CLDOPQ_CAL_TMP ','CLDTHN_CAL_TMP ','CLDZOPQ_CAL_TMP',&
1370 : ! 'CLDOPQ_CAL_Z ','CLDTHN_CAL_Z ','CLDTHN_CAL_EMIS','CLDOPQ_CAL_SE ','CLDTHN_CAL_SE ',&
1371 : ! 'CLDZOPQ_CAL_SE' /)
1372 : ! ISCCP outputs
1373 : character(len=max_fieldname_len),dimension(nf_isccp),parameter :: &
1374 : fname_isccp=(/'FISCCP1_COSP ','CLDTOT_ISCCP ','MEANCLDALB_ISCCP',&
1375 : 'MEANPTOP_ISCCP ','TAU_ISCCP ','CLDPTOP_ISCCP ','MEANTAU_ISCCP ',&
1376 : 'MEANTB_ISCCP ','MEANTBCLR_ISCCP '/)
1377 : ! MISR outputs
1378 : character(len=max_fieldname_len),dimension(nf_misr),parameter :: &
1379 : fname_misr=(/'CLD_MISR '/)
1380 : ! MODIS outputs
1381 : character(len=max_fieldname_len),dimension(nf_modis) :: &
1382 : fname_modis=(/'CLTMODIS ','CLWMODIS ','CLIMODIS ','CLHMODIS ','CLMMODIS ',&
1383 : 'CLLMODIS ','TAUTMODIS ','TAUWMODIS ','TAUIMODIS ','TAUTLOGMODIS',&
1384 : 'TAUWLOGMODIS','TAUILOGMODIS','REFFCLWMODIS','REFFCLIMODIS',&
1385 : 'PCTMODIS ','LWPMODIS ','IWPMODIS ','CLMODIS ','CLRIMODIS ',&
1386 : 'CLRLMODIS '/)
1387 :
1388 : logical :: run_radar(nf_radar,pcols) ! logical telling you if you should run radar simulator
1389 : logical :: run_calipso(nf_calipso,pcols) ! logical telling you if you should run calipso simulator
1390 : logical :: run_isccp(nf_isccp,pcols) ! logical telling you if you should run isccp simulator
1391 : logical :: run_misr(nf_misr,pcols) ! logical telling you if you should run misr simulator
1392 : logical :: run_modis(nf_modis,pcols) ! logical telling you if you should run modis simulator
1393 :
1394 : ! CAM pointers to get variables from radiation interface (get from rad_cnst_get_gas)
1395 : real(r8), pointer, dimension(:,:) :: q ! specific humidity (kg/kg)
1396 : real(r8), pointer, dimension(:,:) :: o3 ! Mass mixing ratio 03
1397 : real(r8), pointer, dimension(:,:) :: co2 ! Mass mixing ratio C02
1398 : real(r8), pointer, dimension(:,:) :: ch4 ! Mass mixing ratio CH4
1399 : real(r8), pointer, dimension(:,:) :: n2o ! Mass mixing ratio N20
1400 :
1401 : ! CAM pointers to get variables from the physics buffer
1402 : real(r8), pointer, dimension(:,:) :: cld ! cloud fraction, tca - total_cloud_amount (0-1)
1403 : real(r8), pointer, dimension(:,:) :: concld ! concld fraction, cca - convective_cloud_amount (0-1)
1404 : real(r8), pointer, dimension(:,:) :: rel ! liquid effective drop radius (microns)
1405 : real(r8), pointer, dimension(:,:) :: rei ! ice effective drop size (microns)
1406 : real(r8), pointer, dimension(:,:) :: ls_reffrain ! rain effective drop radius (microns)
1407 : real(r8), pointer, dimension(:,:) :: ls_reffsnow ! snow effective drop size (microns)
1408 : real(r8), pointer, dimension(:,:) :: cv_reffliq ! convective cld liq effective drop radius (microns)
1409 : real(r8), pointer, dimension(:,:) :: cv_reffice ! convective cld ice effective drop size (microns)
1410 :
1411 : !! precip flux pointers (use for cam4 or cam5)
1412 : real(r8), target, dimension(pcols,pverp) :: zero_ifc ! zero array for interface fields not in the pbuf
1413 : ! Added pointers; pbuff in zm_conv_intr.F90, calc in zm_conv.F90
1414 : real(r8), pointer, dimension(:,:) :: dp_flxprc ! deep interface gbm flux_convective_cloud_rain+snow (kg m^-2 s^-1)
1415 : real(r8), pointer, dimension(:,:) :: dp_flxsnw ! deep interface gbm flux_convective_cloud_snow (kg m^-2 s^-1)
1416 : ! More pointers; pbuf in convect_shallow.F90, calc in hk_conv.F90/convect_shallow.F90 (CAM4), uwshcu.F90 (CAM5)
1417 : real(r8), pointer, dimension(:,:) :: sh_flxprc ! shallow interface gbm flux_convective_cloud_rain+snow (kg m^-2 s^-1)
1418 : real(r8), pointer, dimension(:,:) :: sh_flxsnw ! shallow interface gbm flux_convective_cloud_snow (kg m^-2 s^-1)
1419 : ! More pointers; pbuf in stratiform.F90, getting from pbuf here
1420 : ! a) added as output to pcond subroutine in cldwat.F90 and to nmicro_pcond subroutine in cldwat2m_micro.F90
1421 : real(r8), pointer, dimension(:,:) :: ls_flxprc ! stratiform interface gbm flux_cloud_rain+snow (kg m^-2 s^-1)
1422 : real(r8), pointer, dimension(:,:) :: ls_flxsnw ! stratiform interface gbm flux_cloud_snow (kg m^-2 s^-1)
1423 :
1424 : !! cloud mixing ratio pointers (note: large-scale in state)
1425 : ! More pointers; pbuf in convect_shallow.F90 (cam4) or stratiform.F90 (cam5)
1426 : ! calc in hk_conv.F90 (CAM4 should be 0!), uwshcu.F90 but then affected by micro so values from stratiform.F90 (CAM5)
1427 : real(r8), pointer, dimension(:,:) :: sh_cldliq ! shallow gbm cloud liquid water (kg/kg)
1428 : real(r8), pointer, dimension(:,:) :: sh_cldice ! shallow gbm cloud ice water (kg/kg)
1429 : ! More pointers; pbuf in zm_conv_intr.F90, calc in zm_conv.F90, 0 for CAM4 and CAM5 (same convection scheme)
1430 : real(r8), pointer, dimension(:,:) :: dp_cldliq ! deep gbm cloud liquid water (kg/kg)
1431 : real(r8), pointer, dimension(:,:) :: dp_cldice ! deep gmb cloud ice water (kg/kg)
1432 :
1433 : ! Output CAM variables
1434 : ! Notes:
1435 : ! 1) use pcols (maximum number of columns that code could use, maybe 16)
1436 : ! pcols vs. ncol. ncol is the number of columns a chunk is actually using, pcols is maximum number
1437 : ! 2) Mixed variables rules/notes, need to collapse because CAM history does not support increased dimensionality
1438 : ! MIXED DIMS: ntau_cosp*nprs_cosp, CLOUDSAT_DBZE_BINS*nht_cosp, nsr_cosp*nht_cosp, nscol_cosp*nhtml_cosp, ntau_cosp*nhtmisr_cosp
1439 : ! a) always making mixed variables VERTICAL*OTHER, e.g., pressure*tau or ht*dbze
1440 : ! b) always collapsing output as V1_1/V2_1...V1_1/V2_N ; V1_2/V2_1 ...V1_2/V2_N etc. to V1_N/V2_1 ... V1_N/V2_N
1441 : ! c) here, need vars for both multi-dimensional output from COSP, and two-dimensional output from CAM
1442 : ! 3) ntime=1, nprofile=ncol
1443 : ! 4) dimensions listed in COSP units are from netcdf output from cosp test case, and are not necessarily in the
1444 : ! correct order. In fact, most of them are not as I discovered after trying to run COSP in-line.
1445 : ! BE says this could be because FORTRAN and C (netcdf defaults to C) have different conventions.
1446 : ! 5) !! Note: after running COSP, it looks like height_mlev is actually the model levels after all!!
1447 : real(r8) :: clisccp2(pcols,ntau_cosp,nprs_cosp) ! clisccp2 (time,tau,plev,profile)
1448 : real(r8) :: cfad_dbze94(pcols,CLOUDSAT_DBZE_BINS,nht_cosp) ! cfad_dbze94 (time,height,dbze,profile)
1449 : real(r8) :: cfad_lidarsr532(pcols,nsr_cosp,nht_cosp) ! cfad_lidarsr532 (time,height,scat_ratio,profile)
1450 : real(r8) :: dbze94(pcols,nscol_cosp,nhtml_cosp) ! dbze94 (time,height_mlev,column,profile)
1451 : real(r8) :: atb532(pcols,nscol_cosp,nhtml_cosp) ! atb532 (time,height_mlev,column,profile)
1452 : real(r8) :: clMISR(pcols,ntau_cosp,nhtmisr_cosp) ! clMISR (time,tau,CTH_height_bin,profile)
1453 : real(r8) :: frac_out(pcols,nscol_cosp,nhtml_cosp) ! frac_out (time,height_mlev,column,profile)
1454 : real(r8) :: cldtot_isccp(pcols) ! CAM tclisccp (time,profile)
1455 : real(r8) :: meancldalb_isccp(pcols) ! CAM albisccp (time,profile)
1456 : real(r8) :: meanptop_isccp(pcols) ! CAM ctpisccp (time,profile)
1457 : real(r8) :: cldlow_cal(pcols) ! CAM cllcalipso (time,profile)
1458 : real(r8) :: cldmed_cal(pcols) ! CAM clmcalipso (time,profile)
1459 : real(r8) :: cldhgh_cal(pcols) ! CAM clhcalipso (time,profile)
1460 : real(r8) :: cldtot_cal(pcols) ! CAM cltcalipso (time,profile)
1461 : real(r8) :: cldtot_cal_ice(pcols) ! CAM (time,profile) !!+cosp1.4
1462 : real(r8) :: cldtot_cal_liq(pcols) ! CAM (time,profile)
1463 : real(r8) :: cldtot_cal_un(pcols) ! CAM (time,profile)
1464 : real(r8) :: cldhgh_cal_ice(pcols) ! CAM (time,profile)
1465 : real(r8) :: cldhgh_cal_liq(pcols) ! CAM (time,profile)
1466 : real(r8) :: cldhgh_cal_un(pcols) ! CAM (time,profile)
1467 : real(r8) :: cldmed_cal_ice(pcols) ! CAM (time,profile)
1468 : real(r8) :: cldmed_cal_liq(pcols) ! CAM (time,profile)
1469 : real(r8) :: cldmed_cal_un(pcols) ! CAM (time,profile)
1470 : real(r8) :: cldlow_cal_ice(pcols) ! CAM (time,profile)
1471 : real(r8) :: cldlow_cal_liq(pcols) ! CAM (time,profile)
1472 : real(r8) :: cldlow_cal_un(pcols) ! CAM (time,profile) !+cosp1.4
1473 : real(r8) :: cld_cal(pcols,nht_cosp) ! CAM clcalipso (time,height,profile)
1474 : real(r8) :: cld_cal_liq(pcols,nht_cosp) ! CAM (time,height,profile) !+cosp1.4
1475 : real(r8) :: cld_cal_ice(pcols,nht_cosp) ! CAM (time,height,profile)
1476 : real(r8) :: cld_cal_un(pcols,nht_cosp) ! CAM (time,height,profile)
1477 : real(r8) :: cld_cal_tmp(pcols,nht_cosp) ! CAM (time,height,profile)
1478 : real(r8) :: cld_cal_tmpliq(pcols,nht_cosp) ! CAM (time,height,profile)
1479 : real(r8) :: cld_cal_tmpice(pcols,nht_cosp) ! CAM (time,height,profile)
1480 : real(r8) :: cld_cal_tmpun(pcols,nht_cosp) ! CAM (time,height,profile) !+cosp1.4
1481 : ! real(r8) :: cldopaq_cal(pcols)
1482 : ! real(r8) :: cldthin_cal(pcols)
1483 : ! real(r8) :: cldopaqz_cal(pcols)
1484 : ! real(r8) :: cldopaq_cal_temp(pcols)
1485 : ! real(r8) :: cldthin_cal_temp(pcols)
1486 : ! real(r8) :: cldzopaq_cal_temp(pcols)
1487 : ! real(r8) :: cldopaq_cal_z(pcols)
1488 : ! real(r8) :: cldthin_cal_z(pcols)
1489 : ! real(r8) :: cldthin_cal_emis(pcols)
1490 : ! real(r8) :: cldopaq_cal_se(pcols)
1491 : ! real(r8) :: cldthin_cal_se(pcols)
1492 : ! real(r8) :: cldzopaq_cal_se(pcols)
1493 : ! real(r8) :: cldopaq_cal_2d(pcols,nht_cosp)
1494 : ! real(r8) :: cldthin_cal_2d(pcols,nht_cosp)
1495 : ! real(r8) :: cldzopaq_cal_2d(pcols,nht_cosp)
1496 : ! real(r8) :: opacity_cal_2d(pcols,nht_cosp)
1497 : real(r8) :: cfad_dbze94_cs(pcols,nht_cosp*CLOUDSAT_DBZE_BINS)! CAM cfad_dbze94 (time,height,dbze,profile)
1498 : real(r8) :: cfad_sr532_cal(pcols,nht_cosp*nsr_cosp) ! CAM cfad_lidarsr532 (time,height,scat_ratio,profile)
1499 : real(r8) :: tau_isccp(pcols,nscol_cosp) ! CAM boxtauisccp (time,column,profile)
1500 : real(r8) :: cldptop_isccp(pcols,nscol_cosp) ! CAM boxptopisccp (time,column,profile)
1501 : real(r8) :: meantau_isccp(pcols) ! CAM tauisccp (time,profile)
1502 : real(r8) :: meantb_isccp(pcols) ! CAM meantbisccp (time,profile)
1503 : real(r8) :: meantbclr_isccp(pcols) ! CAM meantbclrisccp (time,profile)
1504 : real(r8) :: dbze_cs(pcols,nhtml_cosp*nscol_cosp) ! CAM dbze94 (time,height_mlev,column,profile)
1505 : real(r8) :: cldtot_calcs(pcols) ! CAM cltlidarradar (time,profile)
1506 : real(r8) :: cldtot_cs(pcols) ! CAM cltradar (time,profile)
1507 : real(r8) :: cldtot_cs2(pcols) ! CAM cltradar2 (time,profile)
1508 : real(r8) :: ptcloudsatflag0(pcols)
1509 : real(r8) :: ptcloudsatflag1(pcols)
1510 : real(r8) :: ptcloudsatflag2(pcols)
1511 : real(r8) :: ptcloudsatflag3(pcols)
1512 : real(r8) :: ptcloudsatflag4(pcols)
1513 : real(r8) :: ptcloudsatflag5(pcols)
1514 : real(r8) :: ptcloudsatflag6(pcols)
1515 : real(r8) :: ptcloudsatflag7(pcols)
1516 : real(r8) :: ptcloudsatflag8(pcols)
1517 : real(r8) :: ptcloudsatflag9(pcols)
1518 : real(r8) :: cloudsatpia(pcols)
1519 : real(r8) :: cld_cal_notcs(pcols,nht_cosp) ! CAM clcalipso2 (time,height,profile)
1520 : real(r8) :: atb532_cal(pcols,nhtml_cosp*nscol_cosp) ! CAM atb532 (time,height_mlev,column,profile)
1521 : real(r8) :: mol532_cal(pcols,nhtml_cosp) ! CAM beta_mol532 (time,height_mlev,profile)
1522 : real(r8) :: cld_misr(pcols,nhtmisr_cosp*ntau_cosp) ! CAM clMISR (time,tau,CTH_height_bin,profile)
1523 : real(r8) :: refl_parasol(pcols,nsza_cosp) ! CAM parasol_refl (time,sza,profile)
1524 : real(r8) :: scops_out(pcols,nhtml_cosp*nscol_cosp) ! CAM frac_out (time,height_mlev,column,profile)
1525 : real(r8) :: cltmodis(pcols)
1526 : real(r8) :: clwmodis(pcols)
1527 : real(r8) :: climodis(pcols)
1528 : real(r8) :: clhmodis(pcols)
1529 : real(r8) :: clmmodis(pcols)
1530 : real(r8) :: cllmodis(pcols)
1531 : real(r8) :: tautmodis(pcols)
1532 : real(r8) :: tauwmodis(pcols)
1533 : real(r8) :: tauimodis(pcols)
1534 : real(r8) :: tautlogmodis(pcols)
1535 : real(r8) :: tauwlogmodis(pcols)
1536 : real(r8) :: tauilogmodis(pcols)
1537 : real(r8) :: reffclwmodis(pcols)
1538 : real(r8) :: reffclimodis(pcols)
1539 : real(r8) :: pctmodis(pcols)
1540 : real(r8) :: lwpmodis(pcols)
1541 : real(r8) :: iwpmodis(pcols)
1542 : real(r8) :: clmodis_cam(pcols,ntau_cosp_modis*nprs_cosp)
1543 : real(r8) :: clmodis(pcols,ntau_cosp_modis,nprs_cosp)
1544 : real(r8) :: clrimodis_cam(pcols,ntau_cosp*numMODISReffIceBins)
1545 : real(r8) :: clrimodis(pcols,ntau_cosp,numMODISReffIceBins)
1546 : real(r8) :: clrlmodis_cam(pcols,ntau_cosp*numMODISReffLiqBins)
1547 : real(r8) :: clrlmodis(pcols,ntau_cosp,numMODISReffLiqBins)
1548 : !real(r8) :: tau067_out(pcols,nhtml_cosp*nscol_cosp),emis11_out(pcols,nhtml_cosp*nscol_cosp)
1549 : real(r8),dimension(pcols,nhtml_cosp*nscol_cosp) :: &
1550 : tau067_out,emis11_out,fracliq_out,cal_betatot,cal_betatot_ice, &
1551 : cal_betatot_liq,cal_tautot,cal_tautot_ice,cal_tautot_liq,cs_gvol_out,cs_krvol_out,cs_zvol_out,&
1552 : asym34_out,ssa34_out
1553 :
1554 : type(interp_type) :: interp_wgts
1555 : integer, parameter :: extrap_method = 1 ! sets extrapolation method to boundary value (1)
1556 :
1557 : ! COSPv2 stuff
1558 : character(len=256),dimension(100) :: cosp_status
1559 : integer :: nerror
1560 :
1561 : call t_startf("init_and_stuff")
1562 : ! ######################################################################################
1563 : ! Initialization
1564 : ! ######################################################################################
1565 : ! Find the chunk and ncol from the state vector
1566 : lchnk = state%lchnk ! state variable contains a number of columns, one chunk
1567 : ncol = state%ncol ! number of columns in the chunk
1568 :
1569 : zero_ifc = 0._r8
1570 :
1571 : ! Initialize temporary variables as R_UNDEF - need to do this otherwise array expansion puts garbage in history
1572 : ! file for columns over which COSP did make calculations.
1573 : tmp(1:pcols) = R_UNDEF
1574 : tmp1(1:pcols,1:pver) = R_UNDEF
1575 : tmp2(1:pcols,1:pver) = R_UNDEF
1576 :
1577 : ! Initialize CAM variables as R_UNDEF, important for history files because it will exclude these from averages
1578 : ! (multi-dimensional output that will be collapsed)
1579 : ! initialize over all pcols, not just ncol. missing values needed in chunks where ncol<pcols
1580 : clisccp2(1:pcols,1:ntau_cosp,1:nprs_cosp) = R_UNDEF
1581 : cfad_dbze94(1:pcols,1:CLOUDSAT_DBZE_BINS,1:nht_cosp) = R_UNDEF
1582 : cfad_lidarsr532(1:pcols,1:nsr_cosp,1:nht_cosp)= R_UNDEF
1583 : dbze94(1:pcols,1:nscol_cosp,1:nhtml_cosp) = R_UNDEF
1584 : atb532(1:pcols,1:nscol_cosp,1:nhtml_cosp) = R_UNDEF
1585 : clMISR(1:pcols,ntau_cosp,1:nhtmisr_cosp) = R_UNDEF
1586 : frac_out(1:pcols,1:nscol_cosp,1:nhtml_cosp) = R_UNDEF
1587 :
1588 : ! (all CAM output variables. including collapsed variables)
1589 : cldtot_isccp(1:pcols) = R_UNDEF
1590 : meancldalb_isccp(1:pcols) = R_UNDEF
1591 : meanptop_isccp(1:pcols) = R_UNDEF
1592 : cldlow_cal(1:pcols) = R_UNDEF
1593 : cldmed_cal(1:pcols) = R_UNDEF
1594 : cldhgh_cal(1:pcols) = R_UNDEF
1595 : cldtot_cal(1:pcols) = R_UNDEF
1596 : cldtot_cal_ice(1:pcols) = R_UNDEF !+cosp1.4
1597 : cldtot_cal_liq(1:pcols) = R_UNDEF
1598 : cldtot_cal_un(1:pcols) = R_UNDEF
1599 : cldhgh_cal_ice(1:pcols) = R_UNDEF
1600 : cldhgh_cal_liq(1:pcols) = R_UNDEF
1601 : cldhgh_cal_un(1:pcols) = R_UNDEF
1602 : cldmed_cal_ice(1:pcols) = R_UNDEF
1603 : cldmed_cal_liq(1:pcols) = R_UNDEF
1604 : cldmed_cal_un(1:pcols) = R_UNDEF
1605 : cldlow_cal_liq(1:pcols) = R_UNDEF
1606 : cldlow_cal_ice(1:pcols) = R_UNDEF
1607 : cldlow_cal_un(1:pcols) = R_UNDEF !+cosp1.4
1608 : cld_cal(1:pcols,1:nht_cosp) = R_UNDEF
1609 : cld_cal_liq(1:pcols,1:nht_cosp) = R_UNDEF !+cosp1.4
1610 : cld_cal_ice(1:pcols,1:nht_cosp) = R_UNDEF
1611 : cld_cal_un(1:pcols,1:nht_cosp) = R_UNDEF
1612 : cld_cal_tmp(1:pcols,1:nht_cosp) = R_UNDEF
1613 : cld_cal_tmpliq(1:pcols,1:nht_cosp) = R_UNDEF
1614 : cld_cal_tmpice(1:pcols,1:nht_cosp) = R_UNDEF
1615 : cld_cal_tmpun(1:pcols,1:nht_cosp) = R_UNDEF
1616 : ! cldopaq_cal(1:pcols) = R_UNDEF
1617 : ! cldthin_cal(1:pcols) = R_UNDEF
1618 : ! cldopaqz_cal(1:pcols) = R_UNDEF
1619 : ! cldopaq_cal_temp(1:pcols) = R_UNDEF
1620 : ! cldthin_cal_temp(1:pcols) = R_UNDEF
1621 : ! cldzopaq_cal_temp(1:pcols) = R_UNDEF
1622 : ! cldopaq_cal_z(1:pcols) = R_UNDEF
1623 : ! cldthin_cal_z(1:pcols) = R_UNDEF
1624 : ! cldthin_cal_emis(1:pcols) = R_UNDEF
1625 : ! cldopaq_cal_se(1:pcols) = R_UNDEF
1626 : ! cldthin_cal_se(1:pcols) = R_UNDEF
1627 : ! cldzopaq_cal_se(1:pcols) = R_UNDEF
1628 : ! cldopaq_cal_2d(1:pcols,1:nht_cosp) = R_UNDEF
1629 : ! cldthin_cal_2d(1:pcols,1:nht_cosp) = R_UNDEF
1630 : ! cldzopaq_cal_2d(1:pcols,1:nht_cosp) = R_UNDEF
1631 : ! opacity_cal_2d(1:pcols,1:nht_cosp) = R_UNDEF
1632 : cfad_dbze94_cs(1:pcols,1:nht_cosp*CLOUDSAT_DBZE_BINS) = R_UNDEF
1633 : cfad_sr532_cal(1:pcols,1:nht_cosp*nsr_cosp) = R_UNDEF
1634 : tau_isccp(1:pcols,1:nscol_cosp) = R_UNDEF
1635 : cldptop_isccp(1:pcols,1:nscol_cosp) = R_UNDEF
1636 : meantau_isccp(1:pcols) = R_UNDEF
1637 : meantb_isccp(1:pcols) = R_UNDEF
1638 : meantbclr_isccp(1:pcols) = R_UNDEF
1639 : dbze_cs(1:pcols,1:nhtml_cosp*nscol_cosp) = R_UNDEF
1640 : ptcloudsatflag0(1:pcols) = R_UNDEF
1641 : ptcloudsatflag1(1:pcols) = R_UNDEF
1642 : ptcloudsatflag2(1:pcols) = R_UNDEF
1643 : ptcloudsatflag3(1:pcols) = R_UNDEF
1644 : ptcloudsatflag4(1:pcols) = R_UNDEF
1645 : ptcloudsatflag5(1:pcols) = R_UNDEF
1646 : ptcloudsatflag6(1:pcols) = R_UNDEF
1647 : ptcloudsatflag7(1:pcols) = R_UNDEF
1648 : ptcloudsatflag8(1:pcols) = R_UNDEF
1649 : ptcloudsatflag9(1:pcols) = R_UNDEF
1650 : cloudsatpia(1:pcols) = R_UNDEF
1651 : cldtot_calcs(1:pcols) = R_UNDEF
1652 : cldtot_cs(1:pcols) = R_UNDEF
1653 : cldtot_cs2(1:pcols) = R_UNDEF
1654 : cld_cal_notcs(1:pcols,1:nht_cosp) = R_UNDEF
1655 : atb532_cal(1:pcols,1:nhtml_cosp*nscol_cosp) = R_UNDEF
1656 : mol532_cal(1:pcols,1:nhtml_cosp) = R_UNDEF
1657 : cld_misr(1:pcols,1:nhtmisr_cosp*ntau_cosp) = R_UNDEF
1658 : refl_parasol(1:pcols,1:nsza_cosp) = R_UNDEF
1659 : scops_out(1:pcols,1:nhtml_cosp*nscol_cosp) = R_UNDEF
1660 : cltmodis(1:pcols) = R_UNDEF
1661 : clwmodis(1:pcols) = R_UNDEF
1662 : climodis(1:pcols) = R_UNDEF
1663 : clhmodis(1:pcols) = R_UNDEF
1664 : clmmodis(1:pcols) = R_UNDEF
1665 : cllmodis(1:pcols) = R_UNDEF
1666 : tautmodis(1:pcols) = R_UNDEF
1667 : tauwmodis(1:pcols) = R_UNDEF
1668 : tauimodis(1:pcols) = R_UNDEF
1669 : tautlogmodis(1:pcols) = R_UNDEF
1670 : tauwlogmodis(1:pcols) = R_UNDEF
1671 : tauilogmodis(1:pcols) = R_UNDEF
1672 : reffclwmodis(1:pcols) = R_UNDEF
1673 : reffclimodis(1:pcols) = R_UNDEF
1674 : pctmodis(1:pcols) = R_UNDEF
1675 : lwpmodis(1:pcols) = R_UNDEF
1676 : iwpmodis(1:pcols) = R_UNDEF
1677 : clmodis_cam(1:pcols,1:ntau_cosp_modis*nprs_cosp) = R_UNDEF
1678 : clmodis(1:pcols,1:ntau_cosp_modis,1:nprs_cosp) = R_UNDEF
1679 : clrimodis_cam(1:pcols,1:ntau_cosp_modis*numMODISReffIceBins) = R_UNDEF ! +cosp2
1680 : clrimodis(1:pcols,1:ntau_cosp_modis,1:numMODISReffIceBins) = R_UNDEF ! +cosp2
1681 : clrlmodis_cam(1:pcols,1:ntau_cosp_modis*numMODISReffLiqBins) = R_UNDEF ! +cosp2
1682 : clrlmodis(1:pcols,1:ntau_cosp_modis,1:numMODISReffLiqBins) = R_UNDEF ! +cosp2
1683 : tau067_out(1:pcols,1:nhtml_cosp*nscol_cosp) = R_UNDEF ! +cosp2
1684 : emis11_out(1:pcols,1:nhtml_cosp*nscol_cosp) = R_UNDEF ! +cosp2
1685 : asym34_out(1:pcols,1:nhtml_cosp*nscol_cosp) = R_UNDEF ! +cosp2
1686 : ssa34_out(1:pcols,1:nhtml_cosp*nscol_cosp) = R_UNDEF ! +cosp2
1687 : fracLiq_out(1:pcols,1:nhtml_cosp*nscol_cosp) = R_UNDEF ! +cosp2
1688 :
1689 : ! ######################################################################################
1690 : ! DECIDE WHICH COLUMNS YOU ARE GOING TO RUN COSP ON....
1691 : ! ######################################################################################
1692 :
1693 : !! run_cosp is set for each column in each chunk in the first timestep of the run
1694 : !! hist_fld_col_active in cam_history.F90 is used to decide if you need to run cosp.
1695 : if (first_run_cosp(lchnk)) then
1696 : !! initalize to run logicals as false
1697 : run_cosp(1:ncol,lchnk)=.false.
1698 : run_radar(1:nf_radar,1:ncol)=.false.
1699 : run_calipso(1:nf_calipso,1:ncol)=.false.
1700 : run_isccp(1:nf_isccp,1:ncol)=.false.
1701 : run_misr(1:nf_misr,1:ncol)=.false.
1702 : run_modis(1:nf_modis,1:ncol)=.false.
1703 :
1704 : if (lradar_sim) then
1705 : do i=1,nf_radar
1706 : run_radar(i,1:pcols)=hist_fld_col_active(fname_radar(i),lchnk,pcols)
1707 : end do
1708 : end if
1709 : if (llidar_sim) then
1710 : do i=1,nf_calipso
1711 : run_calipso(i,1:pcols)=hist_fld_col_active(fname_calipso(i),lchnk,pcols)
1712 : end do
1713 : end if
1714 : if (lisccp_sim) then
1715 : do i=1,nf_isccp
1716 : run_isccp(i,1:pcols)=hist_fld_col_active(fname_isccp(i),lchnk,pcols)
1717 : end do
1718 : end if
1719 : if (lmisr_sim) then
1720 : do i=1,nf_misr
1721 : run_misr(i,1:pcols)=hist_fld_col_active(fname_misr(i),lchnk,pcols)
1722 : end do
1723 : end if
1724 : if (lmodis_sim) then
1725 : do i=1,nf_modis
1726 : run_modis(i,1:pcols)=hist_fld_col_active(fname_modis(i),lchnk,pcols)
1727 : end do
1728 : end if
1729 :
1730 : do i=1,ncol
1731 : if ((any(run_radar(:,i))) .or. (any(run_calipso(:,i))) .or. (any(run_isccp(:,i))) &
1732 : .or. (any(run_misr(:,i))) .or. (any(run_modis(:,i)))) then
1733 : run_cosp(i,lchnk)=.true.
1734 : end if
1735 : end do
1736 :
1737 : first_run_cosp(lchnk)=.false.
1738 : endif
1739 :
1740 : ! ######################################################################################
1741 : ! GET CAM GEOPHYSICAL VARIABLES NEEDED FOR COSP INPUT
1742 : ! ######################################################################################
1743 : ! 1) state variables (prognostic variables, see physics_types.F90)
1744 : ! state vars are passed to this subroutine from radiation.F90.
1745 : ! I do not need to define these variables. I can use them as is, e.g., state%t
1746 : !state%lat ! lat (radians)
1747 : !state%lon ! lon (radians)
1748 : !state%t ! temperature (K)
1749 : !state%u ! u_wind zonal wind (m/s)
1750 : !state%v ! v_wind meridional wind (m/s)
1751 : !state%ps ! surface pressure (Pa)
1752 : !state%pint ! p - p_in_full_levels (Pa)
1753 : !state%pmid ! ph - p_in_half_levels (Pa)
1754 : !state%zm ! geopotential height above surface at midpoints (m), pver
1755 : !state%zi ! geopotential height above surface at interfaces (m), pverp
1756 : !state%phis ! surface geopotential (m2/s2)
1757 : ! NOTE: The state variables state%q(:,:,ixcldliq)/state%q(:,:,ixcldice) are grid-box
1758 : ! quantities for the stratiform clouds only. stratiform water * stratiform cloud fraction
1759 : !state%q(:,:,ixcldliq) !for CAM4: cldliq= stratiform incld water content * total cloud fraction
1760 : !state%q(:,:,ixcldice) !for CAM4: cldice = stratiform incld ice content * total cloud fraction
1761 :
1762 : ! need query index for cldliq and cldice
1763 : ! use cnst_get_ind subroutine in constituents.F90.
1764 : ! can also get MG microphysics number from state using similar procedure.
1765 : call cnst_get_ind('CLDLIQ',ixcldliq) !! replaced cnst_names(1) not setting abort flag which is optional in cnst_get_ind
1766 : call cnst_get_ind(cnst_names(2),ixcldice)
1767 :
1768 : Npoints = ncol ! default is running all columns in the chunk, not pcols = maximum number
1769 : Nlevels = pver
1770 :
1771 : ! 2) cam_in variables (see camsrfexch.F90)
1772 : ! I can reference these as is, e.g., cam_in%ts.
1773 : !cam_in%ts ! skt - Skin temperature (K)
1774 : !cam_in%landfrac ! land fraction, used to define a landmask (0 or 1) for COSP input
1775 :
1776 : ! 3) radiative constituent interface variables:
1777 : ! specific humidity (q), 03, CH4,C02, N20 mass mixing ratio
1778 : ! Note: these all have dims (pcol,pver) but the values don't change much for the well-mixed gases.
1779 : call rad_cnst_get_gas(0,'H2O', state, pbuf, q)
1780 : call rad_cnst_get_gas(0,'O3', state, pbuf, o3)
1781 : call rad_cnst_get_gas(0,'CH4', state, pbuf, ch4)
1782 : call rad_cnst_get_gas(0,'CO2', state, pbuf, co2)
1783 : call rad_cnst_get_gas(0,'N2O', state, pbuf, n2o)
1784 :
1785 : ! 4) get variables from physics buffer
1786 : itim_old = pbuf_old_tim_idx()
1787 : call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
1788 : call pbuf_get_field(pbuf, concld_idx, concld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
1789 : call pbuf_get_field(pbuf, rel_idx, rel )
1790 : call pbuf_get_field(pbuf, rei_idx, rei)
1791 :
1792 : !added some more sizes to physics buffer in stratiform.F90 for COSP inputs
1793 : call pbuf_get_field(pbuf, lsreffrain_idx, ls_reffrain )
1794 : call pbuf_get_field(pbuf, lsreffsnow_idx, ls_reffsnow )
1795 : call pbuf_get_field(pbuf, cvreffliq_idx, cv_reffliq )
1796 : call pbuf_get_field(pbuf, cvreffice_idx, cv_reffice )
1797 :
1798 : ! Variables I added to physics buffer in other interfaces (not radiation.F90)
1799 : ! all "1" at the end ok as is because radiation/intr after when these were added to physics buffer
1800 :
1801 : !! convective cloud mixing ratios (use for cam4 and cam5)
1802 : call pbuf_get_field(pbuf, dpcldliq_idx, dp_cldliq )
1803 : call pbuf_get_field(pbuf, dpcldice_idx, dp_cldice )
1804 : !! get from pbuf in stratiform.F90
1805 : call pbuf_get_field(pbuf, shcldliq1_idx, sh_cldliq )
1806 : call pbuf_get_field(pbuf, shcldice1_idx, sh_cldice )
1807 :
1808 : !! precipitation fluxes (use for both cam4 and cam5 for now....)
1809 : call pbuf_get_field(pbuf, dpflxprc_idx, dp_flxprc )
1810 : call pbuf_get_field(pbuf, dpflxsnw_idx, dp_flxsnw )
1811 : if (shflxprc_idx > 0) then
1812 : call pbuf_get_field(pbuf, shflxprc_idx, sh_flxprc )
1813 : else
1814 : sh_flxprc => zero_ifc
1815 : end if
1816 : if (shflxsnw_idx > 0) then
1817 : call pbuf_get_field(pbuf, shflxsnw_idx, sh_flxsnw )
1818 : else
1819 : sh_flxsnw => zero_ifc
1820 : end if
1821 : call pbuf_get_field(pbuf, lsflxprc_idx, ls_flxprc )
1822 : call pbuf_get_field(pbuf, lsflxsnw_idx, ls_flxsnw )
1823 :
1824 : !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1825 : ! CALCULATE COSP INPUT VARIABLES FROM CAM VARIABLES, done for all columns within chunk
1826 : !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1827 :
1828 : ! 0) Create ptop/ztop for gbx%pf and gbx%zlev are for the the interface,
1829 : ! also reverse CAM height/pressure values for input into CSOP
1830 : ! CAM state%pint from top to surface, COSP wants surface to top.
1831 :
1832 : ! Initalize
1833 : ptop(1:ncol,1:pver)=0._r8
1834 : pbot(1:ncol,1:pver)=0._r8
1835 : ztop(1:ncol,1:pver)=0._r8
1836 : zbot(1:ncol,1:pver)=0._r8
1837 : zmid(1:ncol,1:pver)=0._r8
1838 :
1839 : ! assign values from top
1840 : do k=1,pverp-1
1841 : ! assign values from top
1842 : ptop(1:ncol,k)=state%pint(1:ncol,pverp-k)
1843 : ztop(1:ncol,k)=state%zi(1:ncol,pverp-k)
1844 : ! assign values from bottom
1845 : pbot(1:ncol,k)=state%pint(1:ncol,pverp-k+1)
1846 : zbot(1:ncol,k)=state%zi(1:ncol,pverp-k+1)
1847 : end do
1848 :
1849 : ! add surface height (surface geopotential/gravity) to convert CAM heights based on geopotential above surface into height above sea level
1850 : do k=1,pver
1851 : do i=1,ncol
1852 : ztop(i,k)=ztop(i,k)+state%phis(i)/gravit
1853 : zbot(i,k)=zbot(i,k)+state%phis(i)/gravit
1854 : zmid(i,k)=state%zm(i,k)+state%phis(i)/gravit
1855 : end do
1856 : end do
1857 :
1858 : ! 1) lat/lon - convert from radians to cosp input type
1859 : ! Initalize
1860 : lat_cosp(1:ncol)=0._r8
1861 : lon_cosp(1:ncol)=0._r8
1862 : ! convert from radians to degrees_north and degrees_east
1863 : lat_cosp=state%lat*180._r8/(pi) ! needs to go from -90 to +90 degrees north
1864 : lon_cosp=state%lon*180._r8/(pi) ! needs to go from 0 to 360 degrees east
1865 :
1866 : ! 2) rh - relative_humidity_liquid_water (%)
1867 : ! calculate from CAM q and t using CAM built-in functions
1868 : do k = 1, pver
1869 : call qsat_water(state%t(1:ncol,k), state%pmid(1:ncol,k), es(1:ncol,k), qs(1:ncol,k), ncol)
1870 : end do
1871 : ! initialize rh
1872 : rh(1:ncol,1:pver)=0._r8
1873 :
1874 : ! calculate rh
1875 : do k=1,pver
1876 : do i=1,ncol
1877 : rh(i,k)=(q(i,k)/qs(i,k))*100
1878 : end do
1879 : end do
1880 :
1881 : ! 3) landmask - calculate from cam_in%landfrac
1882 : ! initalize landmask
1883 : landmask(1:ncol)=0._r8
1884 : ! calculate landmask
1885 : do i=1,ncol
1886 : if (cam_in%landfrac(i).gt.0.01_r8) landmask(i)= 1
1887 : end do
1888 :
1889 : ! 4) calculate necessary input cloud/precip variables
1890 : ! CAM4 note: don't take the cloud water from the hack shallow convection scheme or the deep convection.
1891 : ! cloud water values for convection are the same as the stratiform value. (Sungsu)
1892 : ! all precip fluxes are mid points, all values are grid-box mean ("gbm") (Yuying)
1893 :
1894 : ! initialize local variables
1895 : mr_ccliq(1:ncol,1:pver) = 0._r8
1896 : mr_ccice(1:ncol,1:pver) = 0._r8
1897 : mr_lsliq(1:ncol,1:pver) = 0._r8
1898 : mr_lsice(1:ncol,1:pver) = 0._r8
1899 : grpl_ls_interp(1:ncol,1:pver) = 0._r8
1900 : rain_ls_interp(1:ncol,1:pver) = 0._r8
1901 : snow_ls_interp(1:ncol,1:pver) = 0._r8
1902 : rain_cv(1:ncol,1:pverp) = 0._r8
1903 : snow_cv(1:ncol,1:pverp) = 0._r8
1904 : rain_cv_interp(1:ncol,1:pver) = 0._r8
1905 : snow_cv_interp(1:ncol,1:pver) = 0._r8
1906 : reff_cosp(1:ncol,1:pver,1:nhydro) = 0._r8
1907 : ! note: reff_cosp dimensions should be same as cosp (reff_cosp has 9 hydrometeor dimension)
1908 : ! Reff(Npoints,Nlevels,N_HYDRO)
1909 :
1910 : use_precipitation_fluxes = .true. !!! consistent with cam4 implementation.
1911 :
1912 : ! add together deep and shallow convection precipitation fluxes, recall *_flxprc variables are rain+snow
1913 : rain_cv(1:ncol,1:pverp) = (sh_flxprc(1:ncol,1:pverp)-sh_flxsnw(1:ncol,1:pverp)) + &
1914 : (dp_flxprc(1:ncol,1:pverp)-dp_flxsnw(1:ncol,1:pverp))
1915 : snow_cv(1:ncol,1:pverp) = sh_flxsnw(1:ncol,1:pverp) + dp_flxsnw(1:ncol,1:pverp)
1916 :
1917 : ! interpolate interface precip fluxes to mid points
1918 : do i=1,ncol
1919 : ! find weights (pressure weighting?)
1920 : call lininterp_init(state%zi(i,1:pverp),pverp,state%zm(i,1:pver),pver,extrap_method,interp_wgts)
1921 : ! interpolate lininterp1d(arrin, nin, arrout, nout, interp_wgts)
1922 : ! note: lininterp is an interface, contains lininterp1d -- code figures out to use lininterp1d.
1923 : call lininterp(rain_cv(i,1:pverp),pverp,rain_cv_interp(i,1:pver),pver,interp_wgts)
1924 : call lininterp(snow_cv(i,1:pverp),pverp,snow_cv_interp(i,1:pver),pver,interp_wgts)
1925 : call lininterp(ls_flxprc(i,1:pverp),pverp,rain_ls_interp(i,1:pver),pver,interp_wgts)
1926 : call lininterp(ls_flxsnw(i,1:pverp),pverp,snow_ls_interp(i,1:pver),pver,interp_wgts)
1927 : call lininterp_finish(interp_wgts)
1928 : !! ls_flxprc is for rain+snow, find rain_ls_interp by subtracting off snow_ls_interp
1929 : rain_ls_interp(i,1:pver)=rain_ls_interp(i,1:pver)-snow_ls_interp(i,1:pver)
1930 : end do
1931 :
1932 : !! CAM5 cloud mixing ratio calculations
1933 : !! Note: Although CAM5 has non-zero convective cloud mixing ratios that affect the model state,
1934 : !! Convective cloud water is NOT part of radiation calculations.
1935 : do k=1,pver
1936 : do i=1,ncol
1937 : if (cld(i,k) .gt. 0._r8) then
1938 : !! note: convective mixing ratio is the sum of shallow and deep convective clouds in CAM5
1939 : mr_ccliq(i,k) = sh_cldliq(i,k) + dp_cldliq(i,k)
1940 : mr_ccice(i,k) = sh_cldice(i,k) + dp_cldice(i,k)
1941 : mr_lsliq(i,k)=state%q(i,k,ixcldliq) ! mr_lsliq, mixing_ratio_large_scale_cloud_liquid, state only includes stratiform (kg/kg)
1942 : mr_lsice(i,k)=state%q(i,k,ixcldice) ! mr_lsice - mixing_ratio_large_scale_cloud_ice, state only includes stratiform (kg/kg)
1943 : else
1944 : mr_ccliq(i,k) = 0._r8
1945 : mr_ccice(i,k) = 0._r8
1946 : mr_lsliq(i,k) = 0._r8
1947 : mr_lsice(i,k) = 0._r8
1948 : end if
1949 : end do
1950 : end do
1951 :
1952 : !! Previously, I had set use_reff=.false.
1953 : !! use_reff = .false. !! if you use this,all sizes use DEFAULT_LIDAR_REFF = 30.0e-6 meters
1954 :
1955 : !! The specification of reff_cosp now follows e-mail discussion with Yuying in January 2011. (see above)
1956 : !! All of the values that I have assembled in the code are in microns... convert to meters here since that is what COSP wants.
1957 : use_reff = .true.
1958 : reff_cosp(1:ncol,1:pver,1) = rel(1:ncol,1:pver)*1.e-6_r8 !! LSCLIQ (same as effc and effliq in stratiform.F90)
1959 : reff_cosp(1:ncol,1:pver,2) = rei(1:ncol,1:pver)*1.e-6_r8 !! LSCICE (same as effi and effice in stratiform.F90)
1960 : reff_cosp(1:ncol,1:pver,3) = ls_reffrain(1:ncol,1:pver)*1.e-6_r8 !! LSRAIN (calculated in cldwat2m_micro.F90, passed to stratiform.F90)
1961 : reff_cosp(1:ncol,1:pver,4) = ls_reffsnow(1:ncol,1:pver)*1.e-6_r8 !! LSSNOW (calculated in cldwat2m_micro.F90, passed to stratiform.F90)
1962 : reff_cosp(1:ncol,1:pver,5) = cv_reffliq(1:ncol,1:pver)*1.e-6_r8 !! CVCLIQ (calculated in stratiform.F90, not actually used in radiation)
1963 : reff_cosp(1:ncol,1:pver,6) = cv_reffice(1:ncol,1:pver)*1.e-6_r8 !! CVCICE (calculated in stratiform.F90, not actually used in radiation)
1964 : reff_cosp(1:ncol,1:pver,7) = ls_reffrain(1:ncol,1:pver)*1.e-6_r8 !! CVRAIN (same as stratiform per Andrew)
1965 : reff_cosp(1:ncol,1:pver,8) = ls_reffsnow(1:ncol,1:pver)*1.e-6_r8 !! CVSNOW (same as stratiform per Andrew)
1966 : reff_cosp(1:ncol,1:pver,9) = 0._r8 !! LSGRPL (using radar default reff)
1967 :
1968 : !! Need code below for when effective radius is fillvalue, and you multiply it by 1.e-6 to convert units, and value becomes no longer fillvalue.
1969 : !! Here, we set it back to zero.
1970 : where (rel(1:ncol,1:pver) .eq. R_UNDEF)
1971 : reff_cosp(1:ncol,1:pver,1) = 0._r8
1972 : end where
1973 : where (rei(1:ncol,1:pver) .eq. R_UNDEF)
1974 : reff_cosp(1:ncol,1:pver,2) = 0._r8
1975 : end where
1976 : where (ls_reffrain(1:ncol,1:pver) .eq. R_UNDEF)
1977 : reff_cosp(1:ncol,1:pver,3) = 0._r8
1978 : end where
1979 : where (ls_reffsnow(1:ncol,1:pver) .eq. R_UNDEF)
1980 : reff_cosp(1:ncol,1:pver,4) = 0._r8
1981 : end where
1982 : where (cv_reffliq(1:ncol,1:pver) .eq. R_UNDEF)
1983 : reff_cosp(1:ncol,1:pver,5) = 0._r8
1984 : end where
1985 : where (cv_reffice(1:ncol,1:pver) .eq. R_UNDEF)
1986 : reff_cosp(1:ncol,1:pver,6) = 0._r8
1987 : end where
1988 : where (ls_reffrain(1:ncol,1:pver) .eq. R_UNDEF)
1989 : reff_cosp(1:ncol,1:pver,7) = 0._r8
1990 : end where
1991 : where (ls_reffsnow(1:ncol,1:pver) .eq. R_UNDEF)
1992 : reff_cosp(1:ncol,1:pver,8) = 0._r8
1993 : end where
1994 :
1995 : !! Make sure interpolated values are not less than 0 - COSP was complaining and resetting small negative values to zero.
1996 : !! ----- WARNING: COSP_CHECK_INPUT_2D: minimum value of rain_ls set to: 0.000000000000000
1997 : !! So I set negative values to zero here...
1998 : do k=1,pver
1999 : do i=1,ncol
2000 : if (rain_ls_interp(i,k) .lt. 0._r8) then
2001 : rain_ls_interp(i,k)=0._r8
2002 : end if
2003 : if (snow_ls_interp(i,k) .lt. 0._r8) then
2004 : snow_ls_interp(i,k)=0._r8
2005 : end if
2006 : if (rain_cv_interp(i,k) .lt. 0._r8) then
2007 : rain_cv_interp(i,k)=0._r8
2008 : end if
2009 : if (snow_cv_interp(i,k) .lt. 0._r8) then
2010 : snow_cv_interp(i,k)=0._r8
2011 : end if
2012 : end do
2013 : end do
2014 :
2015 : ! 5) assign optical depths and emissivities needed for isccp simulator
2016 : cld_swtau(1:ncol,1:pver) = cld_swtau_in(1:ncol,1:pver)
2017 :
2018 : ! initialize cosp inputs
2019 : dtau_s(1:ncol,1:pver) = 0._r8
2020 : dtau_c(1:ncol,1:pver) = 0._r8
2021 : dtau_s_snow(1:ncol,1:pver) = 0._r8
2022 : dem_s(1:ncol,1:pver) = 0._r8
2023 : dem_c(1:ncol,1:pver) = 0._r8
2024 : dem_s_snow(1:ncol,1:pver) = 0._r8
2025 :
2026 : ! assign values
2027 : ! NOTES:
2028 : ! 1) CAM4 assumes same radiative properties for stratiform and convective clouds,
2029 : ! (see ISCCP_CLOUD_TYPES subroutine call in cloudsimulator.F90)
2030 : ! I presume CAM5 is doing the same thing based on the ISCCP simulator calls within RRTM's radiation.F90
2031 : ! 2) COSP wants in-cloud values. CAM5 values cld_swtau are in-cloud.
2032 : ! 3) snow_tau_in and snow_emis_in are passed without modification to COSP
2033 : dtau_s(1:ncol,1:pver) = cld_swtau(1:ncol,1:pver) ! mean 0.67 micron optical depth of stratiform (in-cloud)
2034 : dtau_c(1:ncol,1:pver) = cld_swtau(1:ncol,1:pver) ! mean 0.67 micron optical depth of convective (in-cloud)
2035 : dem_s(1:ncol,1:pver) = emis(1:ncol,1:pver) ! 10.5 micron longwave emissivity of stratiform (in-cloud)
2036 : dem_c(1:ncol,1:pver) = emis(1:ncol,1:pver) ! 10.5 micron longwave emissivity of convective (in-cloud)
2037 : dem_s_snow(1:ncol,1:pver) = snow_emis_in(1:ncol,1:pver) ! 10.5 micron grid-box mean optical depth of stratiform snow
2038 : dtau_s_snow(1:ncol,1:pver) = snow_tau_in(1:ncol,1:pver) ! 0.67 micron grid-box mean optical depth of stratiform snow
2039 :
2040 : ! ######################################################################################
2041 : ! Compute sunlit flag. If cosp_runall=.true., then run on all points.
2042 : ! ######################################################################################
2043 : cam_sunlit(:) = 0
2044 : if (cosp_runall) then
2045 : cam_sunlit(:) = 1
2046 : nSunLit = ncol
2047 : nNoSunLit = 0
2048 : else
2049 : nSunLit = 0
2050 : nNoSunLit = 0
2051 : do i=1,ncol
2052 : if ((coszrs(i) > 0.0_r8) .and. (run_cosp(i,lchnk))) then
2053 : cam_sunlit(i) = 1
2054 : nSunLit = nSunLit+1
2055 : else
2056 : nNoSunLit = nNoSunlit+1
2057 : endif
2058 : enddo
2059 : endif
2060 : call t_stopf("init_and_stuff")
2061 :
2062 : ! ######################################################################################
2063 : ! ######################################################################################
2064 : ! END TRANSLATE CAM VARIABLES TO COSP INPUT VARIABLES
2065 : ! ######################################################################################
2066 : ! ######################################################################################
2067 :
2068 : ! ######################################################################################
2069 : ! Construct COSP output derived type.
2070 : ! ######################################################################################
2071 : call t_startf("construct_cosp_outputs")
2072 : call construct_cosp_outputs(ncol,nscol_cosp,pver,Nlvgrid,0,cospOUT)
2073 : call t_stopf("construct_cosp_outputs")
2074 :
2075 : ! ######################################################################################
2076 : ! Construct and populate COSP input types
2077 : ! ######################################################################################
2078 : ! Model state
2079 : call t_startf("construct_cospstateIN")
2080 : call construct_cospstateIN(ncol,pver,0,cospstateIN)
2081 : cospstateIN%lat = lat_cosp(1:ncol)
2082 : cospstateIN%lon = lon_cosp(1:ncol)
2083 : cospstateIN%at = state%t(1:ncol,1:pver)
2084 : cospstateIN%qv = q(1:ncol,1:pver)
2085 : cospstateIN%o3 = o3(1:ncol,1:pver)
2086 : cospstateIN%sunlit = cam_sunlit(1:ncol)
2087 : cospstateIN%skt = cam_in%ts(1:ncol)
2088 : cospstateIN%land = landmask(1:ncol)
2089 : cospstateIN%pfull = state%pmid(1:ncol,1:pver)
2090 : cospstateIN%phalf(1:ncol,1) = 0._r8
2091 : cospstateIN%phalf(1:ncol,2:pver+1) = pbot(1:ncol,pver:1:-1)
2092 : cospstateIN%hgt_matrix = zmid(1:ncol,1:pver)
2093 : cospstateIN%hgt_matrix_half(1:ncol,pver+1) = 0._r8
2094 : cospstateIN%hgt_matrix_half(1:ncol,1:pver) = zbot(1:ncol,pver:1:-1)
2095 : cospstateIN%surfelev(1:ncol) = zbot(1:ncol,1)
2096 : call t_stopf("construct_cospstateIN")
2097 :
2098 : ! Optical inputs
2099 : call t_startf("construct_cospIN")
2100 : call construct_cospIN(ncol,nscol_cosp,pver,cospIN)
2101 : cospIN%emsfc_lw = emsfc_lw
2102 : if (lradar_sim) cospIN%rcfg_cloudsat = rcfg_cs(lchnk)
2103 : call t_stopf("construct_cospIN")
2104 :
2105 : ! *NOTE* Fields passed into subsample_and_optics are ordered from TOA-2-SFC.
2106 : call t_startf("subsample_and_optics")
2107 : call subsample_and_optics(ncol,pver,nscol_cosp,nhydro,overlap, &
2108 : use_precipitation_fluxes,lidar_ice_type,sd_cs(lchnk),cld(1:ncol,1:pver),&
2109 : concld(1:ncol,1:pver),rain_ls_interp(1:ncol,1:pver), &
2110 : snow_ls_interp(1:ncol,1:pver),grpl_ls_interp(1:ncol,1:pver), &
2111 : rain_cv_interp(1:ncol,1:pver),snow_cv_interp(1:ncol,1:pver), &
2112 : mr_lsliq(1:ncol,1:pver),mr_lsice(1:ncol,1:pver), &
2113 : mr_ccliq(1:ncol,1:pver),mr_ccice(1:ncol,1:pver), &
2114 : reff_cosp(1:ncol,1:pver,:),dtau_c(1:ncol,1:pver), &
2115 : dtau_s(1:ncol,1:pver),dem_c(1:ncol,1:pver), &
2116 : dem_s(1:ncol,1:pver),dtau_s_snow(1:ncol,1:pver), &
2117 : dem_s_snow(1:ncol,1:pver),state%ps(1:ncol),cospstateIN,cospIN)
2118 : call t_stopf("subsample_and_optics")
2119 :
2120 : ! ######################################################################################
2121 : ! Call COSP
2122 : ! ######################################################################################
2123 : call t_startf("cosp_simulator")
2124 : cosp_status = COSP_SIMULATOR(cospIN, cospstateIN, cospOUT, start_idx=1, stop_idx=ncol,debug=.false.)
2125 :
2126 : ! Check status flags
2127 : nerror = 0
2128 : do i = 1, ubound(cosp_status, 1)
2129 : if (len_trim(cosp_status(i)) > 0) then
2130 : write(iulog,*) "cosp_simulator: ERROR: "//trim(cosp_status(i))
2131 : nerror = nerror + 1
2132 : end if
2133 : end do
2134 : if (nerror > 0) then
2135 : call endrun('cospsimulator_intr_run: error return from cosp_simulator')
2136 : end if
2137 : call t_stopf("cosp_simulator")
2138 :
2139 : ! ######################################################################################
2140 : ! Write COSP inputs to output file for offline use.
2141 : ! ######################################################################################
2142 : call t_startf("cosp_histfile_aux")
2143 : if (cosp_histfile_aux) then
2144 : ! 1D outputs
2145 : call outfld('PS_COSP', state%ps(1:ncol), ncol,lchnk)
2146 : call outfld('TS_COSP', cospstateIN%skt, ncol,lchnk)
2147 :
2148 : ! 2D outputs
2149 : call outfld('P_COSP', cospstateIN%pfull, ncol,lchnk)
2150 : call outfld('PH_COSP', cospstateIN%phalf, ncol,lchnk)
2151 : call outfld('ZLEV_COSP', cospstateIN%hgt_matrix, ncol,lchnk)
2152 : call outfld('ZLEV_HALF_COSP', cospstateIN%hgt_matrix_half, ncol,lchnk)
2153 : call outfld('T_COSP', cospstateIN%at, ncol,lchnk)
2154 : call outfld('RH_COSP', cospstateIN%qv, ncol,lchnk)
2155 : call outfld('Q_COSP', q(1:ncol,1:pver), ncol,lchnk)
2156 :
2157 : ! 3D outputs, but first compress to 2D
2158 : do i=1,ncol
2159 : do ihml=1,nhtml_cosp
2160 : do isc=1,nscol_cosp
2161 : ihsc = (ihml-1)*nscol_cosp+isc
2162 : tau067_out(i,ihsc) = cospIN%tau_067(i,isc,ihml)
2163 : emis11_out(i,ihsc) = cospIN%emiss_11(i,isc,ihml)
2164 : ssa34_out(i,ihsc) = cospIN%ss_alb(i,isc,ihml)
2165 : asym34_out(i,ihsc) = cospIN%asym(i,isc,ihml)
2166 : fracLiq_out(i,ihsc) = cospIN%fracLiq(i,isc,ihml)
2167 : end do
2168 : end do
2169 : end do
2170 : call outfld('TAU_067', tau067_out, pcols,lchnk)
2171 : call outfld('EMISS_11', emis11_out, pcols,lchnk)
2172 : call outfld('MODIS_asym', asym34_out, pcols,lchnk)
2173 : call outfld('MODIS_ssa', ssa34_out, pcols,lchnk)
2174 : call outfld('MODIS_fracliq',fracLiq_out,pcols,lchnk)
2175 : end if
2176 : call t_stopf("cosp_histfile_aux")
2177 :
2178 : ! ######################################################################################
2179 : ! Set dark-scenes to fill value. Only done for passive simulators and when cosp_runall=F
2180 : ! ######################################################################################
2181 : call t_startf("sunlit_passive")
2182 : if (.not. cosp_runall) then
2183 : ! ISCCP simulator
2184 : if (lisccp_sim) then
2185 : ! 1D
2186 : where(cam_sunlit(1:ncol) .eq. 0)
2187 : cospOUT%isccp_totalcldarea(1:ncol) = R_UNDEF
2188 : cospOUT%isccp_meanptop(1:ncol) = R_UNDEF
2189 : cospOUT%isccp_meantaucld(1:ncol) = R_UNDEF
2190 : cospOUT%isccp_meanalbedocld(1:ncol) = R_UNDEF
2191 : cospOUT%isccp_meantb(1:ncol) = R_UNDEF
2192 : cospOUT%isccp_meantbclr(1:ncol) = R_UNDEF
2193 : end where
2194 : ! 2D
2195 : do i=1,nscol_cosp
2196 : where (cam_sunlit(1:ncol) .eq. 0)
2197 : cospOUT%isccp_boxtau(1:ncol,i) = R_UNDEF
2198 : cospOUT%isccp_boxptop(1:ncol,i) = R_UNDEF
2199 : end where
2200 : enddo
2201 : ! 3D
2202 : do i=1,nprs_cosp
2203 : do k=1,ntau_cosp
2204 : where(cam_sunlit(1:ncol) .eq. 0)
2205 : cospOUT%isccp_fq(1:ncol,k,i) = R_UNDEF
2206 : end where
2207 : end do
2208 : end do
2209 : endif
2210 :
2211 : ! MISR simulator
2212 : if (lmisr_sim) then
2213 : do i=1,nhtmisr_cosp
2214 : do k=1,ntau_cosp
2215 : where(cam_sunlit(1:ncol) .eq. 0)
2216 : cospOUT%misr_fq(1:ncol,k,i) = R_UNDEF
2217 : end where
2218 : end do
2219 : end do
2220 : end if
2221 :
2222 : ! MODIS simulator
2223 : if (lmodis_sim) then
2224 : ! 1D
2225 : where(cam_sunlit(1:ncol) .eq. 0)
2226 : cospOUT%modis_Cloud_Fraction_Total_Mean(1:ncol) = R_UNDEF
2227 : cospOUT%modis_Cloud_Fraction_Water_Mean(1:ncol) = R_UNDEF
2228 : cospOUT%modis_Cloud_Fraction_Ice_Mean(1:ncol) = R_UNDEF
2229 : cospOUT%modis_Cloud_Fraction_High_Mean(1:ncol) = R_UNDEF
2230 : cospOUT%modis_Cloud_Fraction_Mid_Mean(1:ncol) = R_UNDEF
2231 : cospOUT%modis_Cloud_Fraction_Low_Mean(1:ncol) = R_UNDEF
2232 : cospOUT%modis_Optical_Thickness_Total_Mean(1:ncol) = R_UNDEF
2233 : cospOUT%modis_Optical_Thickness_Water_Mean(1:ncol) = R_UNDEF
2234 : cospOUT%modis_Optical_Thickness_Ice_Mean(1:ncol) = R_UNDEF
2235 : cospOUT%modis_Optical_Thickness_Total_LogMean(1:ncol) = R_UNDEF
2236 : cospOUT%modis_Optical_Thickness_Water_LogMean(1:ncol) = R_UNDEF
2237 : cospOUT%modis_Optical_Thickness_Ice_LogMean(1:ncol) = R_UNDEF
2238 : cospOUT%modis_Cloud_Particle_Size_Water_Mean(1:ncol) = R_UNDEF
2239 : cospOUT%modis_Cloud_Particle_Size_Ice_Mean(1:ncol) = R_UNDEF
2240 : cospOUT%modis_Cloud_Top_Pressure_Total_Mean(1:ncol) = R_UNDEF
2241 : cospOUT%modis_Liquid_Water_Path_Mean(1:ncol) = R_UNDEF
2242 : cospOUT%modis_Ice_Water_Path_Mean(1:ncol) = R_UNDEF
2243 : endwhere
2244 : ! 3D
2245 : do i=1,ntau_cosp_modis
2246 : do k=1,nprs_cosp
2247 : where(cam_sunlit(1:ncol) .eq. 0)
2248 : cospOUT%modis_Optical_Thickness_vs_Cloud_Top_Pressure(1:ncol,i,k) = R_UNDEF
2249 : end where
2250 : enddo
2251 : do k=1,numMODISReffIceBins
2252 : where(cam_sunlit(1:ncol) .eq. 0)
2253 : cospOUT%modis_Optical_Thickness_vs_ReffICE(1:ncol,i,k) = R_UNDEF
2254 : end where
2255 : end do
2256 : do k=1,numMODISReffLiqBins
2257 : where(cam_sunlit(1:ncol) .eq. 0)
2258 : cospOUT%modis_Optical_Thickness_vs_ReffLIQ(1:ncol,i,k) = R_UNDEF
2259 : end where
2260 : enddo
2261 : enddo
2262 : end if
2263 : end if
2264 : call t_stopf("sunlit_passive")
2265 :
2266 : ! ######################################################################################
2267 : ! Copy COSP outputs to CAM fields.
2268 : ! ######################################################################################
2269 : call t_startf("output_copying")
2270 : if (allocated(cospIN%frac_out)) &
2271 : frac_out(1:ncol,1:nscol_cosp,1:nhtml_cosp) = cospIN%frac_out ! frac_out (time,height_mlev,column,profile)
2272 :
2273 : ! Cloudsat
2274 : if (lradar_sim) then
2275 : cfad_dbze94(1:ncol,1:CLOUDSAT_DBZE_BINS,1:nht_cosp) = cospOUT%cloudsat_cfad_ze ! cfad_dbze94 (time,height,dbze,profile)
2276 : dbze94(1:ncol,1:nscol_cosp,1:nhtml_cosp) = cospOUT%cloudsat_Ze_tot ! dbze94 (time,height_mlev,column,profile)
2277 : cldtot_cs(1:ncol) = 0._r8!cospOUT%cloudsat_radar_tcc ! CAM version of cltradar (time,profile) ! NOT COMPUTED IN COSP2
2278 : cldtot_cs2(1:ncol) = 0._r8!cospOUT%cloudsat_radar_tcc2 ! CAM version of cltradar2 (time,profile) ! NOT COMPUTED IN COSP2
2279 : ! *NOTE* These two fields are joint-simulator products, but in CAM they are controlled
2280 : ! by the radar simulator control.
2281 : cldtot_calcs(1:ncol) = cospOUT%radar_lidar_tcc ! CAM version of cltlidarradar (time,profile)
2282 : cld_cal_notcs(1:ncol,1:nht_cosp) = cospOUT%lidar_only_freq_cloud ! CAM version of clcalipso2 (time,height,profile)
2283 :
2284 : ! Cloudsat near-surface precipitation diagnostics
2285 : ptcloudsatflag0(1:ncol) = cospOUT%cloudsat_precip_cover(:,1)
2286 : ptcloudsatflag1(1:ncol) = cospOUT%cloudsat_precip_cover(:,2)
2287 : ptcloudsatflag2(1:ncol) = cospOUT%cloudsat_precip_cover(:,3)
2288 : ptcloudsatflag3(1:ncol) = cospOUT%cloudsat_precip_cover(:,4)
2289 : ptcloudsatflag4(1:ncol) = cospOUT%cloudsat_precip_cover(:,5)
2290 : ptcloudsatflag5(1:ncol) = cospOUT%cloudsat_precip_cover(:,6)
2291 : ptcloudsatflag6(1:ncol) = cospOUT%cloudsat_precip_cover(:,7)
2292 : ptcloudsatflag7(1:ncol) = cospOUT%cloudsat_precip_cover(:,8)
2293 : ptcloudsatflag8(1:ncol) = cospOUT%cloudsat_precip_cover(:,9)
2294 : ptcloudsatflag9(1:ncol) = cospOUT%cloudsat_precip_cover(:,10)
2295 : cloudsatpia(1:ncol) = cospOUT%cloudsat_pia
2296 :
2297 : ! Output the mixing-ratio for all hydrometeor types in Cloudsat near-surface precipitation diagnostics
2298 : ! *NOTE* These fields are simply the native CAM mixing-ratios for each hydrometeor type used in the
2299 : ! CAM6 microphysics scheme, interpolated to the same vertical grid used by the Cloudsat
2300 : ! simulator. These fields are not part of the radar simulator standard output, as these fields
2301 : ! are entirely dependent on the host models microphysics, not the retrieval.
2302 :
2303 :
2304 : endif
2305 :
2306 : ! CALIPSO
2307 : if (llidar_sim) then
2308 : cldlow_cal(1:ncol) = cospOUT%calipso_cldlayer(:,1) ! CAM version of cllcalipso (time,profile)
2309 : cldmed_cal(1:ncol) = cospOUT%calipso_cldlayer(:,2) ! CAM version of clmcalipso (time,profile)
2310 : cldhgh_cal(1:ncol) = cospOUT%calipso_cldlayer(:,3) ! CAM version of clhcalipso (time,profile)
2311 : cldtot_cal(1:ncol) = cospOUT%calipso_cldlayer(:,4) ! CAM version of cltcalipso (time,profile)
2312 : cldlow_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,1,1) ! CAM version of cllcalipsoice !+cosp1.4
2313 : cldmed_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,2,1) ! CAM version of clmcalipsoice
2314 : cldhgh_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,3,1) ! CAM version of clhcalipsoice
2315 : cldtot_cal_ice(1:ncol) = cospOUT%calipso_cldlayerphase(:,4,1) ! CAM version of cltcalipsoice
2316 : cldlow_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,1,2) ! CAM version of cllcalipsoliq
2317 : cldmed_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,2,2) ! CAM version of clmcalipsoliq
2318 : cldhgh_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,3,2) ! CAM version of clhcalipsoliq
2319 : cldtot_cal_liq(1:ncol) = cospOUT%calipso_cldlayerphase(:,4,2) ! CAM version of cltcalipsoliq
2320 : cldlow_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,1,3) ! CAM version of cllcalipsoun
2321 : cldmed_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,2,3) ! CAM version of clmcalipsoun
2322 : cldhgh_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,3,3) ! CAM version of clhcalipsoun
2323 : cldtot_cal_un(1:ncol) = cospOUT%calipso_cldlayerphase(:,4,3) ! CAM version of cltcalipsoun, !+cosp1.4
2324 : cld_cal_ice(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldphase(:,:,1) ! CAM version of clcalipsoice !+cosp1.4
2325 : cld_cal_liq(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldphase(:,:,2) ! CAM version of clcalipsoliq
2326 : cld_cal_un(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldphase(:,:,3) ! CAM version of clcalipsoun
2327 : cld_cal_tmp(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,1) ! CAM version of clcalipsotmp
2328 : cld_cal_tmpliq(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,2) ! CAM version of clcalipsotmpice
2329 : cld_cal_tmpice(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,3) ! CAM version of clcalipsotmpliq
2330 : cld_cal_tmpun(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcldtmp(:,:,4) ! CAM version of clcalipsotmpun, !+cosp1.4
2331 : cld_cal(1:ncol,1:nht_cosp) = cospOUT%calipso_lidarcld(:,1:nht_cosp) ! CAM version of clcalipso (time,height,profile)
2332 : mol532_cal(1:ncol,1:nhtml_cosp) = cospOUT%calipso_beta_mol ! CAM version of beta_mol532 (time,height_mlev,profile)
2333 : atb532(1:ncol,1:nscol_cosp,1:nhtml_cosp) = cospOUT%calipso_beta_tot ! atb532 (time,height_mlev,column,profile)
2334 : cfad_lidarsr532(1:ncol,1:nsr_cosp,1:nht_cosp) = cospOUT%calipso_cfad_sr(:,:,:) ! cfad_lidarsr532 (time,height,scat_ratio,profile)
2335 : ! PARASOL. In COSP2, the Parasol simulator is independent of the calipso simulator.
2336 : refl_parasol(1:ncol,1:nsza_cosp) = cospOUT%parasolGrid_refl ! CAM version of parasolrefl (time,sza,profile)
2337 : ! CALIPSO Opaque cloud diagnostics
2338 : ! cldopaq_cal(1:pcols) = cospOUT%calipso_cldtype(:,1)
2339 : ! cldthin_cal(1:pcols) = cospOUT%calipso_cldtype(:,2)
2340 : ! cldopaqz_cal(1:pcols) = cospOUT%calipso_cldtype(:,3)
2341 : ! cldopaq_cal_temp(1:pcols) = cospOUT%calipso_cldtypetemp(:,1)
2342 : ! cldthin_cal_temp(1:pcols) = cospOUT%calipso_cldtypetemp(:,2)
2343 : ! cldzopaq_cal_temp(1:pcols) = cospOUT%calipso_cldtypetemp(:,3)
2344 : ! cldopaq_cal_z(1:pcols) = cospOUT%calipso_cldtypemeanz(:,1)
2345 : ! cldthin_cal_z(1:pcols) = cospOUT%calipso_cldtypemeanz(:,2)
2346 : ! cldthin_cal_emis(1:pcols) = cospOUT%calipso_cldthinemis
2347 : ! cldopaq_cal_se(1:pcols) = cospOUT%calipso_cldtypemeanzse(:,1)
2348 : ! cldthin_cal_se(1:pcols) = cospOUT%calipso_cldtypemeanzse(:,2)
2349 : ! cldzopaq_cal_se(1:pcols) = cospOUT%calipso_cldtypemeanzse(:,3)
2350 : ! cldopaq_cal_2d(1:pcols,1:nht_cosp) = cospOUT%calipso_lidarcldtype(:,:,1)
2351 : ! cldthin_cal_2d(1:pcols,1:nht_cosp) = cospOUT%calipso_lidarcldtype(:,:,2)
2352 : ! cldzopaq_cal_2d(1:pcols,1:nht_cosp) = cospOUT%calipso_lidarcldtype(:,:,3)
2353 : ! opacity_cal_2d(1:pcols,1:nht_cosp) = cospOUT%calipso_lidarcldtype(:,:,4)
2354 : endif
2355 :
2356 : ! ISCCP
2357 : if (lisccp_sim) then
2358 : clisccp2(1:ncol,1:ntau_cosp,1:nprs_cosp) = cospOUT%isccp_fq ! CAM version of clisccp2 (time,tau,plev,profile)
2359 : tau_isccp(1:ncol,1:nscol_cosp) = cospOUT%isccp_boxtau ! CAM version of boxtauisccp (time,column,profile)
2360 : cldptop_isccp(1:ncol,1:nscol_cosp) = cospOUT%isccp_boxptop ! CAM version of boxptopisccp (time,column,profile)
2361 : cldtot_isccp(1:ncol) = cospOUT%isccp_totalcldarea ! CAM version of tclisccp (time, profile)
2362 : meanptop_isccp(1:ncol) = cospOUT%isccp_meanptop ! CAM version of ctpisccp (time, profile)
2363 : meantau_isccp(1:ncol) = cospOUT%isccp_meantaucld ! CAM version of meantbisccp (time, profile)
2364 : meancldalb_isccp(1:ncol) = cospOUT%isccp_meanalbedocld ! CAM version of albisccp (time, profile)
2365 : meantb_isccp(1:ncol) = cospOUT%isccp_meantb ! CAM version of meantbisccp (time, profile)
2366 : meantbclr_isccp(1:ncol) = cospOUT%isccp_meantbclr ! CAM version of meantbclrisccp (time, profile)
2367 : endif
2368 :
2369 : ! MISR
2370 : if (lmisr_sim) then
2371 : clMISR(1:ncol,1:ntau_cosp,1:nhtmisr_cosp) = cospOUT%misr_fq ! CAM version of clMISR (time,tau,CTH_height_bin,profile)
2372 : endif
2373 :
2374 : ! MODIS
2375 : if (lmodis_sim) then
2376 : cltmodis(1:ncol) = cospOUT%modis_Cloud_Fraction_Total_Mean
2377 : clwmodis(1:ncol) = cospOUT%modis_Cloud_Fraction_Water_Mean
2378 : climodis(1:ncol) = cospOUT%modis_Cloud_Fraction_Ice_Mean
2379 : clhmodis(1:ncol) = cospOUT%modis_Cloud_Fraction_High_Mean
2380 : clmmodis(1:ncol) = cospOUT%modis_Cloud_Fraction_Mid_Mean
2381 : cllmodis(1:ncol) = cospOUT%modis_Cloud_Fraction_Low_Mean
2382 : tautmodis(1:ncol) = cospOUT%modis_Optical_Thickness_Total_Mean
2383 : tauwmodis(1:ncol) = cospOUT%modis_Optical_Thickness_Water_Mean
2384 : tauimodis(1:ncol) = cospOUT%modis_Optical_Thickness_Ice_Mean
2385 : tautlogmodis(1:ncol) = cospOUT%modis_Optical_Thickness_Total_LogMean
2386 : tauwlogmodis(1:ncol) = cospOUT%modis_Optical_Thickness_Water_LogMean
2387 : tauilogmodis(1:ncol) = cospOUT%modis_Optical_Thickness_Ice_LogMean
2388 : reffclwmodis(1:ncol) = cospOUT%modis_Cloud_Particle_Size_Water_Mean
2389 : reffclimodis(1:ncol) = cospOUT%modis_Cloud_Particle_Size_Ice_Mean
2390 : pctmodis(1:ncol) = cospOUT%modis_Cloud_Top_Pressure_Total_Mean
2391 : lwpmodis(1:ncol) = cospOUT%modis_Liquid_Water_Path_Mean
2392 : iwpmodis(1:ncol) = cospOUT%modis_Ice_Water_Path_Mean
2393 : clmodis(1:ncol,1:ntau_cosp_modis,1:nprs_cosp) = cospOUT%modis_Optical_Thickness_vs_Cloud_Top_Pressure
2394 : clrimodis(1:ncol,1:ntau_cosp_modis,1:numMODISReffIceBins) = cospOUT%modis_Optical_Thickness_vs_ReffICE
2395 : clrlmodis(1:ncol,1:ntau_cosp_modis,1:numMODISReffLiqBins) = cospOUT%modis_Optical_Thickness_vs_ReffLIQ
2396 : endif
2397 :
2398 : ! Use high-dimensional output to populate CAM collapsed output variables
2399 : ! see above for mixed dimension definitions
2400 : ! i am using the convention of starting vertical coordinates at the surface, up to down, COSP convention, not CAM.
2401 : do i=1,ncol
2402 : if (lradar_sim) then
2403 : ! CAM cfad_dbze94 (time,height,dbze,profile)
2404 : do ih=1,nht_cosp
2405 : do id=1,CLOUDSAT_DBZE_BINS
2406 : ihd=(ih-1)*CLOUDSAT_DBZE_BINS+id
2407 : cfad_dbze94_cs(i,ihd) = cfad_dbze94(i,id,ih) ! cfad_dbze94_cs(pcols,nht_cosp*CLOUDSAT_DBZE_BINS)
2408 : end do
2409 : end do
2410 : ! CAM dbze94 (time,height_mlev,column,profile)
2411 : do ihml=1,nhtml_cosp
2412 : do isc=1,nscol_cosp
2413 : ihsc=(ihml-1)*nscol_cosp+isc
2414 : dbze_cs(i,ihsc) = dbze94(i,isc,ihml) ! dbze_cs(pcols,pver*nscol_cosp)
2415 : end do
2416 : end do
2417 : endif
2418 :
2419 : if (llidar_sim) then
2420 : ! CAM cfad_lidarsr532 (time,height,scat_ratio,profile)
2421 : do ih=1,nht_cosp
2422 : do is=1,nsr_cosp
2423 : ihs=(ih-1)*nsr_cosp+is
2424 : cfad_sr532_cal(i,ihs) = cfad_lidarsr532(i,is,ih) ! cfad_sr532_cal(pcols,nht_cosp*nsr_cosp)
2425 : end do
2426 : end do
2427 : ! CAM atb532 (time,height_mlev,column,profile) FIX
2428 : do ihml=1,nhtml_cosp
2429 : do isc=1,nscol_cosp
2430 : ihsc=(ihml-1)*nscol_cosp+isc
2431 : atb532_cal(i,ihsc) = atb532(i,isc,ihml) ! atb532_cal(pcols,nht_cosp*nscol_cosp)
2432 : end do
2433 : end do
2434 : endif
2435 :
2436 : if (lmisr_sim) then
2437 : ! CAM clMISR (time,tau,CTH_height_bin,profile)
2438 : do ihm=1,nhtmisr_cosp
2439 : do it=1,ntau_cosp
2440 : ihmt=(ihm-1)*ntau_cosp+it
2441 : cld_misr(i,ihmt) = clMISR(i,it,ihm)
2442 : end do
2443 : end do
2444 : endif
2445 :
2446 : if (lmodis_sim) then
2447 : ! CAM clmodis
2448 : do ip=1,nprs_cosp
2449 : do it=1,ntau_cosp_modis
2450 : ipt=(ip-1)*ntau_cosp_modis+it
2451 : clmodis_cam(i,ipt) = clmodis(i,it,ip)
2452 : end do
2453 : end do
2454 : ! CAM clrimodis
2455 : do ip=1,numMODISReffIceBins
2456 : do it=1,ntau_cosp_modis
2457 : ipt=(ip-1)*ntau_cosp_modis+it
2458 : clrimodis_cam(i,ipt) = clrimodis(i,it,ip)
2459 : end do
2460 : end do
2461 : ! CAM clrlmodis
2462 : do ip=1,numMODISReffLiqBins
2463 : do it=1,ntau_cosp_modis
2464 : ipt=(ip-1)*ntau_cosp_modis+it
2465 : clrlmodis_cam(i,ipt) = clrlmodis(i,it,ip)
2466 : end do
2467 : end do
2468 : endif
2469 :
2470 : ! Subcolums
2471 : do ihml=1,nhtml_cosp
2472 : do isc=1,nscol_cosp
2473 : ihsc=(ihml-1)*nscol_cosp+isc
2474 : scops_out(i,ihsc) = frac_out(i,isc,ihml) ! scops_out(pcols,nht_cosp*nscol_cosp)
2475 : end do
2476 : end do
2477 : end do
2478 : call t_stopf("output_copying")
2479 :
2480 : ! ######################################################################################
2481 : ! Clean up
2482 : ! ######################################################################################
2483 : call t_startf("destroy_cospIN")
2484 : call destroy_cospIN(cospIN)
2485 : call t_stopf("destroy_cospIN")
2486 : call t_startf("destroy_cospstateIN")
2487 : call destroy_cospstateIN(cospstateIN)
2488 : call t_stopf("destroy_cospstateIN")
2489 : call t_startf("destroy_cospOUT")
2490 : call destroy_cosp_outputs(cospOUT)
2491 : call t_stopf("destroy_cospOUT")
2492 :
2493 : ! ######################################################################################
2494 : ! OUTPUT
2495 : ! ######################################################################################
2496 : call t_startf("writing_output")
2497 : ! ISCCP OUTPUTS
2498 : if (lisccp_sim) then
2499 : call outfld('FISCCP1_COSP',clisccp2, pcols,lchnk)
2500 : call outfld('CLDTOT_ISCCP',cldtot_isccp, pcols,lchnk)
2501 : !! weight meancldalb_isccp by the cloud fraction
2502 : !! where there is no isccp cloud fraction, set meancldalb_isccp = R_UNDEF
2503 : !! weight meanptop_isccp by the cloud fraction
2504 : !! where there is no isccp cloud fraction, set meanptop_isccp = R_UNDEF
2505 : !! weight meantau_isccp by the cloud fraction
2506 : !! where there is no isccp cloud fraction, set meantau_isccp = R_UNDEF
2507 : where (cldtot_isccp(:ncol) .eq. R_UNDEF)
2508 : meancldalb_isccp(:ncol) = R_UNDEF
2509 : meanptop_isccp(:ncol) = R_UNDEF
2510 : meantau_isccp(:ncol) = R_UNDEF
2511 : elsewhere
2512 : meancldalb_isccp(:ncol) = meancldalb_isccp(:ncol)*cldtot_isccp(:ncol)
2513 : meanptop_isccp(:ncol) = meanptop_isccp(:ncol)*cldtot_isccp(:ncol)
2514 : meantau_isccp(:ncol) = meantau_isccp(:ncol)*cldtot_isccp(:ncol)
2515 : end where
2516 : call outfld('MEANCLDALB_ISCCP',meancldalb_isccp,pcols,lchnk)
2517 : call outfld('MEANPTOP_ISCCP', meanptop_isccp, pcols,lchnk)
2518 : call outfld('MEANTAU_ISCCP', meantau_isccp, pcols,lchnk)
2519 : call outfld('MEANTB_ISCCP', meantb_isccp, pcols,lchnk)
2520 : call outfld('MEANTBCLR_ISCCP', meantbclr_isccp, pcols,lchnk)
2521 : end if
2522 :
2523 : ! CALIPSO SIMULATOR OUTPUTS
2524 : if (llidar_sim) then
2525 : call outfld('CLDLOW_CAL', cldlow_cal, pcols,lchnk)
2526 : call outfld('CLDMED_CAL', cldmed_cal, pcols,lchnk)
2527 : call outfld('CLDHGH_CAL', cldhgh_cal, pcols,lchnk)
2528 : call outfld('CLDTOT_CAL', cldtot_cal, pcols,lchnk)
2529 : call outfld('CLDTOT_CAL_ICE',cldtot_cal_ice, pcols,lchnk) !+1.4
2530 : call outfld('CLDTOT_CAL_LIQ',cldtot_cal_liq, pcols,lchnk)
2531 : call outfld('CLDTOT_CAL_UN', cldtot_cal_un, pcols,lchnk)
2532 : call outfld('CLDHGH_CAL_ICE',cldhgh_cal_ice, pcols,lchnk)
2533 : call outfld('CLDHGH_CAL_LIQ',cldhgh_cal_liq, pcols,lchnk)
2534 : call outfld('CLDHGH_CAL_UN', cldhgh_cal_un, pcols,lchnk)
2535 : call outfld('CLDMED_CAL_ICE',cldmed_cal_ice, pcols,lchnk)
2536 : call outfld('CLDMED_CAL_LIQ',cldmed_cal_liq, pcols,lchnk)
2537 : call outfld('CLDMED_CAL_UN', cldmed_cal_un, pcols,lchnk)
2538 : call outfld('CLDLOW_CAL_ICE',cldlow_cal_ice, pcols,lchnk)
2539 : call outfld('CLDLOW_CAL_LIQ',cldlow_cal_liq, pcols,lchnk)
2540 : call outfld('CLDLOW_CAL_UN', cldlow_cal_un, pcols,lchnk) !+1.4
2541 : where (cld_cal(:ncol,:nht_cosp) .eq. R_UNDEF)
2542 : !! setting missing values to 0 (clear air).
2543 : !! I'm not sure why COSP produces a mix of R_UNDEF and realvalue in the nht_cosp dimension.
2544 : cld_cal(:ncol,:nht_cosp) = 0.0_r8
2545 : end where
2546 : call outfld('CLD_CAL', cld_cal, pcols,lchnk) !! fails check_accum if 'A'
2547 : call outfld('MOL532_CAL', mol532_cal, pcols,lchnk)
2548 :
2549 : where (cfad_sr532_cal(:ncol,:nht_cosp*nsr_cosp) .eq. R_UNDEF)
2550 : !! fails check_accum if this is set... with ht_cosp set relative to sea level, mix of R_UNDEF and realvalue
2551 : !! cfad_sr532_cal(:ncol,:nht_cosp*nsr_cosp) = R_UNDEF
2552 : cfad_sr532_cal(:ncol,:nht_cosp*nsr_cosp) = 0.0_r8
2553 : end where
2554 : call outfld('CFAD_SR532_CAL',cfad_sr532_cal ,pcols,lchnk)
2555 :
2556 : where (refl_parasol(:ncol,:nsza_cosp) .eq. R_UNDEF)
2557 : !! setting missing values to 0 (clear air).
2558 : refl_parasol(:ncol,:nsza_cosp) = 0
2559 : end where
2560 : call outfld('RFL_PARASOL',refl_parasol ,pcols,lchnk) !!
2561 :
2562 : where (cld_cal_liq(:ncol,:nht_cosp) .eq. R_UNDEF) !+cosp1.4
2563 : !! setting missing values to 0 (clear air), likely below sea level
2564 : cld_cal_liq(:ncol,:nht_cosp) = 0.0_r8
2565 : end where
2566 : call outfld('CLD_CAL_LIQ',cld_cal_liq ,pcols,lchnk) !!
2567 :
2568 : where (cld_cal_ice(:ncol,:nht_cosp) .eq. R_UNDEF)
2569 : !! setting missing values to 0 (clear air), likely below sea level
2570 : cld_cal_ice(:ncol,:nht_cosp) = 0.0_r8
2571 : end where
2572 : call outfld('CLD_CAL_ICE',cld_cal_ice ,pcols,lchnk) !!
2573 :
2574 : where (cld_cal_un(:ncol,:nht_cosp) .eq. R_UNDEF)
2575 : !! setting missing values to 0 (clear air), likely below sea level
2576 : cld_cal_un(:ncol,:nht_cosp) = 0.0_r8
2577 : end where
2578 : call outfld('CLD_CAL_UN',cld_cal_un ,pcols,lchnk) !!
2579 :
2580 : where (cld_cal_tmp(:ncol,:nht_cosp) .eq. R_UNDEF)
2581 : !! setting missing values to 0 (clear air), likely below sea level
2582 : cld_cal_tmp(:ncol,:nht_cosp) = 0.0_r8
2583 : end where
2584 : call outfld('CLD_CAL_TMP',cld_cal_tmp ,pcols,lchnk) !!
2585 :
2586 : where (cld_cal_tmpliq(:ncol,:nht_cosp) .eq. R_UNDEF)
2587 : !! setting missing values to 0 (clear air), likely below sea level
2588 : cld_cal_tmpliq(:ncol,:nht_cosp) = 0.0_r8
2589 : end where
2590 : call outfld('CLD_CAL_TMPLIQ',cld_cal_tmpliq ,pcols,lchnk) !!
2591 :
2592 : where (cld_cal_tmpice(:ncol,:nht_cosp) .eq. R_UNDEF)
2593 : !! setting missing values to 0 (clear air), likely below sea level
2594 : cld_cal_tmpice(:ncol,:nht_cosp) = 0.0_r8
2595 : end where
2596 : call outfld('CLD_CAL_TMPICE',cld_cal_tmpice ,pcols,lchnk) !!
2597 :
2598 : where (cld_cal_tmpun(:ncol,:nht_cosp) .eq. R_UNDEF)
2599 : !! setting missing values to 0 (clear air), likely below sea level
2600 : cld_cal_tmpun(:ncol,:nht_cosp) = 0.0_r8
2601 : end where
2602 : call outfld('CLD_CAL_TMPUN',cld_cal_tmpun ,pcols,lchnk) !! !+cosp1.4
2603 :
2604 : ! Opaque cloud diagnostics
2605 : ! call outfld('CLDOPQ_CAL', cldopaq_cal, pcols, lchnk)
2606 : ! call outfld('CLDTHN_CAL', cldthin_cal, pcols, lchnk)
2607 : ! call outfld('CLDZOPQ_CAL', cldopaqz_cal, pcols, lchnk)
2608 : ! call outfld('CLDOPQ_CAL_TMP', cldopaq_cal_temp, pcols, lchnk)
2609 : ! call outfld('CLDTHN_CAL_TMP', cldthin_cal_temp, pcols, lchnk)
2610 : ! call outfld('CLDZOPQ_CAL_TMP', cldzopaq_cal_temp, pcols, lchnk)
2611 : ! call outfld('CLDOPQ_CAL_Z', cldopaq_cal_z, pcols, lchnk)
2612 : ! call outfld('CLDTHN_CAL_Z', cldthin_cal_z, pcols, lchnk)
2613 : ! call outfld('CLDTHN_CAL_EMIS', cldthin_cal_emis, pcols, lchnk)
2614 : ! call outfld('CLDOPQ_CAL_SE', cldopaq_cal_se, pcols, lchnk)
2615 : ! call outfld('CLDTHN_CAL_SE', cldthin_cal_se, pcols, lchnk)
2616 : ! call outfld('CLDZOPQ_CAL_SE', cldzopaq_cal_se, pcols, lchnk)
2617 : ! !
2618 : ! where (cldopaq_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF)
2619 : ! cldopaq_cal_2d(:ncol,:nht_cosp) = 0.0_r8
2620 : ! end where
2621 : ! call outfld('CLDOPQ_CAL_2D', cldopaq_cal_2d, pcols, lchnk)
2622 : ! !
2623 : ! where (cldthin_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF)
2624 : ! cldthin_cal_2d(:ncol,:nht_cosp) = 0.0_r8
2625 : ! end where
2626 : ! call outfld('CLDTHN_CAL_2D', cldthin_cal_2d, pcols, lchnk)
2627 : ! !
2628 : ! where (cldzopaq_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF)
2629 : ! cldzopaq_cal_2d(:ncol,:nht_cosp) = 0.0_r8
2630 : ! end where
2631 : ! call outfld('CLDZOPQ_CAL_2D', cldzopaq_cal_2d, pcols, lchnk)
2632 : ! !
2633 : ! where (opacity_cal_2d(:ncol,:nht_cosp) .eq. R_UNDEF)
2634 : ! opacity_cal_2d(:ncol,:nht_cosp) = 0.0_r8
2635 : ! end where
2636 : ! call outfld('OPACITY_CAL_2D', opacity_cal_2d, pcols, lchnk)
2637 :
2638 : end if
2639 :
2640 : ! RADAR SIMULATOR OUTPUTS
2641 : if (lradar_sim) then
2642 : where (cfad_dbze94_cs(:ncol,:nht_cosp*CLOUDSAT_DBZE_BINS) .eq. R_UNDEF)
2643 : !! fails check_accum if this is set... with ht_cosp set relative to sea level, mix of R_UNDEF and realvalue
2644 : ! cfad_dbze94_cs(:ncol,:nht_cosp*CLOUDSAT_DBZE_BINS) = R_UNDEF
2645 : cfad_dbze94_cs(:ncol,:nht_cosp*CLOUDSAT_DBZE_BINS) = 0.0_r8
2646 : end where
2647 : call outfld('CFAD_DBZE94_CS',cfad_dbze94_cs, pcols, lchnk)
2648 : call outfld('CLDTOT_CALCS', cldtot_calcs, pcols, lchnk)
2649 : call outfld('CLDTOT_CS', cldtot_cs, pcols, lchnk)
2650 : call outfld('CLDTOT_CS2', cldtot_cs2, pcols, lchnk)
2651 : call outfld('CLD_CAL_NOTCS', cld_cal_notcs, pcols, lchnk)
2652 : call outfld('CS_NOPRECIP', ptcloudsatflag0, pcols, lchnk)
2653 : call outfld('CS_RAINPOSS', ptcloudsatflag1, pcols, lchnk)
2654 : call outfld('CS_RAINPROB', ptcloudsatflag2, pcols, lchnk)
2655 : call outfld('CS_RAINCERT', ptcloudsatflag3, pcols, lchnk)
2656 : call outfld('CS_SNOWPOSS', ptcloudsatflag4, pcols, lchnk)
2657 : call outfld('CS_SNOWCERT', ptcloudsatflag5, pcols, lchnk)
2658 : call outfld('CS_MIXPOSS', ptcloudsatflag6, pcols, lchnk)
2659 : call outfld('CS_MIXCERT', ptcloudsatflag7, pcols, lchnk)
2660 : call outfld('CS_RAINHARD', ptcloudsatflag8, pcols, lchnk)
2661 : call outfld('CS_UN', ptcloudsatflag9, pcols, lchnk)
2662 : call outfld('CS_PIA', cloudsatpia, pcols, lchnk)
2663 : end if
2664 :
2665 : ! MISR SIMULATOR OUTPUTS
2666 : if (lmisr_sim) then
2667 : call outfld('CLD_MISR',cld_misr ,pcols,lchnk)
2668 : end if
2669 :
2670 : ! MODIS SIMULATOR OUTPUTS
2671 : if (lmodis_sim) then
2672 : call outfld('CLTMODIS',cltmodis ,pcols,lchnk)
2673 : call outfld('CLWMODIS',clwmodis ,pcols,lchnk)
2674 : call outfld('CLIMODIS',climodis ,pcols,lchnk)
2675 : call outfld('CLHMODIS',clhmodis ,pcols,lchnk)
2676 : call outfld('CLMMODIS',clmmodis ,pcols,lchnk)
2677 : call outfld('CLLMODIS',cllmodis ,pcols,lchnk)
2678 :
2679 : !! where there is no cloud fraction or no retrieval, set to R_UNDEF,
2680 : !! otherwise weight retrieval by cloud fraction
2681 : where ((cltmodis(:ncol) .eq. R_UNDEF) .or. (tautmodis(:ncol) .eq. R_UNDEF))
2682 : tautmodis(:ncol) = R_UNDEF
2683 : elsewhere
2684 : !! weight by the cloud fraction cltmodis
2685 : tautmodis(:ncol) = tautmodis(:ncol)*cltmodis(:ncol)
2686 : end where
2687 : call outfld('TAUTMODIS',tautmodis ,pcols,lchnk)
2688 :
2689 : where ((tauwmodis(:ncol) .eq. R_UNDEF) .or. (clwmodis(:ncol) .eq. R_UNDEF))
2690 : tauwmodis(:ncol) = R_UNDEF
2691 : elsewhere
2692 : !! weight by the cloud fraction clwmodis
2693 : tauwmodis(:ncol) = tauwmodis(:ncol)*clwmodis(:ncol)
2694 : end where
2695 : call outfld('TAUWMODIS',tauwmodis ,pcols,lchnk)
2696 :
2697 : where ((tauimodis(:ncol) .eq. R_UNDEF) .or. (climodis(:ncol) .eq. R_UNDEF))
2698 : tauimodis(:ncol) = R_UNDEF
2699 : elsewhere
2700 : !! weight by the cloud fraction climodis
2701 : tauimodis(:ncol) = tauimodis(:ncol)*climodis(:ncol)
2702 : end where
2703 : call outfld('TAUIMODIS',tauimodis ,pcols,lchnk)
2704 :
2705 : where ((tautlogmodis(:ncol) .eq. R_UNDEF) .or. (cltmodis(:ncol) .eq. R_UNDEF))
2706 : tautlogmodis(:ncol) = R_UNDEF
2707 : elsewhere
2708 : !! weight by the cloud fraction cltmodis
2709 : tautlogmodis(:ncol) = tautlogmodis(:ncol)*cltmodis(:ncol)
2710 : end where
2711 : call outfld('TAUTLOGMODIS',tautlogmodis ,pcols,lchnk)
2712 :
2713 : where ((tauwlogmodis(:ncol) .eq. R_UNDEF) .or. (clwmodis(:ncol) .eq. R_UNDEF))
2714 : tauwlogmodis(:ncol) = R_UNDEF
2715 : elsewhere
2716 : !! weight by the cloud fraction clwmodis
2717 : tauwlogmodis(:ncol) = tauwlogmodis(:ncol)*clwmodis(:ncol)
2718 : end where
2719 : call outfld('TAUWLOGMODIS',tauwlogmodis ,pcols,lchnk)
2720 :
2721 : where ((tauilogmodis(:ncol) .eq. R_UNDEF) .or. (climodis(:ncol) .eq. R_UNDEF))
2722 : tauilogmodis(:ncol) = R_UNDEF
2723 : elsewhere
2724 : !! weight by the cloud fraction climodis
2725 : tauilogmodis(:ncol) = tauilogmodis(:ncol)*climodis(:ncol)
2726 : end where
2727 : call outfld('TAUILOGMODIS',tauilogmodis ,pcols,lchnk)
2728 :
2729 : where ((reffclwmodis(:ncol) .eq. R_UNDEF) .or. (clwmodis(:ncol) .eq. R_UNDEF))
2730 : reffclwmodis(:ncol) = R_UNDEF
2731 : elsewhere
2732 : !! weight by the cloud fraction clwmodis
2733 : reffclwmodis(:ncol) = reffclwmodis(:ncol)*clwmodis(:ncol)
2734 : end where
2735 : call outfld('REFFCLWMODIS',reffclwmodis ,pcols,lchnk)
2736 :
2737 : where ((reffclimodis(:ncol) .eq. R_UNDEF) .or. (climodis(:ncol) .eq. R_UNDEF))
2738 : reffclimodis(:ncol) = R_UNDEF
2739 : elsewhere
2740 : !! weight by the cloud fraction climodis
2741 : reffclimodis(:ncol) = reffclimodis(:ncol)*climodis(:ncol)
2742 : end where
2743 : call outfld('REFFCLIMODIS',reffclimodis ,pcols,lchnk)
2744 :
2745 : where ((pctmodis(:ncol) .eq. R_UNDEF) .or. ( cltmodis(:ncol) .eq. R_UNDEF))
2746 : pctmodis(:ncol) = R_UNDEF
2747 : elsewhere
2748 : !! weight by the cloud fraction cltmodis
2749 : pctmodis(:ncol) = pctmodis(:ncol)*cltmodis(:ncol)
2750 : end where
2751 : call outfld('PCTMODIS',pctmodis ,pcols,lchnk)
2752 :
2753 : where ((lwpmodis(:ncol) .eq. R_UNDEF) .or. (clwmodis(:ncol) .eq. R_UNDEF))
2754 : lwpmodis(:ncol) = R_UNDEF
2755 : elsewhere
2756 : !! weight by the cloud fraction clwmodis
2757 : lwpmodis(:ncol) = lwpmodis(:ncol)*clwmodis(:ncol)
2758 : end where
2759 : call outfld('LWPMODIS',lwpmodis ,pcols,lchnk)
2760 :
2761 : where ((iwpmodis(:ncol) .eq. R_UNDEF) .or. (climodis(:ncol) .eq. R_UNDEF))
2762 : iwpmodis(:ncol) = R_UNDEF
2763 : elsewhere
2764 : !! weight by the cloud fraction climodis
2765 : iwpmodis(:ncol) = iwpmodis(:ncol)*climodis(:ncol)
2766 : end where
2767 : call outfld('IWPMODIS',iwpmodis ,pcols,lchnk)
2768 :
2769 : call outfld('CLMODIS',clmodis_cam ,pcols,lchnk)
2770 : call outfld('CLRIMODIS',clrimodis_cam ,pcols,lchnk)
2771 : call outfld('CLRLMODIS',clrlmodis_cam ,pcols,lchnk)
2772 : end if
2773 :
2774 : ! SUB-COLUMN OUTPUT
2775 : if (lfrac_out) then
2776 : call outfld('SCOPS_OUT',scops_out ,pcols,lchnk)!!!-1.00000E+30 !! fails check_accum if 'A'
2777 : if (lisccp_sim) then
2778 : call outfld('TAU_ISCCP', tau_isccp, pcols,lchnk) !! fails check_accum if 'A'
2779 : call outfld('CLDPTOP_ISCCP',cldptop_isccp,pcols,lchnk) !! fails check_accum if 'A'
2780 : end if
2781 : if (llidar_sim) then
2782 : call outfld('ATB532_CAL',atb532_cal,pcols,lchnk) !! fails check_accum if 'A'
2783 : end if
2784 : if (lradar_sim) then
2785 : call outfld('DBZE_CS',dbze_cs,pcols,lchnk) !! fails check_accum if 'A'
2786 : end if
2787 : end if
2788 : call t_stopf("writing_output")
2789 : #endif
2790 0 : end subroutine cospsimulator_intr_run
2791 :
2792 : #ifdef USE_COSP
2793 : ! ######################################################################################
2794 : ! SUBROUTINE subsample_and_optics
2795 : ! ######################################################################################
2796 : subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap, &
2797 : use_precipitation_fluxes, lidar_ice_type, sd, tca, cca,&
2798 : fl_lsrainIN, fl_lssnowIN, fl_lsgrplIN, fl_ccrainIN, &
2799 : fl_ccsnowIN, mr_lsliq, mr_lsice, mr_ccliq, mr_ccice, &
2800 : reffIN, dtau_c, dtau_s, dem_c, dem_s, dtau_s_snow, &
2801 : dem_s_snow, sfcP, cospstateIN, cospIN)
2802 : ! Dependencies
2803 : use cosp_kinds, only: wp
2804 : use mod_rng, only: rng_state, init_rng
2805 : use mod_cosp_config, only: R_UNDEF
2806 : use mod_scops, only: scops
2807 : use mod_prec_scops, only: prec_scops
2808 : use mod_cosp_utils, only: cosp_precip_mxratio
2809 : use mod_quickbeam_optics, only: quickbeam_optics, gases
2810 : use cosp_optics, only: cosp_simulator_optics,lidar_optics,modis_optics, &
2811 : modis_optics_partition
2812 : use mod_cosp_config, only: Nlvgrid, vgrid_zl, vgrid_zu
2813 : use mod_cosp_stats, only: cosp_change_vertical_grid
2814 : ! Inputs
2815 : logical,intent(in) :: &
2816 : use_precipitation_fluxes
2817 : integer,intent(in) :: &
2818 : nPoints, & ! Number of gridpoints
2819 : nLevels, & ! Number of vertical levels
2820 : nColumns, & ! Number of subcolumns
2821 : nHydro, & ! Number pf hydrometeor types
2822 : overlap, & ! Overlap assumption (1/2/3)
2823 : lidar_ice_type ! Ice type assumption used by lidar optics
2824 : real(wp),intent(in),dimension(nPoints,nLevels) :: &
2825 : tca, & ! Total cloud amount (0-1)
2826 : cca, & ! Convective cloud amount (0-1)
2827 : mr_lsliq, & ! Mixing ratio (kg/kg)
2828 : mr_lsice, & ! Mixing ratio (kg/kg)
2829 : mr_ccliq, & ! Mixing ratio (kg/kg)
2830 : mr_ccice, & ! Mixing ratio (kg/kg)
2831 : dtau_c, & ! 0.67-micron optical depth (convective)
2832 : dtau_s, & ! 0.67-micron optical depth (stratiform)
2833 : dem_c, & ! 11-micron emissivity (convective)
2834 : dem_s, & ! 11-micron emissivity (stratiform)
2835 : fl_lsrainIN, & ! Precipitation flux
2836 : fl_lssnowIN, & ! Precipitation flux
2837 : fl_lsgrplIN, & ! Precipitation flux
2838 : fl_ccrainIN, & ! Precipitation flux
2839 : fl_ccsnowIN ! Precipitation flux
2840 : real(wp),intent(inout),dimension(nPoints,nLevels) :: &
2841 : dtau_s_snow, & ! 0.67-micron optical depth (snow)
2842 : dem_s_snow ! 11-micron emissivity (snow)
2843 : real(wp),intent(in),dimension(nPoints,nLevels,nHydro) :: &
2844 : reffIN !
2845 : real(wp),intent(in),dimension(nPoints) :: &
2846 : sfcP ! Surface pressure
2847 : type(size_distribution),intent(inout) :: &
2848 : sd
2849 :
2850 : ! Outputs
2851 : type(cosp_optical_inputs),intent(inout) :: cospIN
2852 : type(cosp_column_inputs),intent(inout) :: cospstateIN
2853 :
2854 : ! Local variables
2855 : integer :: i,j,k
2856 : real(wp),dimension(nPoints,nLevels) :: column_frac_out,column_prec_out, &
2857 : fl_lsrain,fl_lssnow,fl_lsgrpl,fl_ccrain, &
2858 : fl_ccsnow
2859 : real(wp),dimension(nPoints,nLevels,nHydro) :: ReffTemp
2860 : type(rng_state),allocatable,dimension(:) :: rngs ! Seeds for random number generator
2861 : integer,dimension(:),allocatable :: seed
2862 : real(wp),dimension(:,:),allocatable :: ls_p_rate,cv_p_rate,frac_ls,frac_cv, &
2863 : prec_ls,prec_cv,g_vol
2864 : real(wp),dimension(:,:,:), allocatable :: frac_prec,&
2865 : MODIS_cloudWater,MODIS_cloudIce, &
2866 : MODIS_watersize,MODIS_iceSize, &
2867 : MODIS_snowSize,MODIS_cloudSnow, &
2868 : MODIS_opticalThicknessLiq, &
2869 : MODIS_opticalThicknessSnow, &
2870 : MODIS_opticalThicknessIce, &
2871 : fracPrecipIce, fracPrecipIce_statGrid
2872 : real(wp),dimension(:,:,:,:),allocatable :: mr_hydro,Reff,Np
2873 :
2874 : call t_startf("scops")
2875 : if (Ncolumns .gt. 1) then
2876 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2877 : ! Generate subcolumns for clouds (SCOPS) and precipitation type (PREC_SCOPS)
2878 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2879 : ! RNG used for subcolumn generation
2880 : allocate(rngs(nPoints),seed(nPoints))
2881 : seed = int(sfcP)
2882 : if (Npoints .gt. 1) seed=(sfcP-int(sfcP))*1000000
2883 : call init_rng(rngs, seed)
2884 :
2885 : ! Call scops
2886 : call scops(NPoints,Nlevels,Ncolumns,rngs,tca,cca,overlap,cospIN%frac_out,0)
2887 : deallocate(seed,rngs)
2888 :
2889 : ! Sum up precipitation rates. If not using preciitation fluxes, mixing ratios are
2890 : ! stored in _rate variables.
2891 : allocate(ls_p_rate(nPoints,nLevels),cv_p_rate(nPoints,Nlevels))
2892 : if(use_precipitation_fluxes) then
2893 : ls_p_rate(:,1:nLevels) = fl_lsrainIN + fl_lssnowIN + fl_lsgrplIN
2894 : cv_p_rate(:,1:nLevels) = fl_ccrainIN + fl_ccsnowIN
2895 : else
2896 : ls_p_rate(:,1:nLevels) = 0 ! mixing_ratio(rain) + mixing_ratio(snow) + mixing_ratio (groupel)
2897 : cv_p_rate(:,1:nLevels) = 0 ! mixing_ratio(rain) + mixing_ratio(snow)
2898 : endif
2899 :
2900 : ! Call PREC_SCOPS
2901 : allocate(frac_prec(nPoints,nColumns,nLevels))
2902 : call prec_scops(nPoints,nLevels,nColumns,ls_p_rate,cv_p_rate,cospIN%frac_out,frac_prec)
2903 : deallocate(ls_p_rate,cv_p_rate)
2904 :
2905 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2906 : ! Compute precipitation fraction in each gridbox
2907 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2908 : ! Allocate
2909 : allocate(frac_ls(nPoints,nLevels),prec_ls(nPoints,nLevels), &
2910 : frac_cv(nPoints,nLevels),prec_cv(nPoints,nLevels))
2911 :
2912 : ! Initialize
2913 : frac_ls(1:nPoints,1:nLevels) = 0._wp
2914 : prec_ls(1:nPoints,1:nLevels) = 0._wp
2915 : frac_cv(1:nPoints,1:nLevels) = 0._wp
2916 : prec_cv(1:nPoints,1:nLevels) = 0._wp
2917 : do j=1,nPoints
2918 : do k=1,nLevels
2919 : do i=1,nColumns
2920 : if (cospIN%frac_out(j,i,k) .eq. 1) frac_ls(j,k) = frac_ls(j,k)+1._wp
2921 : if (cospIN%frac_out(j,i,k) .eq. 2) frac_cv(j,k) = frac_cv(j,k)+1._wp
2922 : if (frac_prec(j,i,k) .eq. 1) prec_ls(j,k) = prec_ls(j,k)+1._wp
2923 : if (frac_prec(j,i,k) .eq. 2) prec_cv(j,k) = prec_cv(j,k)+1._wp
2924 : if (frac_prec(j,i,k) .eq. 3) prec_cv(j,k) = prec_cv(j,k)+1._wp
2925 : if (frac_prec(j,i,k) .eq. 3) prec_ls(j,k) = prec_ls(j,k)+1._wp
2926 : enddo
2927 : frac_ls(j,k)=frac_ls(j,k)/nColumns
2928 : frac_cv(j,k)=frac_cv(j,k)/nColumns
2929 : prec_ls(j,k)=prec_ls(j,k)/nColumns
2930 : prec_cv(j,k)=prec_cv(j,k)/nColumns
2931 :
2932 : ! Adjust grid-box mean snow properties to local properties
2933 : ! Convert longwave optical depth to longwave emissivity
2934 : if (prec_ls(j,k) .ne. 0._r8 .and. dtau_s_snow(j,k) .gt. 0._r8) then
2935 : dtau_s_snow(j,k) = dtau_s_snow(j,k)/prec_ls(j,k)
2936 : end if
2937 : if (prec_ls(j,k) .ne. 0._r8 .and. dem_s_snow(j,k) .gt. 0._r8) then
2938 : dem_s_snow(j,k) = dem_s_snow(j,k)/prec_ls(j,k)
2939 : dem_s_snow(j,k) = 1._r8 - exp ( -1._r8*dem_s_snow(j,k))
2940 : end if !!+JEK
2941 : enddo
2942 : enddo
2943 :
2944 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2945 : ! Compute mixing ratios, effective radii and precipitation fluxes for clouds
2946 : ! and precipitation
2947 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2948 : allocate(mr_hydro(nPoints,nColumns,nLevels,nHydro), &
2949 : Reff(nPoints,nColumns,nLevels,nHydro), &
2950 : Np(nPoints,nColumns,nLevels,nHydro))
2951 :
2952 : ! Initialize
2953 : mr_hydro(:,:,:,:) = 0._wp
2954 : Reff(:,:,:,:) = 0._wp
2955 : Np(:,:,:,:) = 0._wp
2956 :
2957 : do k=1,nColumns
2958 : ! Subcolumn clouds
2959 : column_frac_out = cospIN%frac_out(:,k,:)
2960 :
2961 : ! LS clouds
2962 : where (column_frac_out == I_LSC)
2963 : mr_hydro(:,k,:,I_LSCLIQ) = mr_lsliq
2964 : mr_hydro(:,k,:,I_LSCICE) = mr_lsice
2965 : Reff(:,k,:,I_LSCLIQ) = ReffIN(:,:,I_LSCLIQ)
2966 : Reff(:,k,:,I_LSCICE) = ReffIN(:,:,I_LSCICE)
2967 : ! CONV clouds
2968 : elsewhere (column_frac_out == I_CVC)
2969 : mr_hydro(:,k,:,I_CVCLIQ) = mr_ccliq
2970 : mr_hydro(:,k,:,I_CVCICE) = mr_ccice
2971 : Reff(:,k,:,I_CVCLIQ) = ReffIN(:,:,I_CVCLIQ)
2972 : Reff(:,k,:,I_CVCICE) = ReffIN(:,:,I_CVCICE)
2973 : end where
2974 :
2975 : ! Subcolumn precipitation
2976 : column_prec_out = frac_prec(:,k,:)
2977 :
2978 : ! LS Precipitation
2979 : where ((column_prec_out == 1) .or. (column_prec_out == 3) )
2980 : Reff(:,k,:,I_LSRAIN) = ReffIN(:,:,I_LSRAIN)
2981 : Reff(:,k,:,I_LSSNOW) = ReffIN(:,:,I_LSSNOW)
2982 : Reff(:,k,:,I_LSGRPL) = ReffIN(:,:,I_LSGRPL)
2983 : ! CONV precipitation
2984 : elsewhere ((column_prec_out == 2) .or. (column_prec_out == 3))
2985 : Reff(:,k,:,I_CVRAIN) = ReffIN(:,:,I_CVRAIN)
2986 : Reff(:,k,:,I_CVSNOW) = ReffIN(:,:,I_CVSNOW)
2987 : end where
2988 : enddo
2989 :
2990 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2991 : ! Convert the mixing ratio and precipitation fluxes from gridbox mean to
2992 : ! the fraction-based values
2993 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2994 : do k=1,nLevels
2995 : do j=1,nPoints
2996 : ! Clouds
2997 : if (frac_ls(j,k) .ne. 0._r8) then
2998 : mr_hydro(j,:,k,I_LSCLIQ) = mr_hydro(j,:,k,I_LSCLIQ)/frac_ls(j,k)
2999 : mr_hydro(j,:,k,I_LSCICE) = mr_hydro(j,:,k,I_LSCICE)/frac_ls(j,k)
3000 : endif
3001 : if (frac_cv(j,k) .ne. 0._r8) then
3002 : mr_hydro(j,:,k,I_CVCLIQ) = mr_hydro(j,:,k,I_CVCLIQ)/frac_cv(j,k)
3003 : mr_hydro(j,:,k,I_CVCICE) = mr_hydro(j,:,k,I_CVCICE)/frac_cv(j,k)
3004 : endif
3005 :
3006 : ! Precipitation
3007 : if (use_precipitation_fluxes) then
3008 : if (prec_ls(j,k) .ne. 0._r8) then
3009 : fl_lsrain(j,k) = fl_lsrainIN(j,k)/prec_ls(j,k)
3010 : fl_lssnow(j,k) = fl_lssnowIN(j,k)/prec_ls(j,k)
3011 : fl_lsgrpl(j,k) = fl_lsgrplIN(j,k)/prec_ls(j,k)
3012 : endif
3013 : if (prec_cv(j,k) .ne. 0._r8) then
3014 : fl_ccrain(j,k) = fl_ccrainIN(j,k)/prec_cv(j,k)
3015 : fl_ccsnow(j,k) = fl_ccsnowIN(j,k)/prec_cv(j,k)
3016 : endif
3017 : else
3018 : if (prec_ls(j,k) .ne. 0._r8) then
3019 : mr_hydro(j,:,k,I_LSRAIN) = mr_hydro(j,:,k,I_LSRAIN)/prec_ls(j,k)
3020 : mr_hydro(j,:,k,I_LSSNOW) = mr_hydro(j,:,k,I_LSSNOW)/prec_ls(j,k)
3021 : mr_hydro(j,:,k,I_LSGRPL) = mr_hydro(j,:,k,I_LSGRPL)/prec_ls(j,k)
3022 : endif
3023 : if (prec_cv(j,k) .ne. 0._r8) then
3024 : mr_hydro(j,:,k,I_CVRAIN) = mr_hydro(j,:,k,I_CVRAIN)/prec_cv(j,k)
3025 : mr_hydro(j,:,k,I_CVSNOW) = mr_hydro(j,:,k,I_CVSNOW)/prec_cv(j,k)
3026 : endif
3027 : endif
3028 : enddo
3029 : enddo
3030 :
3031 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3032 : ! Convert precipitation fluxes to mixing ratios
3033 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3034 : if (use_precipitation_fluxes) then
3035 : ! LS rain
3036 : call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, &
3037 : cospstateIN%at, frac_prec, 1._wp, n_ax(I_LSRAIN), n_bx(I_LSRAIN), &
3038 : alpha_x(I_LSRAIN), c_x(I_LSRAIN), d_x(I_LSRAIN), g_x(I_LSRAIN), &
3039 : a_x(I_LSRAIN), b_x(I_LSRAIN), gamma_1(I_LSRAIN), gamma_2(I_LSRAIN), &
3040 : gamma_3(I_LSRAIN), gamma_4(I_LSRAIN), fl_lsrain, &
3041 : mr_hydro(:,:,:,I_LSRAIN), Reff(:,:,:,I_LSRAIN))
3042 : ! LS snow
3043 : call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, &
3044 : cospstateIN%at, frac_prec, 1._wp, n_ax(I_LSSNOW), n_bx(I_LSSNOW), &
3045 : alpha_x(I_LSSNOW), c_x(I_LSSNOW), d_x(I_LSSNOW), g_x(I_LSSNOW), &
3046 : a_x(I_LSSNOW), b_x(I_LSSNOW), gamma_1(I_LSSNOW), gamma_2(I_LSSNOW), &
3047 : gamma_3(I_LSSNOW), gamma_4(I_LSSNOW), fl_lssnow, &
3048 : mr_hydro(:,:,:,I_LSSNOW), Reff(:,:,:,I_LSSNOW))
3049 : ! CV rain
3050 : call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, &
3051 : cospstateIN%at, frac_prec, 2._wp, n_ax(I_CVRAIN), n_bx(I_CVRAIN), &
3052 : alpha_x(I_CVRAIN), c_x(I_CVRAIN), d_x(I_CVRAIN), g_x(I_CVRAIN), &
3053 : a_x(I_CVRAIN), b_x(I_CVRAIN), gamma_1(I_CVRAIN), gamma_2(I_CVRAIN), &
3054 : gamma_3(I_CVRAIN), gamma_4(I_CVRAIN), fl_ccrain, &
3055 : mr_hydro(:,:,:,I_CVRAIN), Reff(:,:,:,I_CVRAIN))
3056 : ! CV snow
3057 : call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, &
3058 : cospstateIN%at, frac_prec, 2._wp, n_ax(I_CVSNOW), n_bx(I_CVSNOW), &
3059 : alpha_x(I_CVSNOW), c_x(I_CVSNOW), d_x(I_CVSNOW), g_x(I_CVSNOW), &
3060 : a_x(I_CVSNOW), b_x(I_CVSNOW), gamma_1(I_CVSNOW), gamma_2(I_CVSNOW), &
3061 : gamma_3(I_CVSNOW), gamma_4(I_CVSNOW), fl_ccsnow, &
3062 : mr_hydro(:,:,:,I_CVSNOW), Reff(:,:,:,I_CVSNOW))
3063 : ! LS groupel.
3064 : call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, &
3065 : cospstateIN%at, frac_prec, 1._wp, n_ax(I_LSGRPL), n_bx(I_LSGRPL), &
3066 : alpha_x(I_LSGRPL), c_x(I_LSGRPL), d_x(I_LSGRPL), g_x(I_LSGRPL), &
3067 : a_x(I_LSGRPL), b_x(I_LSGRPL), gamma_1(I_LSGRPL), gamma_2(I_LSGRPL), &
3068 : gamma_3(I_LSGRPL), gamma_4(I_LSGRPL), fl_lsgrpl, &
3069 : mr_hydro(:,:,:,I_LSGRPL), Reff(:,:,:,I_LSGRPL))
3070 : endif
3071 :
3072 : else
3073 : cospIN%frac_out(:,:,:) = 1
3074 : allocate(mr_hydro(nPoints, 1,nLevels,nHydro),Reff(nPoints,1,nLevels,nHydro), &
3075 : Np(nPoints,1,nLevels,nHydro))
3076 : mr_hydro(:,1,:,I_LSCLIQ) = mr_lsliq
3077 : mr_hydro(:,1,:,I_LSCICE) = mr_lsice
3078 : mr_hydro(:,1,:,I_CVCLIQ) = mr_ccliq
3079 : mr_hydro(:,1,:,I_CVCICE) = mr_ccice
3080 : Reff(:,1,:,:) = ReffIN
3081 : endif
3082 : call t_stopf("scops")
3083 :
3084 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3085 : ! CLOUDSAT RADAR OPTICS
3086 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3087 : call t_startf("cloudsat_optics")
3088 : if (lradar_sim) then
3089 : ! Compute gaseous absorption (assume identical for each subcolun)
3090 : allocate(g_vol(nPoints,nLevels))
3091 : g_vol(:,:)=0._wp
3092 : do i = 1, nPoints
3093 : do j = 1, nLevels
3094 : if (cospIN%rcfg_cloudsat%use_gas_abs == 1 .or. &
3095 : (cospIN%rcfg_cloudsat%use_gas_abs == 2 .and. j == 1)) then
3096 : g_vol(i,j) = gases(cospstateIN%pfull(i,j), cospstateIN%at(i,j), &
3097 : cospstateIN%qv(i,j), cospIN%rcfg_cloudsat%freq)
3098 : endif
3099 : cospIN%g_vol_cloudsat(i,:,j) = g_vol(i,j)
3100 : end do
3101 : end do
3102 :
3103 : ! Loop over all subcolumns
3104 : allocate(fracPrecipIce(nPoints,nColumns,nLevels))
3105 : fracPrecipIce(:,:,:) = 0._wp
3106 : do k=1,nColumns
3107 : call quickbeam_optics(sd, cospIN%rcfg_cloudsat, nPoints, nLevels, R_UNDEF, &
3108 : mr_hydro(:,k,:,1:nHydro)*1000._wp, Reff(:,k,:,1:nHydro)*1.e6_wp, &
3109 : Np(:,k,:,1:nHydro), cospstateIN%pfull, cospstateIN%at, &
3110 : cospstateIN%qv, cospIN%z_vol_cloudsat(1:nPoints,k,:), &
3111 : cospIN%kr_vol_cloudsat(1:nPoints,k,:))
3112 :
3113 : ! At each model level, what fraction of the precipitation is frozen?
3114 : where(mr_hydro(:,k,:,I_LSRAIN) .gt. 0 .or. mr_hydro(:,k,:,I_LSSNOW) .gt. 0 .or. &
3115 : mr_hydro(:,k,:,I_CVRAIN) .gt. 0 .or. mr_hydro(:,k,:,I_CVSNOW) .gt. 0 .or. &
3116 : mr_hydro(:,k,:,I_LSGRPL) .gt. 0)
3117 : fracPrecipIce(:,k,:) = (mr_hydro(:,k,:,I_LSSNOW) + mr_hydro(:,k,:,I_CVSNOW) + &
3118 : mr_hydro(:,k,:,I_LSGRPL)) / &
3119 : (mr_hydro(:,k,:,I_LSSNOW) + mr_hydro(:,k,:,I_CVSNOW) + mr_hydro(:,k,:,I_LSGRPL) + &
3120 : mr_hydro(:,k,:,I_LSRAIN) + mr_hydro(:,k,:,I_CVRAIN))
3121 : elsewhere
3122 : fracPrecipIce(:,k,:) = 0._wp
3123 : endwhere
3124 : enddo
3125 :
3126 : ! Regrid frozen fraction to Cloudsat/Calipso statistical grid
3127 : allocate(fracPrecipIce_statGrid(nPoints,nColumns,Nlvgrid))
3128 : fracPrecipIce_statGrid(:,:,:) = 0._wp
3129 : call cosp_change_vertical_grid(Npoints, Ncolumns, Nlevels, cospstateIN%hgt_matrix(:,Nlevels:1:-1), &
3130 : cospstateIN%hgt_matrix_half(:,Nlevels:1:-1), fracPrecipIce(:,:,Nlevels:1:-1), Nlvgrid, &
3131 : vgrid_zl(Nlvgrid:1:-1), vgrid_zu(Nlvgrid:1:-1), fracPrecipIce_statGrid(:,:,Nlvgrid:1:-1))
3132 :
3133 : ! For near-surface diagnostics, we only need the frozen fraction at one layer.
3134 : cospIN%fracPrecipIce(:,:) = fracPrecipIce_statGrid(:,:,cloudsat_preclvl)
3135 :
3136 : ! Regrid preipitation mixing-ratios to statistical grid.
3137 : !allocate(tempStatGrid(nPoints,ncol,Nlvgrid))
3138 : !tempStatGrid(:,:,:,:) = 0._wp
3139 : !call cosp_change_vertical_grid(Npoints, ncol, pver, cospstateIN%hgt_matrix(:,pver:1:-1), &
3140 : ! cospstateIN%hgt_matrix_half(:,pver:1:-1), mr_hydro(:,:,:,LSGRPL), &
3141 : ! Nlvgrid,vgrid_zl(Nlvgrid:1:-1), vgrid_zu(Nlvgrid:1:-1), tempStatGrid)
3142 : !
3143 : endif
3144 : call t_stopf("cloudsat_optics")
3145 :
3146 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3147 : ! CALIPSO Polarized optics
3148 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3149 : call t_startf("calipso_optics")
3150 : if (Llidar_sim) then
3151 : ReffTemp = ReffIN
3152 : call lidar_optics(nPoints,nColumns,nLevels,5,lidar_ice_type, &
3153 : mr_hydro(1:nPoints,1:nColumns,1:nLevels,I_LSCLIQ), &
3154 : mr_hydro(1:nPoints,1:nColumns,1:nLevels,I_LSCICE), &
3155 : mr_hydro(1:nPoints,1:nColumns,1:nLevels,I_CVCLIQ), &
3156 : mr_hydro(1:nPoints,1:nColumns,1:nLevels,I_CVCICE), &
3157 : mr_hydro(1:nPoints,1:nColumns,1:nLevels,I_LSSNOW), &
3158 : ReffTemp(1:nPoints,1:nLevels,I_LSCLIQ), &
3159 : ReffTemp(1:nPoints,1:nLevels,I_LSCICE), &
3160 : ReffTemp(1:nPoints,1:nLevels,I_CVCLIQ), &
3161 : ReffTemp(1:nPoints,1:nLevels,I_CVCICE), &
3162 : ReffTemp(1:nPoints,1:nLevels,I_LSSNOW), &
3163 : cospstateIN%pfull(1:nPoints,1:nLevels), &
3164 : cospstateIN%phalf(1:nPoints,1:nLevels+1), &
3165 : cospstateIN%at(1:nPoints,1:nLevels), &
3166 : cospIN%beta_mol_calipso(1:nPoints,1:nLevels), &
3167 : cospIN%betatot_calipso(1:nPoints,1:nColumns,1:nLevels), &
3168 : cospIN%tau_mol_calipso(1:nPoints,1:nLevels), &
3169 : cospIN%tautot_calipso(1:nPoints,1:nColumns,1:nLevels), &
3170 : cospIN%tautot_S_liq(1:nPoints,1:nColumns), &
3171 : cospIN%tautot_S_ice(1:nPoints,1:nColumns), &
3172 : cospIN%betatot_ice_calipso(1:nPoints,1:nColumns,1:nLevels), &
3173 : cospIN%betatot_liq_calipso(1:nPoints,1:nColumns,1:nLevels), &
3174 : cospIN%tautot_ice_calipso(1:nPoints,1:nColumns,1:nLevels), &
3175 : cospIN%tautot_liq_calipso(1:nPoints,1:nColumns,1:nLevels))
3176 : endif
3177 : call t_stopf("calipso_optics")
3178 :
3179 :
3180 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3181 : ! Compute optical fields for passive simulators (i.e. only sunlit points)
3182 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3183 :
3184 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3185 : ! 11 micron emissivity (needed by the ISCCP simulator)
3186 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3187 : call t_startf("11micron_emissivity")
3188 : if (Lisccp_sim) then
3189 : call cosp_simulator_optics(nPoints,nColumns,nLevels,cospIN%frac_out,dem_c,dem_s, &
3190 : cospIN%emiss_11)
3191 : ! Add in contributions from radiative snow
3192 : do j=1,nColumns
3193 : where(frac_prec(:,j,:) .eq. 1 .or. frac_prec(:,j,:) .eq. 3)
3194 : cospIN%emiss_11(:,j,:) = 1._wp - (1- cospIN%emiss_11(:,j,:))*(1-dem_s_snow)
3195 : endwhere
3196 : enddo
3197 : endif
3198 : call t_stopf("11micron_emissivity")
3199 :
3200 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3201 : ! 0.67 micron optical depth (needed by ISCCP, MISR and MODIS simulators)
3202 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3203 : call t_startf("067tau")
3204 : if (Lisccp_sim .or. Lmisr_sim .or. Lmodis_sim) then
3205 : call cosp_simulator_optics(nPoints,nColumns,nLevels,cospIN%frac_out,dtau_c,dtau_s,&
3206 : cospIN%tau_067)
3207 :
3208 : ! Add in contributions from snow
3209 : do j=1,nColumns
3210 : where((frac_prec(:,j,:) .eq. 1 .or. frac_prec(:,j,:) .eq. 3) .and. &
3211 : Reff(:,j,:,I_LSSNOW) .gt. 0._r8 .and. dtau_s_snow .gt. 0._r8)
3212 : cospIN%tau_067(:,j,:) = cospIN%tau_067(:,j,:)+dtau_s_snow
3213 : endwhere
3214 : enddo
3215 : endif
3216 : call t_stopf("067tau")
3217 :
3218 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3219 : ! MODIS optics
3220 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3221 : call t_startf("modis_optics")
3222 : if (lmodis_sim) then
3223 : allocate(MODIS_cloudWater(nPoints,nColumns,nLevels), &
3224 : MODIS_cloudIce(nPoints,nColumns,nLevels), &
3225 : MODIS_cloudSnow(nPoints,nColumns,nLevels), &
3226 : MODIS_waterSize(nPoints,nColumns,nLevels), &
3227 : MODIS_iceSize(nPoints,nColumns,nLevels), &
3228 : MODIS_snowSize(nPoints,nColumns,nLevels), &
3229 : MODIS_opticalThicknessLiq(nPoints,nColumns,nLevels), &
3230 : MODIS_opticalThicknessIce(nPoints,nColumns,nLevels), &
3231 : MODIS_opticalThicknessSnow(nPoints,nColumns,nLevels))
3232 :
3233 : ! Cloud water
3234 : call cosp_simulator_optics(nPoints,nColumns,nLevels,cospIN%frac_out, &
3235 : mr_hydro(:,:,:,I_CVCLIQ),mr_hydro(:,:,:,I_LSCLIQ),MODIS_cloudWater)
3236 : ! Cloud ice
3237 : call cosp_simulator_optics(nPoints,nColumns,nLevels,cospIN%frac_out, &
3238 : mr_hydro(:,:,:,I_CVCICE),mr_hydro(:,:,:,I_LSCICE),MODIS_cloudIce)
3239 : ! Cloud water droplet size
3240 : call cosp_simulator_optics(nPoints,nColumns,nLevels,cospIN%frac_out, &
3241 : Reff(:,:,:,I_CVCLIQ),Reff(:,:,:,I_LSCLIQ),MODIS_waterSize)
3242 : ! Cloud ice crystal size
3243 : call cosp_simulator_optics(nPoints,nColumns,nLevels,cospIN%frac_out, &
3244 : Reff(:,:,:,I_CVCICE),Reff(:,:,:,I_LSCICE),MODIS_iceSize)
3245 :
3246 : ! Cloud snow and size
3247 : MODIS_snowSize(:,:,:) = Reff(:,:,:,I_LSSNOW)
3248 : do j=1,nColumns
3249 : where((frac_prec(:,j,:) .eq. 1 .or. frac_prec(:,j,:) .eq. 3) .and. &
3250 : Reff(:,j,:,I_LSSNOW) .gt. 0._r8 .and. dtau_s_snow .gt. 0._r8)
3251 : MODIS_cloudSnow(:,j,:) = mr_hydro(:,j,:,I_LSSNOW)
3252 : MODIS_snowSize(:,j,:) = Reff(:,j,:,I_LSSNOW)
3253 : elsewhere
3254 : MODIS_snowSize(:,j,:) = 0._wp
3255 : MODIS_cloudSnow(:,j,:) = 0._wp
3256 : endwhere
3257 : enddo
3258 :
3259 : ! Partition optical thickness into liquid and ice parts
3260 : call modis_optics_partition(nPoints, nLevels, nColumns, MODIS_cloudWater, &
3261 : MODIS_cloudIce, MODIS_cloudSnow, MODIS_waterSize, MODIS_iceSize, &
3262 : MODIS_snowSize, cospIN%tau_067, MODIS_opticalThicknessLiq, &
3263 : MODIS_opticalThicknessIce, MODIS_opticalThicknessSnow)
3264 :
3265 : ! Compute asymmetry parameter and single scattering albedo
3266 : call modis_optics(nPoints, nLevels, nColumns, MODIS_opticalThicknessLiq, &
3267 : MODIS_waterSize*1.0e6_wp, MODIS_opticalThicknessIce, &
3268 : MODIS_iceSize*1.0e6_wp, MODIS_opticalThicknessSnow, &
3269 : MODIS_snowSize*1.0e6_wp, cospIN%fracLiq, cospIN%asym, cospIN%ss_alb)
3270 :
3271 : endif ! MODIS simulator optics
3272 : call t_stopf("modis_optics")
3273 :
3274 : end subroutine subsample_and_optics
3275 :
3276 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3277 : ! SUBROUTINE construct_cospIN
3278 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3279 : subroutine construct_cospIN(npoints,ncolumns,nlevels,y)
3280 : ! Inputs
3281 : integer,intent(in) :: &
3282 : npoints, & ! Number of horizontal gridpoints
3283 : ncolumns, & ! Number of subcolumns
3284 : nlevels ! Number of vertical levels
3285 : ! Outputs
3286 : type(cosp_optical_inputs),intent(out) :: y
3287 :
3288 : ! Dimensions
3289 : y%Npoints = Npoints
3290 : y%Ncolumns = Ncolumns
3291 : y%Nlevels = Nlevels
3292 : y%Npart = 4
3293 : y%Nrefl = PARASOL_NREFL
3294 :
3295 : allocate(y%tau_067( npoints, ncolumns, nlevels),&
3296 : y%emiss_11( npoints, ncolumns, nlevels),&
3297 : y%frac_out( npoints, ncolumns, nlevels),&
3298 : y%betatot_calipso( npoints, ncolumns, nlevels),&
3299 : y%betatot_ice_calipso(npoints, ncolumns, nlevels),&
3300 : y%fracLiq( npoints, ncolumns, nlevels),&
3301 : y%betatot_liq_calipso(npoints, ncolumns, nlevels),&
3302 : y%tautot_calipso( npoints, ncolumns, nlevels),&
3303 : y%tautot_ice_calipso( npoints, ncolumns, nlevels),&
3304 : y%tautot_liq_calipso( npoints, ncolumns, nlevels),&
3305 : y%z_vol_cloudsat( npoints, ncolumns, nlevels),&
3306 : y%kr_vol_cloudsat( npoints, ncolumns, nlevels),&
3307 : y%g_vol_cloudsat( npoints, ncolumns, nlevels),&
3308 : y%asym( npoints, ncolumns, nlevels),&
3309 : y%ss_alb( npoints, ncolumns, nlevels),&
3310 : y%beta_mol_calipso( npoints, nlevels),&
3311 : y%tau_mol_calipso( npoints, nlevels),&
3312 : y%tautot_S_ice( npoints, ncolumns ),&
3313 : y%tautot_S_liq( npoints, ncolumns) ,&
3314 : y%fracPrecipIce(npoints, ncolumns))
3315 : end subroutine construct_cospIN
3316 :
3317 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3318 : ! SUBROUTINE construct_cospstateIN
3319 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3320 : subroutine construct_cospstateIN(npoints,nlevels,nchan,y)
3321 : ! Inputs
3322 : integer,intent(in) :: &
3323 : npoints, & ! Number of horizontal gridpoints
3324 : nlevels, & ! Number of vertical levels
3325 : nchan ! Number of channels
3326 : ! Outputs
3327 : type(cosp_column_inputs),intent(out) :: y
3328 :
3329 : allocate(y%sunlit(npoints),y%skt(npoints),y%land(npoints),y%at(npoints,nlevels), &
3330 : y%pfull(npoints,nlevels),y%phalf(npoints,nlevels+1),y%qv(npoints,nlevels), &
3331 : y%o3(npoints,nlevels),y%hgt_matrix(npoints,nlevels),y%u_sfc(npoints), &
3332 : y%v_sfc(npoints),y%lat(npoints),y%lon(nPoints),y%emis_sfc(nchan), &
3333 : y%cloudIce(nPoints,nLevels),y%cloudLiq(nPoints,nLevels),y%surfelev(nPoints),&
3334 : y%fl_snow(nPoints,nLevels),y%fl_rain(nPoints,nLevels),y%seaice(npoints), &
3335 : y%tca(nPoints,nLevels),y%hgt_matrix_half(npoints,nlevels+1))
3336 :
3337 : end subroutine construct_cospstateIN
3338 : ! ######################################################################################
3339 : ! SUBROUTINE construct_cosp_outputs
3340 : !
3341 : ! This subroutine allocates output fields based on input logical flag switches.
3342 : ! ######################################################################################
3343 : subroutine construct_cosp_outputs(Npoints,Ncolumns,Nlevels,Nlvgrid,Nchan,x)
3344 : ! Inputs
3345 : integer,intent(in) :: &
3346 : Npoints, & ! Number of sampled points
3347 : Ncolumns, & ! Number of subgrid columns
3348 : Nlevels, & ! Number of model levels
3349 : Nlvgrid, & ! Number of levels in L3 stats computation
3350 : Nchan ! Number of RTTOV channels
3351 :
3352 : ! Outputs
3353 : type(cosp_outputs),intent(out) :: &
3354 : x ! COSP output structure
3355 :
3356 : ! ISCCP simulator outputs
3357 : if (lisccp_sim) then
3358 : allocate(x%isccp_boxtau(Npoints,Ncolumns))
3359 : allocate(x%isccp_boxptop(Npoints,Ncolumns))
3360 : allocate(x%isccp_fq(Npoints,numISCCPTauBins,numISCCPPresBins))
3361 : allocate(x%isccp_totalcldarea(Npoints))
3362 : allocate(x%isccp_meanptop(Npoints))
3363 : allocate(x%isccp_meantaucld(Npoints))
3364 : allocate(x%isccp_meantb(Npoints))
3365 : allocate(x%isccp_meantbclr(Npoints))
3366 : allocate(x%isccp_meanalbedocld(Npoints))
3367 : endif
3368 :
3369 : ! MISR simulator
3370 : if (lmisr_sim) then
3371 : allocate(x%misr_fq(Npoints,numMISRTauBins,numMISRHgtBins))
3372 : ! *NOTE* These 3 fields are not output, but were part of the v1.4.0 cosp_misr, so
3373 : ! they are still computed. Should probably have a logical to control these
3374 : ! outputs.
3375 : allocate(x%misr_dist_model_layertops(Npoints,numMISRHgtBins))
3376 : allocate(x%misr_meanztop(Npoints))
3377 : allocate(x%misr_cldarea(Npoints))
3378 : endif
3379 :
3380 : ! MODIS simulator
3381 : if (lmodis_sim) then
3382 : allocate(x%modis_Cloud_Fraction_Total_Mean(Npoints))
3383 : allocate(x%modis_Cloud_Fraction_Water_Mean(Npoints))
3384 : allocate(x%modis_Cloud_Fraction_Ice_Mean(Npoints))
3385 : allocate(x%modis_Cloud_Fraction_High_Mean(Npoints))
3386 : allocate(x%modis_Cloud_Fraction_Mid_Mean(Npoints))
3387 : allocate(x%modis_Cloud_Fraction_Low_Mean(Npoints))
3388 : allocate(x%modis_Optical_Thickness_Total_Mean(Npoints))
3389 : allocate(x%modis_Optical_Thickness_Water_Mean(Npoints))
3390 : allocate(x%modis_Optical_Thickness_Ice_Mean(Npoints))
3391 : allocate(x%modis_Optical_Thickness_Total_LogMean(Npoints))
3392 : allocate(x%modis_Optical_Thickness_Water_LogMean(Npoints))
3393 : allocate(x%modis_Optical_Thickness_Ice_LogMean(Npoints))
3394 : allocate(x%modis_Cloud_Particle_Size_Water_Mean(Npoints))
3395 : allocate(x%modis_Cloud_Particle_Size_Ice_Mean(Npoints))
3396 : allocate(x%modis_Cloud_Top_Pressure_Total_Mean(Npoints))
3397 : allocate(x%modis_Liquid_Water_Path_Mean(Npoints))
3398 : allocate(x%modis_Ice_Water_Path_Mean(Npoints))
3399 : allocate(x%modis_Optical_Thickness_vs_Cloud_Top_Pressure(nPoints,numModisTauBins,numMODISPresBins))
3400 : allocate(x%modis_Optical_thickness_vs_ReffLIQ(nPoints,numMODISTauBins,numMODISReffLiqBins))
3401 : allocate(x%modis_Optical_Thickness_vs_ReffICE(nPoints,numMODISTauBins,numMODISReffIceBins))
3402 : endif
3403 :
3404 : ! CALIPSO simulator
3405 : if (llidar_sim) then
3406 : allocate(x%calipso_beta_mol(Npoints,Nlevels))
3407 : allocate(x%calipso_beta_tot(Npoints,Ncolumns,Nlevels))
3408 : allocate(x%calipso_srbval(SR_BINS+1))
3409 : allocate(x%calipso_cfad_sr(Npoints,SR_BINS,Nlvgrid))
3410 : allocate(x%calipso_betaperp_tot(Npoints,Ncolumns,Nlevels))
3411 : allocate(x%calipso_lidarcld(Npoints,Nlvgrid))
3412 : allocate(x%calipso_cldlayer(Npoints,LIDAR_NCAT))
3413 : allocate(x%calipso_lidarcldphase(Npoints,Nlvgrid,6))
3414 : allocate(x%calipso_lidarcldtmp(Npoints,LIDAR_NTEMP,5))
3415 : allocate(x%calipso_cldlayerphase(Npoints,LIDAR_NCAT,6))
3416 : ! These 2 outputs are part of the calipso output type, but are not controlled by an
3417 : ! logical switch in the output namelist, so if all other fields are on, then allocate
3418 : allocate(x%calipso_tau_tot(Npoints,Ncolumns,Nlevels))
3419 : allocate(x%calipso_temp_tot(Npoints,Nlevels))
3420 : ! Calipso opaque cloud diagnostics
3421 : ! allocate(x%calipso_cldtype(Npoints,LIDAR_NTYPE))
3422 : ! allocate(x%calipso_cldtypetemp(Npoints,LIDAR_NTYPE))
3423 : ! allocate(x%calipso_cldtypemeanz(Npoints,2))
3424 : ! allocate(x%calipso_cldtypemeanzse(Npoints,3))
3425 : ! allocate(x%calipso_cldthinemis(Npoints))
3426 : ! allocate(x%calipso_lidarcldtype(Npoints,Nlvgrid,LIDAR_NTYPE+1))
3427 : endif
3428 :
3429 : ! PARASOL
3430 : if (lparasol_sim) then
3431 : allocate(x%parasolPix_refl(Npoints,Ncolumns,PARASOL_NREFL))
3432 : allocate(x%parasolGrid_refl(Npoints,PARASOL_NREFL))
3433 : endif
3434 :
3435 : ! Cloudsat simulator
3436 : if (lradar_sim) then
3437 : allocate(x%cloudsat_Ze_tot(Npoints,Ncolumns,Nlevels))
3438 : allocate(x%cloudsat_cfad_ze(Npoints,CLOUDSAT_DBZE_BINS,Nlvgrid))
3439 : allocate(x%lidar_only_freq_cloud(Npoints,Nlvgrid))
3440 : allocate(x%radar_lidar_tcc(Npoints))
3441 : allocate(x%cloudsat_precip_cover(Npoints,nCloudsatPrecipClass))
3442 : allocate(x%cloudsat_pia(Npoints))
3443 : endif
3444 :
3445 : end subroutine construct_cosp_outputs
3446 :
3447 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3448 : ! SUBROUTINE destroy_cospIN
3449 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3450 : subroutine destroy_cospIN(y)
3451 : type(cosp_optical_inputs),intent(inout) :: y
3452 :
3453 : if (allocated(y%tau_067)) deallocate(y%tau_067)
3454 : if (allocated(y%emiss_11)) deallocate(y%emiss_11)
3455 : if (allocated(y%frac_out)) deallocate(y%frac_out)
3456 : if (allocated(y%beta_mol_calipso)) deallocate(y%beta_mol_calipso)
3457 : if (allocated(y%tau_mol_calipso)) deallocate(y%tau_mol_calipso)
3458 : if (allocated(y%betatot_calipso)) deallocate(y%betatot_calipso)
3459 : if (allocated(y%betatot_ice_calipso)) deallocate(y%betatot_ice_calipso)
3460 : if (allocated(y%betatot_liq_calipso)) deallocate(y%betatot_liq_calipso)
3461 : if (allocated(y%tautot_calipso)) deallocate(y%tautot_calipso)
3462 : if (allocated(y%tautot_ice_calipso)) deallocate(y%tautot_ice_calipso)
3463 : if (allocated(y%tautot_liq_calipso)) deallocate(y%tautot_liq_calipso)
3464 : if (allocated(y%tautot_S_liq)) deallocate(y%tautot_S_liq)
3465 : if (allocated(y%tautot_S_ice)) deallocate(y%tautot_S_ice)
3466 : if (allocated(y%z_vol_cloudsat)) deallocate(y%z_vol_cloudsat)
3467 : if (allocated(y%kr_vol_cloudsat)) deallocate(y%kr_vol_cloudsat)
3468 : if (allocated(y%g_vol_cloudsat)) deallocate(y%g_vol_cloudsat)
3469 : if (allocated(y%asym)) deallocate(y%asym)
3470 : if (allocated(y%ss_alb)) deallocate(y%ss_alb)
3471 : if (allocated(y%fracLiq)) deallocate(y%fracLiq)
3472 : if (allocated(y%fracPrecipIce)) deallocate(y%fracPrecipIce)
3473 : end subroutine destroy_cospIN
3474 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3475 : ! SUBROUTINE destroy_cospstateIN
3476 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3477 : subroutine destroy_cospstateIN(y)
3478 : type(cosp_column_inputs),intent(inout) :: y
3479 :
3480 : if (allocated(y%surfelev)) deallocate(y%surfelev)
3481 : if (allocated(y%sunlit)) deallocate(y%sunlit)
3482 : if (allocated(y%skt)) deallocate(y%skt)
3483 : if (allocated(y%land)) deallocate(y%land)
3484 : if (allocated(y%at)) deallocate(y%at)
3485 : if (allocated(y%pfull)) deallocate(y%pfull)
3486 : if (allocated(y%phalf)) deallocate(y%phalf)
3487 : if (allocated(y%qv)) deallocate(y%qv)
3488 : if (allocated(y%o3)) deallocate(y%o3)
3489 : if (allocated(y%hgt_matrix)) deallocate(y%hgt_matrix)
3490 : if (allocated(y%u_sfc)) deallocate(y%u_sfc)
3491 : if (allocated(y%v_sfc)) deallocate(y%v_sfc)
3492 : if (allocated(y%lat)) deallocate(y%lat)
3493 : if (allocated(y%lon)) deallocate(y%lon)
3494 : if (allocated(y%emis_sfc)) deallocate(y%emis_sfc)
3495 : if (allocated(y%cloudIce)) deallocate(y%cloudIce)
3496 : if (allocated(y%cloudLiq)) deallocate(y%cloudLiq)
3497 : if (allocated(y%seaice)) deallocate(y%seaice)
3498 : if (allocated(y%fl_rain)) deallocate(y%fl_rain)
3499 : if (allocated(y%fl_snow)) deallocate(y%fl_snow)
3500 : if (allocated(y%tca)) deallocate(y%tca)
3501 : if (allocated(y%hgt_matrix_half)) deallocate(y%hgt_matrix_half)
3502 :
3503 : end subroutine destroy_cospstateIN
3504 :
3505 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3506 : ! SUBROUTINE destroy_cosp_outputs
3507 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3508 : subroutine destroy_cosp_outputs(y)
3509 : type(cosp_outputs),intent(inout) :: y
3510 :
3511 : ! Deallocate and nullify
3512 : if (associated(y%calipso_beta_mol)) then
3513 : deallocate(y%calipso_beta_mol)
3514 : nullify(y%calipso_beta_mol)
3515 : endif
3516 : if (associated(y%calipso_temp_tot)) then
3517 : deallocate(y%calipso_temp_tot)
3518 : nullify(y%calipso_temp_tot)
3519 : endif
3520 : if (associated(y%calipso_betaperp_tot)) then
3521 : deallocate(y%calipso_betaperp_tot)
3522 : nullify(y%calipso_betaperp_tot)
3523 : endif
3524 : if (associated(y%calipso_beta_tot)) then
3525 : deallocate(y%calipso_beta_tot)
3526 : nullify(y%calipso_beta_tot)
3527 : endif
3528 : if (associated(y%calipso_tau_tot)) then
3529 : deallocate(y%calipso_tau_tot)
3530 : nullify(y%calipso_tau_tot)
3531 : endif
3532 : if (associated(y%calipso_lidarcldphase)) then
3533 : deallocate(y%calipso_lidarcldphase)
3534 : nullify(y%calipso_lidarcldphase)
3535 : endif
3536 : if (associated(y%calipso_cldlayerphase)) then
3537 : deallocate(y%calipso_cldlayerphase)
3538 : nullify(y%calipso_cldlayerphase)
3539 : endif
3540 : if (associated(y%calipso_lidarcldtmp)) then
3541 : deallocate(y%calipso_lidarcldtmp)
3542 : nullify(y%calipso_lidarcldtmp)
3543 : endif
3544 : if (associated(y%calipso_cldlayer)) then
3545 : deallocate(y%calipso_cldlayer)
3546 : nullify(y%calipso_cldlayer)
3547 : endif
3548 : if (associated(y%calipso_lidarcld)) then
3549 : deallocate(y%calipso_lidarcld)
3550 : nullify(y%calipso_lidarcld)
3551 : endif
3552 : if (associated(y%calipso_srbval)) then
3553 : deallocate(y%calipso_srbval)
3554 : nullify(y%calipso_srbval)
3555 : endif
3556 : if (associated(y%calipso_cfad_sr)) then
3557 : deallocate(y%calipso_cfad_sr)
3558 : nullify(y%calipso_cfad_sr)
3559 : endif
3560 : if (associated(y%parasolPix_refl)) then
3561 : deallocate(y%parasolPix_refl)
3562 : nullify(y%parasolPix_refl)
3563 : endif
3564 : if (associated(y%parasolGrid_refl)) then
3565 : deallocate(y%parasolGrid_refl)
3566 : nullify(y%parasolGrid_refl)
3567 : endif
3568 : if (associated(y%cloudsat_Ze_tot)) then
3569 : deallocate(y%cloudsat_Ze_tot)
3570 : nullify(y%cloudsat_Ze_tot)
3571 : endif
3572 : if (associated(y%cloudsat_precip_cover)) then
3573 : deallocate(y%cloudsat_precip_cover)
3574 : nullify(y%cloudsat_precip_cover)
3575 : endif
3576 : if (associated(y%cloudsat_pia)) then
3577 : deallocate(y%cloudsat_pia)
3578 : nullify(y%cloudsat_pia)
3579 : endif
3580 : if (associated(y%cloudsat_cfad_ze)) then
3581 : deallocate(y%cloudsat_cfad_ze)
3582 : nullify(y%cloudsat_cfad_ze)
3583 : endif
3584 : if (associated(y%radar_lidar_tcc)) then
3585 : deallocate(y%radar_lidar_tcc)
3586 : nullify(y%radar_lidar_tcc)
3587 : endif
3588 : if (associated(y%lidar_only_freq_cloud)) then
3589 : deallocate(y%lidar_only_freq_cloud)
3590 : nullify(y%lidar_only_freq_cloud)
3591 : endif
3592 : if (associated(y%isccp_totalcldarea)) then
3593 : deallocate(y%isccp_totalcldarea)
3594 : nullify(y%isccp_totalcldarea)
3595 : endif
3596 : if (associated(y%isccp_meantb)) then
3597 : deallocate(y%isccp_meantb)
3598 : nullify(y%isccp_meantb)
3599 : endif
3600 : if (associated(y%isccp_meantbclr)) then
3601 : deallocate(y%isccp_meantbclr)
3602 : nullify(y%isccp_meantbclr)
3603 : endif
3604 : if (associated(y%isccp_meanptop)) then
3605 : deallocate(y%isccp_meanptop)
3606 : nullify(y%isccp_meanptop)
3607 : endif
3608 : if (associated(y%isccp_meantaucld)) then
3609 : deallocate(y%isccp_meantaucld)
3610 : nullify(y%isccp_meantaucld)
3611 : endif
3612 : if (associated(y%isccp_meanalbedocld)) then
3613 : deallocate(y%isccp_meanalbedocld)
3614 : nullify(y%isccp_meanalbedocld)
3615 : endif
3616 : if (associated(y%isccp_boxtau)) then
3617 : deallocate(y%isccp_boxtau)
3618 : nullify(y%isccp_boxtau)
3619 : endif
3620 : if (associated(y%isccp_boxptop)) then
3621 : deallocate(y%isccp_boxptop)
3622 : nullify(y%isccp_boxptop)
3623 : endif
3624 : if (associated(y%isccp_fq)) then
3625 : deallocate(y%isccp_fq)
3626 : nullify(y%isccp_fq)
3627 : endif
3628 : if (associated(y%misr_fq)) then
3629 : deallocate(y%misr_fq)
3630 : nullify(y%misr_fq)
3631 : endif
3632 : if (associated(y%misr_dist_model_layertops)) then
3633 : deallocate(y%misr_dist_model_layertops)
3634 : nullify(y%misr_dist_model_layertops)
3635 : endif
3636 : if (associated(y%misr_meanztop)) then
3637 : deallocate(y%misr_meanztop)
3638 : nullify(y%misr_meanztop)
3639 : endif
3640 : if (associated(y%misr_cldarea)) then
3641 : deallocate(y%misr_cldarea)
3642 : nullify(y%misr_cldarea)
3643 : endif
3644 : if (associated(y%rttov_tbs)) then
3645 : deallocate(y%rttov_tbs)
3646 : nullify(y%rttov_tbs)
3647 : endif
3648 : if (associated(y%modis_Cloud_Fraction_Total_Mean)) then
3649 : deallocate(y%modis_Cloud_Fraction_Total_Mean)
3650 : nullify(y%modis_Cloud_Fraction_Total_Mean)
3651 : endif
3652 : if (associated(y%modis_Cloud_Fraction_Ice_Mean)) then
3653 : deallocate(y%modis_Cloud_Fraction_Ice_Mean)
3654 : nullify(y%modis_Cloud_Fraction_Ice_Mean)
3655 : endif
3656 : if (associated(y%modis_Cloud_Fraction_Water_Mean)) then
3657 : deallocate(y%modis_Cloud_Fraction_Water_Mean)
3658 : nullify(y%modis_Cloud_Fraction_Water_Mean)
3659 : endif
3660 : if (associated(y%modis_Cloud_Fraction_High_Mean)) then
3661 : deallocate(y%modis_Cloud_Fraction_High_Mean)
3662 : nullify(y%modis_Cloud_Fraction_High_Mean)
3663 : endif
3664 : if (associated(y%modis_Cloud_Fraction_Mid_Mean)) then
3665 : deallocate(y%modis_Cloud_Fraction_Mid_Mean)
3666 : nullify(y%modis_Cloud_Fraction_Mid_Mean)
3667 : endif
3668 : if (associated(y%modis_Cloud_Fraction_Low_Mean)) then
3669 : deallocate(y%modis_Cloud_Fraction_Low_Mean)
3670 : nullify(y%modis_Cloud_Fraction_Low_Mean)
3671 : endif
3672 : if (associated(y%modis_Optical_Thickness_Total_Mean)) then
3673 : deallocate(y%modis_Optical_Thickness_Total_Mean)
3674 : nullify(y%modis_Optical_Thickness_Total_Mean)
3675 : endif
3676 : if (associated(y%modis_Optical_Thickness_Water_Mean)) then
3677 : deallocate(y%modis_Optical_Thickness_Water_Mean)
3678 : nullify(y%modis_Optical_Thickness_Water_Mean)
3679 : endif
3680 : if (associated(y%modis_Optical_Thickness_Ice_Mean)) then
3681 : deallocate(y%modis_Optical_Thickness_Ice_Mean)
3682 : nullify(y%modis_Optical_Thickness_Ice_Mean)
3683 : endif
3684 : if (associated(y%modis_Optical_Thickness_Total_LogMean)) then
3685 : deallocate(y%modis_Optical_Thickness_Total_LogMean)
3686 : nullify(y%modis_Optical_Thickness_Total_LogMean)
3687 : endif
3688 : if (associated(y%modis_Optical_Thickness_Water_LogMean)) then
3689 : deallocate(y%modis_Optical_Thickness_Water_LogMean)
3690 : nullify(y%modis_Optical_Thickness_Water_LogMean)
3691 : endif
3692 : if (associated(y%modis_Optical_Thickness_Ice_LogMean)) then
3693 : deallocate(y%modis_Optical_Thickness_Ice_LogMean)
3694 : nullify(y%modis_Optical_Thickness_Ice_LogMean)
3695 : endif
3696 : if (associated(y%modis_Cloud_Particle_Size_Water_Mean)) then
3697 : deallocate(y%modis_Cloud_Particle_Size_Water_Mean)
3698 : nullify(y%modis_Cloud_Particle_Size_Water_Mean)
3699 : endif
3700 : if (associated(y%modis_Cloud_Particle_Size_Ice_Mean)) then
3701 : deallocate(y%modis_Cloud_Particle_Size_Ice_Mean)
3702 : nullify(y%modis_Cloud_Particle_Size_Ice_Mean)
3703 : endif
3704 : if (associated(y%modis_Cloud_Top_Pressure_Total_Mean)) then
3705 : deallocate(y%modis_Cloud_Top_Pressure_Total_Mean)
3706 : nullify(y%modis_Cloud_Top_Pressure_Total_Mean)
3707 : endif
3708 : if (associated(y%modis_Liquid_Water_Path_Mean)) then
3709 : deallocate(y%modis_Liquid_Water_Path_Mean)
3710 : nullify(y%modis_Liquid_Water_Path_Mean)
3711 : endif
3712 : if (associated(y%modis_Ice_Water_Path_Mean)) then
3713 : deallocate(y%modis_Ice_Water_Path_Mean)
3714 : nullify(y%modis_Ice_Water_Path_Mean)
3715 : endif
3716 : if (associated(y%modis_Optical_Thickness_vs_Cloud_Top_Pressure)) then
3717 : deallocate(y%modis_Optical_Thickness_vs_Cloud_Top_Pressure)
3718 : nullify(y%modis_Optical_Thickness_vs_Cloud_Top_Pressure)
3719 : endif
3720 : if (associated(y%modis_Optical_thickness_vs_ReffLIQ)) then
3721 : deallocate(y%modis_Optical_thickness_vs_ReffLIQ)
3722 : nullify(y%modis_Optical_thickness_vs_ReffLIQ)
3723 : endif
3724 : if (associated(y%modis_Optical_thickness_vs_ReffICE)) then
3725 : deallocate(y%modis_Optical_thickness_vs_ReffICE)
3726 : nullify(y%modis_Optical_thickness_vs_ReffICE)
3727 : endif
3728 : if (associated(y%calipso_cldtype)) then
3729 : deallocate(y%calipso_cldtype)
3730 : nullify(y%calipso_cldtype)
3731 : endif
3732 : if (associated(y%calipso_cldtypetemp)) then
3733 : deallocate(y%calipso_cldtypetemp)
3734 : nullify(y%calipso_cldtypetemp)
3735 : endif
3736 : if (associated(y%calipso_cldtypemeanz)) then
3737 : deallocate(y%calipso_cldtypemeanz)
3738 : nullify(y%calipso_cldtypemeanz)
3739 : endif
3740 : if (associated(y%calipso_cldtypemeanzse)) then
3741 : deallocate(y%calipso_cldtypemeanzse)
3742 : nullify(y%calipso_cldtypemeanzse)
3743 : endif
3744 : if (associated(y%calipso_cldthinemis)) then
3745 : deallocate(y%calipso_cldthinemis)
3746 : nullify(y%calipso_cldthinemis)
3747 : endif
3748 : if (associated(y%calipso_lidarcldtype)) then
3749 : deallocate(y%calipso_lidarcldtype)
3750 : nullify(y%calipso_lidarcldtype)
3751 : endif
3752 :
3753 : end subroutine destroy_cosp_outputs
3754 : #endif
3755 :
3756 : !#######################################################################
3757 : end module cospsimulator_intr
|
