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