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