1 2! KGEN-generated Fortran source file 3! 4! Filename : micro_mg_cam.F90 5! Generated at: 2015-03-31 09:44:40 6! KGEN version: 0.4.5 7 8 9 10 MODULE micro_mg_cam 11 !--------------------------------------------------------------------------------- 12 ! 13 ! 1 Interfaces for MG microphysics 14 ! 15 !--------------------------------------------------------------------------------- 16 ! 17 ! How to add new packed MG inputs to micro_mg_cam_tend: 18 ! 19 ! If you have an input with first dimension [psetcols, pver], the procedure 20 ! for adding inputs is as follows: 21 ! 22 ! 1) In addition to any variables you need to declare for the "unpacked" 23 ! (1 format) version, you must declare an allocatable or pointer array 24 ! for the "packed" (MG format) version. 25 ! 26 ! 2) After micro_mg_get_cols is called, allocate the "packed" array with 27 ! size [mgncol, nlev]. 28 ! 29 ! 3) Add a call similar to the following line (look before the 30 ! micro_mg_tend calls to see similar lines): 31 ! 32 ! packed_array = packer%pack(original_array) 33 ! 34 ! The packed array can then be passed into any of the MG schemes. 35 ! 36 ! This same procedure will also work for 1D arrays of size psetcols, 3-D 37 ! arrays with psetcols and pver as the first dimensions, and for arrays of 38 ! dimension [psetcols, pverp]. You only have to modify the allocation of 39 ! the packed array before the "pack" call. 40 ! 41 !--------------------------------------------------------------------------------- 42 ! 43 ! How to add new packed MG outputs to micro_mg_cam_tend: 44 ! 45 ! 1) As with inputs, in addition to the unpacked outputs you must declare 46 ! an allocatable or pointer array for packed data. The unpacked and 47 ! packed arrays must *also* be targets or pointers (but cannot be both). 48 ! 49 ! 2) Again as for inputs, allocate the packed array using mgncol and nlev, 50 ! which are set in micro_mg_get_cols. 51 ! 52 ! 3) Add the field to post-processing as in the following line (again, 53 ! there are many examples before the micro_mg_tend calls): 54 ! 55 ! call post_proc%add_field(p(final_array),p(packed_array)) 56 ! 57 ! This registers the field for post-MG averaging, and to scatter to the 58 ! final, unpacked version of the array. 59 ! 60 ! By default, any columns/levels that are not operated on by MG will be 61 ! set to 0 on output; this value can be adjusted using the "fillvalue" 62 ! optional argument to post_proc%add_field. 63 ! 64 ! Also by default, outputs from multiple substeps will be averaged after 65 ! MG's substepping is complete. Passing the optional argument 66 ! "accum_method=accum_null" will change this behavior so that the last 67 ! substep is always output. 68 ! 69 ! This procedure works on 1-D and 2-D outputs. Note that the final, 70 ! unpacked arrays are not set until the call to 71 ! "post_proc%process_and_unpack", which sets every single field that was 72 ! added with post_proc%add_field. 73 ! 74 !--------------------------------------------------------------------------------- 75 USE shr_kind_mod, ONLY: r8 => shr_kind_r8 76 IMPLICIT NONE 77 PRIVATE 78 PUBLIC kgen_read_externs_micro_mg_cam 79 INTEGER, PARAMETER :: kgen_dp = selected_real_kind(15, 307) 80 PUBLIC micro_mg_cam_tend 81 type, public :: check_t 82 logical :: Passed 83 integer :: numFatal 84 integer :: numTotal 85 integer :: numIdentical 86 integer :: numWarning 87 integer :: VerboseLevel 88 real(kind=kgen_dp) :: tolerance 89 real(kind=kgen_dp) :: minvalue 90 end type check_t 91 ! Version number for MG. 92 ! Second part of version number. 93 ! type of precipitation fraction method 94 ! berg efficiency factor 95 ! Prognose cldliq flag 96 ! Prognose cldice flag 97 INTEGER :: num_steps ! Number of MG substeps 98 ! Number of constituents 99 ! Constituent names 100 ! cloud liquid amount index 101 ! cloud ice amount index 102 ! cloud liquid number index 103 ! cloud ice water index 104 ! rain index 105 ! snow index 106 ! rain number index 107 ! snow number index 108 ! Physics buffer indices for fields registered by this module 109 ! Fields for UNICON 110 ! Evaporation area of stratiform precipitation 111 ! Evaporation rate of stratiform rain [kg/kg/s]. >= 0. 112 ! Evaporation rate of stratiform snow [kg/kg/s]. >= 0. 113 ! Fields needed as inputs to COSP 114 ! Fields needed by Park macrophysics 115 ! Used to replace aspects of MG microphysics 116 ! (e.g. by CARMA) 117 ! Index fields for precipitation efficiency. 118 ! Physics buffer indices for fields registered by other modules 119 ! Pbuf fields needed for subcol_SILHS 120 ! pbuf fields for heterogeneous freezing 121 122 !=============================================================================== 123 CONTAINS 124 125 ! write subroutines 126 ! No subroutines 127 128 ! module extern variables 129 130 SUBROUTINE kgen_read_externs_micro_mg_cam(kgen_unit) 131 INTEGER, INTENT(IN) :: kgen_unit 132 READ(UNIT=kgen_unit) num_steps 133 END SUBROUTINE kgen_read_externs_micro_mg_cam 134 135 subroutine kgen_init_check(check, tolerance, minvalue) 136 type(check_t), intent(inout) :: check 137 real(kind=kgen_dp), intent(in), optional :: tolerance 138 real(kind=kgen_dp), intent(in), optional :: minvalue 139 140 check%Passed = .TRUE. 141 check%numFatal = 0 142 check%numWarning = 0 143 check%numTotal = 0 144 check%numIdentical = 0 145 check%VerboseLevel = 1 146 if(present(tolerance)) then 147 check%tolerance = tolerance 148 else 149 check%tolerance = 1.E-14 150 endif 151 if(present(minvalue)) then 152 check%minvalue = minvalue 153 else 154 check%minvalue = 1.0D-15 155 endif 156 end subroutine kgen_init_check 157 subroutine kgen_print_check(kname, check) 158 character(len=*) :: kname 159 type(check_t), intent(in) :: check 160 write (*,*) 161 write (*,*) TRIM(kname),' KGENPrtCheck: Tolerance for normalized RMS: ',check%tolerance 162 write (*,*) TRIM(kname),' KGENPrtCheck: Number of variables checked: ',check%numTotal 163 write (*,*) TRIM(kname),' KGENPrtCheck: Number of Identical results: ',check%numIdentical 164 write (*,*) TRIM(kname),' KGENPrtCheck: Number of warnings detected: ',check%numWarning 165 write (*,*) TRIM(kname),' KGENPrtCheck: Number of fatal errors detected: ', check%numFatal 166 if (check%numFatal> 0) then 167 write(*,*) TRIM(kname),' KGENPrtCheck: verification FAILED' 168 else 169 write(*,*) TRIM(kname),' KGENPrtCheck: verification PASSED' 170 endif 171 end subroutine kgen_print_check 172 !=============================================================================== 173 174 175 !================================================================================================ 176 177 !=============================================================================== 178 179 !=============================================================================== 180 181 !=============================================================================== 182 183 !=============================================================================== 184 185 SUBROUTINE micro_mg_cam_tend(dtime, kgen_unit) 186 USE micro_mg2_0, ONLY: micro_mg_tend2_0 => micro_mg_tend 187 integer, intent(in) :: kgen_unit 188 INTEGER*8 :: kgen_intvar, start_clock, stop_clock, rate_clock 189 TYPE(check_t):: check_status 190 REAL(KIND=kgen_dp) :: tolerance 191 REAL(KIND=r8), intent(in) :: dtime 192 ! Local variables 193 ! ice nucleation number 194 ! ice nucleation number (homogeneous) 195 ! liquid activation number tendency 196 ! Evaporation area of stratiform precipitation. 0<= am_evp_st <=1. 197 ! Evaporation rate of stratiform rain [kg/kg/s] 198 ! Evaporation rate of stratiform snow [kg/kg/s] 199 ! [Total] Sfc flux of precip from stratiform [ m/s ] 200 ! [Total] Sfc flux of snow from stratiform [ m/s ] 201 ! Surface flux of total cloud water from sedimentation 202 ! Surface flux of cloud ice from sedimentation 203 ! Sfc flux of precip from microphysics [ m/s ] 204 ! Sfc flux of snow from microphysics [ m/s ] 205 ! Relative humidity cloud fraction 206 ! Old cloud fraction 207 ! Evaporation of total precipitation (rain + snow) 208 ! precipitation evaporation rate 209 ! relative variance of cloud water 210 ! optional accretion enhancement for experimentation 211 ! Total precipitation (rain + snow) 212 ! Ice effective diameter (meters) (AG: microns?) 213 ! Size distribution shape parameter for radiation 214 ! Size distribution slope parameter for radiation 215 ! Snow effective diameter (m) 216 ! array to hold rate1ord_cw2pr_st from microphysics 217 ! Area over which precip evaporates 218 ! Local evaporation of snow 219 ! Local production of snow 220 ! Rate of cond-evap of ice within the cloud 221 ! Snow mixing ratio 222 ! grid-box average rain flux (kg m^-2 s^-1) 223 ! grid-box average snow flux (kg m^-2 s^-1) 224 ! Rain mixing ratio 225 ! Evaporation of falling cloud water 226 ! Sublimation of falling cloud ice 227 ! Residual condensation term to remove excess saturation 228 ! Deposition/sublimation rate of cloud ice 229 ! Mass-weighted cloud water fallspeed 230 ! Mass-weighted cloud ice fallspeed 231 ! Mass-weighted rain fallspeed 232 ! Mass-weighted snow fallspeed 233 ! Cloud water mixing ratio tendency from sedimentation 234 ! Cloud ice mixing ratio tendency from sedimentation 235 ! Rain mixing ratio tendency from sedimentation 236 ! Snow mixing ratio tendency from sedimentation 237 ! analytic radar reflectivity 238 ! average reflectivity will zero points outside valid range 239 ! average reflectivity in z. 240 ! cloudsat reflectivity 241 ! cloudsat average 242 ! effective radius calculation for rain + cloud 243 ! output number conc of ice nuclei available (1/m3) 244 ! output number conc of CCN (1/m3) 245 ! qc limiter ratio (1=no limit) 246 ! Object that packs columns with clouds/precip. 247 ! Packed versions of inputs. 248 REAL(KIND=r8), allocatable :: packed_t(:,:) 249 REAL(KIND=r8), allocatable :: packed_q(:,:) 250 REAL(KIND=r8), allocatable :: packed_qc(:,:) 251 REAL(KIND=r8), allocatable :: packed_nc(:,:) 252 REAL(KIND=r8), allocatable :: packed_qi(:,:) 253 REAL(KIND=r8), allocatable :: packed_ni(:,:) 254 REAL(KIND=r8), allocatable :: packed_qr(:,:) 255 REAL(KIND=r8), allocatable :: packed_nr(:,:) 256 REAL(KIND=r8), allocatable :: packed_qs(:,:) 257 REAL(KIND=r8), allocatable :: packed_ns(:,:) 258 REAL(KIND=r8), allocatable :: packed_relvar(:,:) 259 REAL(KIND=r8), allocatable :: packed_accre_enhan(:,:) 260 REAL(KIND=r8), allocatable :: packed_p(:,:) 261 REAL(KIND=r8), allocatable :: packed_pdel(:,:) 262 ! This is only needed for MG1.5, and can be removed when support for 263 ! that version is dropped. 264 REAL(KIND=r8), allocatable :: packed_cldn(:,:) 265 REAL(KIND=r8), allocatable :: packed_liqcldf(:,:) 266 REAL(KIND=r8), allocatable :: packed_icecldf(:,:) 267 REAL(KIND=r8), allocatable :: packed_naai(:,:) 268 REAL(KIND=r8), allocatable :: packed_npccn(:,:) 269 REAL(KIND=r8), allocatable :: packed_rndst(:,:,:) 270 REAL(KIND=r8), allocatable :: packed_nacon(:,:,:) 271 ! Optional outputs. 272 REAL(KIND=r8), pointer :: packed_tnd_qsnow(:,:) 273 REAL(KIND=r8), pointer :: packed_tnd_nsnow(:,:) 274 REAL(KIND=r8), pointer :: packed_re_ice(:,:) 275 REAL(KIND=r8), pointer :: packed_frzimm(:,:) 276 REAL(KIND=r8), pointer :: packed_frzcnt(:,:) 277 REAL(KIND=r8), pointer :: packed_frzdep(:,:) 278 ! Output field post-processing. 279 ! Packed versions of outputs. 280 REAL(KIND=r8), allocatable, target :: packed_rate1ord_cw2pr_st(:,:) 281 REAL(KIND=r8), allocatable, target :: ref_packed_rate1ord_cw2pr_st(:,:) 282 REAL(KIND=r8), allocatable, target :: packed_tlat(:,:) 283 REAL(KIND=r8), allocatable, target :: ref_packed_tlat(:,:) 284 REAL(KIND=r8), allocatable, target :: packed_qvlat(:,:) 285 REAL(KIND=r8), allocatable, target :: ref_packed_qvlat(:,:) 286 REAL(KIND=r8), allocatable, target :: packed_qctend(:,:) 287 REAL(KIND=r8), allocatable, target :: ref_packed_qctend(:,:) 288 REAL(KIND=r8), allocatable, target :: packed_qitend(:,:) 289 REAL(KIND=r8), allocatable, target :: ref_packed_qitend(:,:) 290 REAL(KIND=r8), allocatable, target :: packed_nctend(:,:) 291 REAL(KIND=r8), allocatable, target :: ref_packed_nctend(:,:) 292 REAL(KIND=r8), allocatable, target :: packed_nitend(:,:) 293 REAL(KIND=r8), allocatable, target :: ref_packed_nitend(:,:) 294 REAL(KIND=r8), allocatable, target :: packed_qrtend(:,:) 295 REAL(KIND=r8), allocatable, target :: ref_packed_qrtend(:,:) 296 REAL(KIND=r8), allocatable, target :: packed_qstend(:,:) 297 REAL(KIND=r8), allocatable, target :: ref_packed_qstend(:,:) 298 REAL(KIND=r8), allocatable, target :: packed_nrtend(:,:) 299 REAL(KIND=r8), allocatable, target :: ref_packed_nrtend(:,:) 300 REAL(KIND=r8), allocatable, target :: packed_nstend(:,:) 301 REAL(KIND=r8), allocatable, target :: ref_packed_nstend(:,:) 302 REAL(KIND=r8), allocatable, target :: packed_prect(:) 303 REAL(KIND=r8), allocatable, target :: ref_packed_prect(:) 304 REAL(KIND=r8), allocatable, target :: packed_preci(:) 305 REAL(KIND=r8), allocatable, target :: ref_packed_preci(:) 306 REAL(KIND=r8), allocatable, target :: packed_nevapr(:,:) 307 REAL(KIND=r8), allocatable, target :: ref_packed_nevapr(:,:) 308 REAL(KIND=r8), allocatable, target :: packed_evapsnow(:,:) 309 REAL(KIND=r8), allocatable, target :: ref_packed_evapsnow(:,:) 310 REAL(KIND=r8), allocatable, target :: packed_prain(:,:) 311 REAL(KIND=r8), allocatable, target :: ref_packed_prain(:,:) 312 REAL(KIND=r8), allocatable, target :: packed_prodsnow(:,:) 313 REAL(KIND=r8), allocatable, target :: ref_packed_prodsnow(:,:) 314 REAL(KIND=r8), allocatable, target :: packed_cmeout(:,:) 315 REAL(KIND=r8), allocatable, target :: ref_packed_cmeout(:,:) 316 REAL(KIND=r8), allocatable, target :: packed_qsout(:,:) 317 REAL(KIND=r8), allocatable, target :: ref_packed_qsout(:,:) 318 REAL(KIND=r8), allocatable, target :: packed_rflx(:,:) 319 REAL(KIND=r8), allocatable, target :: ref_packed_rflx(:,:) 320 REAL(KIND=r8), allocatable, target :: packed_sflx(:,:) 321 REAL(KIND=r8), allocatable, target :: ref_packed_sflx(:,:) 322 REAL(KIND=r8), allocatable, target :: packed_qrout(:,:) 323 REAL(KIND=r8), allocatable, target :: ref_packed_qrout(:,:) 324 REAL(KIND=r8), allocatable, target :: packed_qcsevap(:,:) 325 REAL(KIND=r8), allocatable, target :: ref_packed_qcsevap(:,:) 326 REAL(KIND=r8), allocatable, target :: packed_qisevap(:,:) 327 REAL(KIND=r8), allocatable, target :: ref_packed_qisevap(:,:) 328 REAL(KIND=r8), allocatable, target :: packed_qvres(:,:) 329 REAL(KIND=r8), allocatable, target :: ref_packed_qvres(:,:) 330 REAL(KIND=r8), allocatable, target :: packed_cmei(:,:) 331 REAL(KIND=r8), allocatable, target :: ref_packed_cmei(:,:) 332 REAL(KIND=r8), allocatable, target :: packed_vtrmc(:,:) 333 REAL(KIND=r8), allocatable, target :: ref_packed_vtrmc(:,:) 334 REAL(KIND=r8), allocatable, target :: packed_vtrmi(:,:) 335 REAL(KIND=r8), allocatable, target :: ref_packed_vtrmi(:,:) 336 REAL(KIND=r8), allocatable, target :: packed_qcsedten(:,:) 337 REAL(KIND=r8), allocatable, target :: ref_packed_qcsedten(:,:) 338 REAL(KIND=r8), allocatable, target :: packed_qisedten(:,:) 339 REAL(KIND=r8), allocatable, target :: ref_packed_qisedten(:,:) 340 REAL(KIND=r8), allocatable, target :: packed_qrsedten(:,:) 341 REAL(KIND=r8), allocatable, target :: ref_packed_qrsedten(:,:) 342 REAL(KIND=r8), allocatable, target :: packed_qssedten(:,:) 343 REAL(KIND=r8), allocatable, target :: ref_packed_qssedten(:,:) 344 REAL(KIND=r8), allocatable, target :: packed_umr(:,:) 345 REAL(KIND=r8), allocatable, target :: ref_packed_umr(:,:) 346 REAL(KIND=r8), allocatable, target :: packed_ums(:,:) 347 REAL(KIND=r8), allocatable, target :: ref_packed_ums(:,:) 348 REAL(KIND=r8), allocatable, target :: packed_pra(:,:) 349 REAL(KIND=r8), allocatable, target :: ref_packed_pra(:,:) 350 REAL(KIND=r8), allocatable, target :: packed_prc(:,:) 351 REAL(KIND=r8), allocatable, target :: ref_packed_prc(:,:) 352 REAL(KIND=r8), allocatable, target :: packed_mnuccc(:,:) 353 REAL(KIND=r8), allocatable, target :: ref_packed_mnuccc(:,:) 354 REAL(KIND=r8), allocatable, target :: packed_mnucct(:,:) 355 REAL(KIND=r8), allocatable, target :: ref_packed_mnucct(:,:) 356 REAL(KIND=r8), allocatable, target :: packed_msacwi(:,:) 357 REAL(KIND=r8), allocatable, target :: ref_packed_msacwi(:,:) 358 REAL(KIND=r8), allocatable, target :: packed_psacws(:,:) 359 REAL(KIND=r8), allocatable, target :: ref_packed_psacws(:,:) 360 REAL(KIND=r8), allocatable, target :: packed_bergs(:,:) 361 REAL(KIND=r8), allocatable, target :: ref_packed_bergs(:,:) 362 REAL(KIND=r8), allocatable, target :: packed_berg(:,:) 363 REAL(KIND=r8), allocatable, target :: ref_packed_berg(:,:) 364 REAL(KIND=r8), allocatable, target :: packed_melt(:,:) 365 REAL(KIND=r8), allocatable, target :: ref_packed_melt(:,:) 366 REAL(KIND=r8), allocatable, target :: packed_homo(:,:) 367 REAL(KIND=r8), allocatable, target :: ref_packed_homo(:,:) 368 REAL(KIND=r8), allocatable, target :: packed_qcres(:,:) 369 REAL(KIND=r8), allocatable, target :: ref_packed_qcres(:,:) 370 REAL(KIND=r8), allocatable, target :: packed_prci(:,:) 371 REAL(KIND=r8), allocatable, target :: ref_packed_prci(:,:) 372 REAL(KIND=r8), allocatable, target :: packed_prai(:,:) 373 REAL(KIND=r8), allocatable, target :: ref_packed_prai(:,:) 374 REAL(KIND=r8), allocatable, target :: packed_qires(:,:) 375 REAL(KIND=r8), allocatable, target :: ref_packed_qires(:,:) 376 REAL(KIND=r8), allocatable, target :: packed_mnuccr(:,:) 377 REAL(KIND=r8), allocatable, target :: ref_packed_mnuccr(:,:) 378 REAL(KIND=r8), allocatable, target :: packed_pracs(:,:) 379 REAL(KIND=r8), allocatable, target :: ref_packed_pracs(:,:) 380 REAL(KIND=r8), allocatable, target :: packed_meltsdt(:,:) 381 REAL(KIND=r8), allocatable, target :: ref_packed_meltsdt(:,:) 382 REAL(KIND=r8), allocatable, target :: packed_frzrdt(:,:) 383 REAL(KIND=r8), allocatable, target :: ref_packed_frzrdt(:,:) 384 REAL(KIND=r8), allocatable, target :: packed_mnuccd(:,:) 385 REAL(KIND=r8), allocatable, target :: ref_packed_mnuccd(:,:) 386 REAL(KIND=r8), allocatable, target :: packed_nrout(:,:) 387 REAL(KIND=r8), allocatable, target :: ref_packed_nrout(:,:) 388 REAL(KIND=r8), allocatable, target :: packed_nsout(:,:) 389 REAL(KIND=r8), allocatable, target :: ref_packed_nsout(:,:) 390 REAL(KIND=r8), allocatable, target :: packed_refl(:,:) 391 REAL(KIND=r8), allocatable, target :: ref_packed_refl(:,:) 392 REAL(KIND=r8), allocatable, target :: packed_arefl(:,:) 393 REAL(KIND=r8), allocatable, target :: ref_packed_arefl(:,:) 394 REAL(KIND=r8), allocatable, target :: packed_areflz(:,:) 395 REAL(KIND=r8), allocatable, target :: ref_packed_areflz(:,:) 396 REAL(KIND=r8), allocatable, target :: packed_frefl(:,:) 397 REAL(KIND=r8), allocatable, target :: ref_packed_frefl(:,:) 398 REAL(KIND=r8), allocatable, target :: packed_csrfl(:,:) 399 REAL(KIND=r8), allocatable, target :: ref_packed_csrfl(:,:) 400 REAL(KIND=r8), allocatable, target :: packed_acsrfl(:,:) 401 REAL(KIND=r8), allocatable, target :: ref_packed_acsrfl(:,:) 402 REAL(KIND=r8), allocatable, target :: packed_fcsrfl(:,:) 403 REAL(KIND=r8), allocatable, target :: ref_packed_fcsrfl(:,:) 404 REAL(KIND=r8), allocatable, target :: packed_rercld(:,:) 405 REAL(KIND=r8), allocatable, target :: ref_packed_rercld(:,:) 406 REAL(KIND=r8), allocatable, target :: packed_ncai(:,:) 407 REAL(KIND=r8), allocatable, target :: ref_packed_ncai(:,:) 408 REAL(KIND=r8), allocatable, target :: packed_ncal(:,:) 409 REAL(KIND=r8), allocatable, target :: ref_packed_ncal(:,:) 410 REAL(KIND=r8), allocatable, target :: packed_qrout2(:,:) 411 REAL(KIND=r8), allocatable, target :: ref_packed_qrout2(:,:) 412 REAL(KIND=r8), allocatable, target :: packed_qsout2(:,:) 413 REAL(KIND=r8), allocatable, target :: ref_packed_qsout2(:,:) 414 REAL(KIND=r8), allocatable, target :: packed_nrout2(:,:) 415 REAL(KIND=r8), allocatable, target :: ref_packed_nrout2(:,:) 416 REAL(KIND=r8), allocatable, target :: packed_nsout2(:,:) 417 REAL(KIND=r8), allocatable, target :: ref_packed_nsout2(:,:) 418 REAL(KIND=r8), allocatable, target :: packed_freqs(:,:) 419 REAL(KIND=r8), allocatable, target :: ref_packed_freqs(:,:) 420 REAL(KIND=r8), allocatable, target :: packed_freqr(:,:) 421 REAL(KIND=r8), allocatable, target :: ref_packed_freqr(:,:) 422 REAL(KIND=r8), allocatable, target :: packed_nfice(:,:) 423 REAL(KIND=r8), allocatable, target :: ref_packed_nfice(:,:) 424 REAL(KIND=r8), allocatable, target :: packed_prer_evap(:,:) 425 REAL(KIND=r8), allocatable, target :: ref_packed_prer_evap(:,:) 426 REAL(KIND=r8), allocatable, target :: packed_qcrat(:,:) 427 REAL(KIND=r8), allocatable, target :: ref_packed_qcrat(:,:) 428 REAL(KIND=r8), allocatable, target :: packed_rel(:,:) 429 REAL(KIND=r8), allocatable, target :: ref_packed_rel(:,:) 430 REAL(KIND=r8), allocatable, target :: packed_rei(:,:) 431 REAL(KIND=r8), allocatable, target :: ref_packed_rei(:,:) 432 REAL(KIND=r8), allocatable, target :: packed_lambdac(:,:) 433 REAL(KIND=r8), allocatable, target :: ref_packed_lambdac(:,:) 434 REAL(KIND=r8), allocatable, target :: packed_mu(:,:) 435 REAL(KIND=r8), allocatable, target :: ref_packed_mu(:,:) 436 REAL(KIND=r8), allocatable, target :: packed_des(:,:) 437 REAL(KIND=r8), allocatable, target :: ref_packed_des(:,:) 438 REAL(KIND=r8), allocatable, target :: packed_dei(:,:) 439 REAL(KIND=r8), allocatable, target :: ref_packed_dei(:,:) 440 ! Dummy arrays for cases where we throw away the MG version and 441 ! recalculate sizes on the 1 grid to avoid time/subcolumn averaging 442 ! issues. 443 REAL(KIND=r8), allocatable :: rel_fn_dum(:,:) 444 REAL(KIND=r8), allocatable :: ref_rel_fn_dum(:,:) 445 REAL(KIND=r8), allocatable :: dsout2_dum(:,:) 446 REAL(KIND=r8), allocatable :: ref_dsout2_dum(:,:) 447 REAL(KIND=r8), allocatable :: drout_dum(:,:) 448 REAL(KIND=r8), allocatable :: ref_drout_dum(:,:) 449 REAL(KIND=r8), allocatable :: reff_rain_dum(:,:) 450 REAL(KIND=r8), allocatable :: ref_reff_rain_dum(:,:) 451 REAL(KIND=r8), allocatable :: reff_snow_dum(:,:) 452 REAL(KIND=r8), allocatable :: ref_reff_snow_dum(:,:) 453 ! Heterogeneous-only version of mnuccdo. 454 ! physics buffer fields for COSP simulator 455 ! MG grid-box mean flux_large_scale_cloud_rain+snow at interfaces (kg/m2/s) 456 ! MG grid-box mean flux_large_scale_cloud_snow at interfaces (kg/m2/s) 457 ! MG grid-box mean mixingratio_large_scale_cloud_rain+snow at interfaces (kg/kg) 458 ! MG grid-box mean mixingratio_large_scale_cloud_snow at interfaces (kg/kg) 459 ! MG diagnostic rain effective radius (um) 460 ! MG diagnostic snow effective radius (um) 461 ! convective cloud liquid effective radius (um) 462 ! convective cloud ice effective radius (um) 463 ! physics buffer fields used with CARMA 464 ! external tendency on snow mass (kg/kg/s) 465 ! external tendency on snow number(#/kg/s) 466 ! ice effective radius (m) 467 ! 1st order rate for direct conversion of 468 ! strat. cloud water to precip (1/s) ! rce 2010/05/01 469 ! Sedimentation velocity of liquid stratus cloud droplet [ m/s ] 470 ! Grid-mean microphysical tendency 471 ! Grid-mean microphysical tendency 472 ! Grid-mean microphysical tendency 473 ! Grid-mean microphysical tendency 474 ! Grid-mean microphysical tendency 475 ! Grid-mean microphysical tendency 476 ! In-liquid stratus microphysical tendency 477 ! variables for heterogeneous freezing 478 ! A local copy of state is used for diagnostic calculations 479 ! Ice cloud fraction 480 ! Liquid cloud fraction (combined into cloud) 481 ! Liquid effective drop radius (microns) 482 ! Ice effective drop size (microns) 483 ! Total cloud fraction 484 ! Convective cloud fraction 485 ! Stratiform in-cloud ice water path for radiation 486 ! Stratiform in-cloud liquid water path for radiation 487 ! Cloud fraction for liquid+snow 488 ! In-cloud snow water path 489 ! In stratus ice mixing ratio 490 ! In stratus water mixing ratio 491 ! In cloud ice number conc 492 ! In cloud water number conc 493 ! Vertically-integrated in-cloud Liquid WP before microphysics 494 ! Vertically-integrated in-cloud Ice WP before microphysics 495 ! Averaging arrays for effective radius and number.... 496 ! Vertically-integrated droplet concentration 497 ! In stratus ice mixing ratio 498 ! In stratus water mixing ratio 499 ! Cloud fraction used for precipitation. 500 ! Average cloud top radius & number 501 ! Variables for precip efficiency calculation 502 ! LWP threshold 503 ! accumulated precip across timesteps 504 ! accumulated condensation across timesteps 505 ! counter for # timesteps accumulated 506 ! Variables for liquid water path and column condensation 507 ! column liquid 508 ! column condensation rate (units) 509 ! precip efficiency for output 510 ! fraction of time precip efficiency is written out 511 ! average accumulated precipitation rate in pe calculation 512 ! variables for autoconversion and accretion vertical averages 513 ! vertical average autoconversion 514 ! vertical average accretion 515 ! ratio of vertical averages 516 ! counters 517 ! stratus ice mixing ratio - on grid 518 ! stratus water mixing ratio - on grid 519 ! Ice effective drop size at fixed number (indirect effect) (microns) - on grid 520 INTEGER :: nlev ! number of levels where cloud physics is done 521 INTEGER :: mgncol ! size of mgcols 522 ! Columns with microphysics performed 523 ! Flag to store whether accessing grid or sub-columns in pbuf_get_field 524 CHARACTER(LEN=128) :: errstring 525 CHARACTER(LEN=128) :: ref_errstring ! return status (non-blank for error return) 526 ! For rrtmg optics. specified distribution. 527 ! Convective size distribution effective radius (meters) 528 ! Convective size distribution shape parameter 529 ! Convective ice effective diameter (meters) 530 !------------------------------------------------------------------------------- 531 ! Find the number of levels used in the microphysics. 532 ! Set the col_type flag to grid or subcolumn dependent on the value of use_subcol_microp 533 !----------------------- 534 ! These physics buffer fields are read only and not set in this parameterization 535 ! If these fields do not have subcolumn data, copy the grid to the subcolumn if subcolumns is turned on 536 ! If subcolumns is not turned on, then these fields will be grid data 537 !----------------------- 538 ! These physics buffer fields are calculated and set in this parameterization 539 ! If subcolumns is turned on, then these fields will be calculated on a subcolumn grid, otherwise they will be a 540 ! normal grid 541 !----------------------- 542 ! If subcolumns is turned on, all calculated fields which are on subcolumns 543 ! need to be retrieved on the grid as well for storing averaged values 544 !----------------------- 545 ! These are only on the grid regardless of whether subcolumns are turned on or not 546 ! Only MG 1 defines this field so far. 547 !------------------------------------------------------------------------------------- 548 ! Microphysics assumes 'liquid stratus frac = ice stratus frac 549 ! = max( liquid stratus frac, ice stratus frac )'. 550 ! Output initial in-cloud LWP (before microphysics) 551 ! Initialize local state from input. 552 ! Initialize ptend for output. 553 ! the name 'cldwat' triggers special tests on cldliq 554 ! and cldice in physics_update 555 ! workaround an apparent pgi compiler bug on goldbach 556 ! The following are all variables related to sizes, where it does not 557 ! necessarily make sense to average over time steps. Instead, we keep 558 ! the value from the last substep, which is what "accum_null" does. 559 ! Allocate all the dummies with MG sizes. 560 ! Pack input variables that are not updated during substeps. 561 ! Allocate input variables that are updated during substeps. 562 tolerance = 1.E-14 563 CALL kgen_init_check(check_status, tolerance) 564 CALL kgen_read_real_r8_dim2_alloc(packed_t, kgen_unit) 565 CALL kgen_read_real_r8_dim2_alloc(packed_q, kgen_unit) 566 CALL kgen_read_real_r8_dim2_alloc(packed_qc, kgen_unit) 567 CALL kgen_read_real_r8_dim2_alloc(packed_nc, kgen_unit) 568 CALL kgen_read_real_r8_dim2_alloc(packed_qi, kgen_unit) 569 CALL kgen_read_real_r8_dim2_alloc(packed_ni, kgen_unit) 570 CALL kgen_read_real_r8_dim2_alloc(packed_qr, kgen_unit) 571 CALL kgen_read_real_r8_dim2_alloc(packed_nr, kgen_unit) 572 CALL kgen_read_real_r8_dim2_alloc(packed_qs, kgen_unit) 573 CALL kgen_read_real_r8_dim2_alloc(packed_ns, kgen_unit) 574 CALL kgen_read_real_r8_dim2_alloc(packed_relvar, kgen_unit) 575 CALL kgen_read_real_r8_dim2_alloc(packed_accre_enhan, kgen_unit) 576 CALL kgen_read_real_r8_dim2_alloc(packed_p, kgen_unit) 577 CALL kgen_read_real_r8_dim2_alloc(packed_pdel, kgen_unit) 578 CALL kgen_read_real_r8_dim2_alloc(packed_cldn, kgen_unit) 579 CALL kgen_read_real_r8_dim2_alloc(packed_liqcldf, kgen_unit) 580 CALL kgen_read_real_r8_dim2_alloc(packed_icecldf, kgen_unit) 581 CALL kgen_read_real_r8_dim2_alloc(packed_naai, kgen_unit) 582 CALL kgen_read_real_r8_dim2_alloc(packed_npccn, kgen_unit) 583 CALL kgen_read_real_r8_dim3_alloc(packed_rndst, kgen_unit) 584 CALL kgen_read_real_r8_dim3_alloc(packed_nacon, kgen_unit) 585 CALL kgen_read_real_r8_dim2_ptr(packed_tnd_qsnow, kgen_unit) 586 CALL kgen_read_real_r8_dim2_ptr(packed_tnd_nsnow, kgen_unit) 587 CALL kgen_read_real_r8_dim2_ptr(packed_re_ice, kgen_unit) 588 CALL kgen_read_real_r8_dim2_ptr(packed_frzimm, kgen_unit) 589 CALL kgen_read_real_r8_dim2_ptr(packed_frzcnt, kgen_unit) 590 CALL kgen_read_real_r8_dim2_ptr(packed_frzdep, kgen_unit) 591 CALL kgen_read_real_r8_dim2_alloc(packed_rate1ord_cw2pr_st, kgen_unit) 592 CALL kgen_read_real_r8_dim2_alloc(packed_tlat, kgen_unit) 593 CALL kgen_read_real_r8_dim2_alloc(packed_qvlat, kgen_unit) 594 CALL kgen_read_real_r8_dim2_alloc(packed_qctend, kgen_unit) 595 CALL kgen_read_real_r8_dim2_alloc(packed_qitend, kgen_unit) 596 CALL kgen_read_real_r8_dim2_alloc(packed_nctend, kgen_unit) 597 CALL kgen_read_real_r8_dim2_alloc(packed_nitend, kgen_unit) 598 CALL kgen_read_real_r8_dim2_alloc(packed_qrtend, kgen_unit) 599 CALL kgen_read_real_r8_dim2_alloc(packed_qstend, kgen_unit) 600 CALL kgen_read_real_r8_dim2_alloc(packed_nrtend, kgen_unit) 601 CALL kgen_read_real_r8_dim2_alloc(packed_nstend, kgen_unit) 602 CALL kgen_read_real_r8_dim1_alloc(packed_prect, kgen_unit) 603 CALL kgen_read_real_r8_dim1_alloc(packed_preci, kgen_unit) 604 CALL kgen_read_real_r8_dim2_alloc(packed_nevapr, kgen_unit) 605 CALL kgen_read_real_r8_dim2_alloc(packed_evapsnow, kgen_unit) 606 CALL kgen_read_real_r8_dim2_alloc(packed_prain, kgen_unit) 607 CALL kgen_read_real_r8_dim2_alloc(packed_prodsnow, kgen_unit) 608 CALL kgen_read_real_r8_dim2_alloc(packed_cmeout, kgen_unit) 609 CALL kgen_read_real_r8_dim2_alloc(packed_qsout, kgen_unit) 610 CALL kgen_read_real_r8_dim2_alloc(packed_rflx, kgen_unit) 611 CALL kgen_read_real_r8_dim2_alloc(packed_sflx, kgen_unit) 612 CALL kgen_read_real_r8_dim2_alloc(packed_qrout, kgen_unit) 613 CALL kgen_read_real_r8_dim2_alloc(packed_qcsevap, kgen_unit) 614 CALL kgen_read_real_r8_dim2_alloc(packed_qisevap, kgen_unit) 615 CALL kgen_read_real_r8_dim2_alloc(packed_qvres, kgen_unit) 616 CALL kgen_read_real_r8_dim2_alloc(packed_cmei, kgen_unit) 617 CALL kgen_read_real_r8_dim2_alloc(packed_vtrmc, kgen_unit) 618 CALL kgen_read_real_r8_dim2_alloc(packed_vtrmi, kgen_unit) 619 CALL kgen_read_real_r8_dim2_alloc(packed_qcsedten, kgen_unit) 620 CALL kgen_read_real_r8_dim2_alloc(packed_qisedten, kgen_unit) 621 CALL kgen_read_real_r8_dim2_alloc(packed_qrsedten, kgen_unit) 622 CALL kgen_read_real_r8_dim2_alloc(packed_qssedten, kgen_unit) 623 CALL kgen_read_real_r8_dim2_alloc(packed_umr, kgen_unit) 624 CALL kgen_read_real_r8_dim2_alloc(packed_ums, kgen_unit) 625 CALL kgen_read_real_r8_dim2_alloc(packed_pra, kgen_unit) 626 CALL kgen_read_real_r8_dim2_alloc(packed_prc, kgen_unit) 627 CALL kgen_read_real_r8_dim2_alloc(packed_mnuccc, kgen_unit) 628 CALL kgen_read_real_r8_dim2_alloc(packed_mnucct, kgen_unit) 629 CALL kgen_read_real_r8_dim2_alloc(packed_msacwi, kgen_unit) 630 CALL kgen_read_real_r8_dim2_alloc(packed_psacws, kgen_unit) 631 CALL kgen_read_real_r8_dim2_alloc(packed_bergs, kgen_unit) 632 CALL kgen_read_real_r8_dim2_alloc(packed_berg, kgen_unit) 633 CALL kgen_read_real_r8_dim2_alloc(packed_melt, kgen_unit) 634 CALL kgen_read_real_r8_dim2_alloc(packed_homo, kgen_unit) 635 CALL kgen_read_real_r8_dim2_alloc(packed_qcres, kgen_unit) 636 CALL kgen_read_real_r8_dim2_alloc(packed_prci, kgen_unit) 637 CALL kgen_read_real_r8_dim2_alloc(packed_prai, kgen_unit) 638 CALL kgen_read_real_r8_dim2_alloc(packed_qires, kgen_unit) 639 CALL kgen_read_real_r8_dim2_alloc(packed_mnuccr, kgen_unit) 640 CALL kgen_read_real_r8_dim2_alloc(packed_pracs, kgen_unit) 641 CALL kgen_read_real_r8_dim2_alloc(packed_meltsdt, kgen_unit) 642 CALL kgen_read_real_r8_dim2_alloc(packed_frzrdt, kgen_unit) 643 CALL kgen_read_real_r8_dim2_alloc(packed_mnuccd, kgen_unit) 644 CALL kgen_read_real_r8_dim2_alloc(packed_nrout, kgen_unit) 645 CALL kgen_read_real_r8_dim2_alloc(packed_nsout, kgen_unit) 646 CALL kgen_read_real_r8_dim2_alloc(packed_refl, kgen_unit) 647 CALL kgen_read_real_r8_dim2_alloc(packed_arefl, kgen_unit) 648 CALL kgen_read_real_r8_dim2_alloc(packed_areflz, kgen_unit) 649 CALL kgen_read_real_r8_dim2_alloc(packed_frefl, kgen_unit) 650 CALL kgen_read_real_r8_dim2_alloc(packed_csrfl, kgen_unit) 651 CALL kgen_read_real_r8_dim2_alloc(packed_acsrfl, kgen_unit) 652 CALL kgen_read_real_r8_dim2_alloc(packed_fcsrfl, kgen_unit) 653 CALL kgen_read_real_r8_dim2_alloc(packed_rercld, kgen_unit) 654 CALL kgen_read_real_r8_dim2_alloc(packed_ncai, kgen_unit) 655 CALL kgen_read_real_r8_dim2_alloc(packed_ncal, kgen_unit) 656 CALL kgen_read_real_r8_dim2_alloc(packed_qrout2, kgen_unit) 657 CALL kgen_read_real_r8_dim2_alloc(packed_qsout2, kgen_unit) 658 CALL kgen_read_real_r8_dim2_alloc(packed_nrout2, kgen_unit) 659 CALL kgen_read_real_r8_dim2_alloc(packed_nsout2, kgen_unit) 660 CALL kgen_read_real_r8_dim2_alloc(packed_freqs, kgen_unit) 661 CALL kgen_read_real_r8_dim2_alloc(packed_freqr, kgen_unit) 662 CALL kgen_read_real_r8_dim2_alloc(packed_nfice, kgen_unit) 663 CALL kgen_read_real_r8_dim2_alloc(packed_prer_evap, kgen_unit) 664 CALL kgen_read_real_r8_dim2_alloc(packed_qcrat, kgen_unit) 665 CALL kgen_read_real_r8_dim2_alloc(packed_rel, kgen_unit) 666 CALL kgen_read_real_r8_dim2_alloc(packed_rei, kgen_unit) 667 CALL kgen_read_real_r8_dim2_alloc(packed_lambdac, kgen_unit) 668 CALL kgen_read_real_r8_dim2_alloc(packed_mu, kgen_unit) 669 CALL kgen_read_real_r8_dim2_alloc(packed_des, kgen_unit) 670 CALL kgen_read_real_r8_dim2_alloc(packed_dei, kgen_unit) 671 CALL kgen_read_real_r8_dim2_alloc(rel_fn_dum, kgen_unit) 672 CALL kgen_read_real_r8_dim2_alloc(dsout2_dum, kgen_unit) 673 CALL kgen_read_real_r8_dim2_alloc(drout_dum, kgen_unit) 674 CALL kgen_read_real_r8_dim2_alloc(reff_rain_dum, kgen_unit) 675 CALL kgen_read_real_r8_dim2_alloc(reff_snow_dum, kgen_unit) 676 READ(UNIT=kgen_unit) nlev 677 READ(UNIT=kgen_unit) mgncol 678 READ(UNIT=kgen_unit) errstring 679 680 CALL kgen_read_real_r8_dim2_alloc(ref_packed_rate1ord_cw2pr_st, kgen_unit) 681 CALL kgen_read_real_r8_dim2_alloc(ref_packed_tlat, kgen_unit) 682 CALL kgen_read_real_r8_dim2_alloc(ref_packed_qvlat, kgen_unit) 683 CALL kgen_read_real_r8_dim2_alloc(ref_packed_qctend, kgen_unit) 684 CALL kgen_read_real_r8_dim2_alloc(ref_packed_qitend, kgen_unit) 685 CALL kgen_read_real_r8_dim2_alloc(ref_packed_nctend, kgen_unit) 686 CALL kgen_read_real_r8_dim2_alloc(ref_packed_nitend, kgen_unit) 687 CALL kgen_read_real_r8_dim2_alloc(ref_packed_qrtend, kgen_unit) 688 CALL kgen_read_real_r8_dim2_alloc(ref_packed_qstend, kgen_unit) 689 CALL kgen_read_real_r8_dim2_alloc(ref_packed_nrtend, kgen_unit) 690 CALL kgen_read_real_r8_dim2_alloc(ref_packed_nstend, kgen_unit) 691 CALL kgen_read_real_r8_dim1_alloc(ref_packed_prect, kgen_unit) 692 CALL kgen_read_real_r8_dim1_alloc(ref_packed_preci, kgen_unit) 693 CALL kgen_read_real_r8_dim2_alloc(ref_packed_nevapr, kgen_unit) 694 CALL kgen_read_real_r8_dim2_alloc(ref_packed_evapsnow, kgen_unit) 695 CALL kgen_read_real_r8_dim2_alloc(ref_packed_prain, kgen_unit) 696 CALL kgen_read_real_r8_dim2_alloc(ref_packed_prodsnow, kgen_unit) 697 CALL kgen_read_real_r8_dim2_alloc(ref_packed_cmeout, kgen_unit) 698 CALL kgen_read_real_r8_dim2_alloc(ref_packed_qsout, kgen_unit) 699 CALL kgen_read_real_r8_dim2_alloc(ref_packed_rflx, kgen_unit) 700 CALL kgen_read_real_r8_dim2_alloc(ref_packed_sflx, kgen_unit) 701 CALL kgen_read_real_r8_dim2_alloc(ref_packed_qrout, kgen_unit) 702 CALL kgen_read_real_r8_dim2_alloc(ref_packed_qcsevap, kgen_unit) 703 CALL kgen_read_real_r8_dim2_alloc(ref_packed_qisevap, kgen_unit) 704 CALL kgen_read_real_r8_dim2_alloc(ref_packed_qvres, kgen_unit) 705 CALL kgen_read_real_r8_dim2_alloc(ref_packed_cmei, kgen_unit) 706 CALL kgen_read_real_r8_dim2_alloc(ref_packed_vtrmc, kgen_unit) 707 CALL kgen_read_real_r8_dim2_alloc(ref_packed_vtrmi, kgen_unit) 708 CALL kgen_read_real_r8_dim2_alloc(ref_packed_qcsedten, kgen_unit) 709 CALL kgen_read_real_r8_dim2_alloc(ref_packed_qisedten, kgen_unit) 710 CALL kgen_read_real_r8_dim2_alloc(ref_packed_qrsedten, kgen_unit) 711 CALL kgen_read_real_r8_dim2_alloc(ref_packed_qssedten, kgen_unit) 712 CALL kgen_read_real_r8_dim2_alloc(ref_packed_umr, kgen_unit) 713 CALL kgen_read_real_r8_dim2_alloc(ref_packed_ums, kgen_unit) 714 CALL kgen_read_real_r8_dim2_alloc(ref_packed_pra, kgen_unit) 715 CALL kgen_read_real_r8_dim2_alloc(ref_packed_prc, kgen_unit) 716 CALL kgen_read_real_r8_dim2_alloc(ref_packed_mnuccc, kgen_unit) 717 CALL kgen_read_real_r8_dim2_alloc(ref_packed_mnucct, kgen_unit) 718 CALL kgen_read_real_r8_dim2_alloc(ref_packed_msacwi, kgen_unit) 719 CALL kgen_read_real_r8_dim2_alloc(ref_packed_psacws, kgen_unit) 720 CALL kgen_read_real_r8_dim2_alloc(ref_packed_bergs, kgen_unit) 721 CALL kgen_read_real_r8_dim2_alloc(ref_packed_berg, kgen_unit) 722 CALL kgen_read_real_r8_dim2_alloc(ref_packed_melt, kgen_unit) 723 CALL kgen_read_real_r8_dim2_alloc(ref_packed_homo, kgen_unit) 724 CALL kgen_read_real_r8_dim2_alloc(ref_packed_qcres, kgen_unit) 725 CALL kgen_read_real_r8_dim2_alloc(ref_packed_prci, kgen_unit) 726 CALL kgen_read_real_r8_dim2_alloc(ref_packed_prai, kgen_unit) 727 CALL kgen_read_real_r8_dim2_alloc(ref_packed_qires, kgen_unit) 728 CALL kgen_read_real_r8_dim2_alloc(ref_packed_mnuccr, kgen_unit) 729 CALL kgen_read_real_r8_dim2_alloc(ref_packed_pracs, kgen_unit) 730 CALL kgen_read_real_r8_dim2_alloc(ref_packed_meltsdt, kgen_unit) 731 CALL kgen_read_real_r8_dim2_alloc(ref_packed_frzrdt, kgen_unit) 732 CALL kgen_read_real_r8_dim2_alloc(ref_packed_mnuccd, kgen_unit) 733 CALL kgen_read_real_r8_dim2_alloc(ref_packed_nrout, kgen_unit) 734 CALL kgen_read_real_r8_dim2_alloc(ref_packed_nsout, kgen_unit) 735 CALL kgen_read_real_r8_dim2_alloc(ref_packed_refl, kgen_unit) 736 CALL kgen_read_real_r8_dim2_alloc(ref_packed_arefl, kgen_unit) 737 CALL kgen_read_real_r8_dim2_alloc(ref_packed_areflz, kgen_unit) 738 CALL kgen_read_real_r8_dim2_alloc(ref_packed_frefl, kgen_unit) 739 CALL kgen_read_real_r8_dim2_alloc(ref_packed_csrfl, kgen_unit) 740 CALL kgen_read_real_r8_dim2_alloc(ref_packed_acsrfl, kgen_unit) 741 CALL kgen_read_real_r8_dim2_alloc(ref_packed_fcsrfl, kgen_unit) 742 CALL kgen_read_real_r8_dim2_alloc(ref_packed_rercld, kgen_unit) 743 CALL kgen_read_real_r8_dim2_alloc(ref_packed_ncai, kgen_unit) 744 CALL kgen_read_real_r8_dim2_alloc(ref_packed_ncal, kgen_unit) 745 CALL kgen_read_real_r8_dim2_alloc(ref_packed_qrout2, kgen_unit) 746 CALL kgen_read_real_r8_dim2_alloc(ref_packed_qsout2, kgen_unit) 747 CALL kgen_read_real_r8_dim2_alloc(ref_packed_nrout2, kgen_unit) 748 CALL kgen_read_real_r8_dim2_alloc(ref_packed_nsout2, kgen_unit) 749 CALL kgen_read_real_r8_dim2_alloc(ref_packed_freqs, kgen_unit) 750 CALL kgen_read_real_r8_dim2_alloc(ref_packed_freqr, kgen_unit) 751 CALL kgen_read_real_r8_dim2_alloc(ref_packed_nfice, kgen_unit) 752 CALL kgen_read_real_r8_dim2_alloc(ref_packed_prer_evap, kgen_unit) 753 CALL kgen_read_real_r8_dim2_alloc(ref_packed_qcrat, kgen_unit) 754 CALL kgen_read_real_r8_dim2_alloc(ref_packed_rel, kgen_unit) 755 CALL kgen_read_real_r8_dim2_alloc(ref_packed_rei, kgen_unit) 756 CALL kgen_read_real_r8_dim2_alloc(ref_packed_lambdac, kgen_unit) 757 CALL kgen_read_real_r8_dim2_alloc(ref_packed_mu, kgen_unit) 758 CALL kgen_read_real_r8_dim2_alloc(ref_packed_des, kgen_unit) 759 CALL kgen_read_real_r8_dim2_alloc(ref_packed_dei, kgen_unit) 760 CALL kgen_read_real_r8_dim2_alloc(ref_rel_fn_dum, kgen_unit) 761 CALL kgen_read_real_r8_dim2_alloc(ref_dsout2_dum, kgen_unit) 762 CALL kgen_read_real_r8_dim2_alloc(ref_drout_dum, kgen_unit) 763 CALL kgen_read_real_r8_dim2_alloc(ref_reff_rain_dum, kgen_unit) 764 CALL kgen_read_real_r8_dim2_alloc(ref_reff_snow_dum, kgen_unit) 765 READ(UNIT=kgen_unit) ref_errstring 766 767 ! call to kernel 768 CALL micro_mg_tend2_0(mgncol, nlev, dtime / num_steps, packed_t, packed_q, packed_qc, packed_qi, & 769 packed_nc, packed_ni, packed_qr, packed_qs, packed_nr, packed_ns, packed_relvar, & 770 packed_accre_enhan, packed_p, packed_pdel, packed_cldn, packed_liqcldf, packed_icecldf, & 771 packed_rate1ord_cw2pr_st, packed_naai, packed_npccn, packed_rndst, packed_nacon, packed_tlat, & 772 packed_qvlat, packed_qctend, packed_qitend, packed_nctend, packed_nitend, packed_qrtend, & 773 packed_qstend, packed_nrtend, packed_nstend, packed_rel, rel_fn_dum, packed_rei, packed_prect, & 774 packed_preci, packed_nevapr, packed_evapsnow, packed_prain, packed_prodsnow, packed_cmeout, & 775 packed_dei, packed_mu, packed_lambdac, packed_qsout, packed_des, packed_rflx, packed_sflx, & 776 packed_qrout, reff_rain_dum, reff_snow_dum, packed_qcsevap, packed_qisevap, packed_qvres, & 777 packed_cmei, packed_vtrmc, packed_vtrmi, packed_umr, packed_ums, packed_qcsedten, & 778 packed_qisedten, packed_qrsedten, packed_qssedten, packed_pra, packed_prc, packed_mnuccc, & 779 packed_mnucct, packed_msacwi, packed_psacws, packed_bergs, packed_berg, packed_melt, & 780 packed_homo, packed_qcres, packed_prci, packed_prai, packed_qires, packed_mnuccr, & 781 packed_pracs, packed_meltsdt, packed_frzrdt, packed_mnuccd, packed_nrout, packed_nsout, & 782 packed_refl, packed_arefl, packed_areflz, packed_frefl, packed_csrfl, packed_acsrfl, & 783 packed_fcsrfl, packed_rercld, packed_ncai, packed_ncal, packed_qrout2, packed_qsout2, & 784 packed_nrout2, packed_nsout2, drout_dum, dsout2_dum, packed_freqs, packed_freqr, & 785 packed_nfice, packed_qcrat, errstring, packed_tnd_qsnow, packed_tnd_nsnow, packed_re_ice, & 786 packed_prer_evap, packed_frzimm, packed_frzcnt, packed_frzdep) 787 ! kernel verification for output variables 788 CALL kgen_verify_real_r8_dim2_alloc( "packed_rate1ord_cw2pr_st", check_status, packed_rate1ord_cw2pr_st, ref_packed_rate1ord_cw2pr_st) 789 CALL kgen_verify_real_r8_dim2_alloc( "packed_tlat", check_status, packed_tlat, ref_packed_tlat) 790 CALL kgen_verify_real_r8_dim2_alloc( "packed_qvlat", check_status, packed_qvlat, ref_packed_qvlat) 791 CALL kgen_verify_real_r8_dim2_alloc( "packed_qctend", check_status, packed_qctend, ref_packed_qctend) 792 CALL kgen_verify_real_r8_dim2_alloc( "packed_qitend", check_status, packed_qitend, ref_packed_qitend) 793 CALL kgen_verify_real_r8_dim2_alloc( "packed_nctend", check_status, packed_nctend, ref_packed_nctend) 794 ! Temporarily increase tolerance to 5.0e-13 795 check_status%tolerance = 5.E-13 796 CALL kgen_verify_real_r8_dim2_alloc( "packed_nitend", check_status, packed_nitend, ref_packed_nitend) 797 check_status%tolerance = tolerance 798 CALL kgen_verify_real_r8_dim2_alloc( "packed_qrtend", check_status, packed_qrtend, ref_packed_qrtend) 799 CALL kgen_verify_real_r8_dim2_alloc( "packed_qstend", check_status, packed_qstend, ref_packed_qstend) 800 ! Temporarily increase tolerance to 5.0e-14 801 check_status%tolerance = 5.E-14 802 CALL kgen_verify_real_r8_dim2_alloc( "packed_nrtend", check_status, packed_nrtend, ref_packed_nrtend) 803 check_status%tolerance = tolerance 804 CALL kgen_verify_real_r8_dim2_alloc( "packed_nstend", check_status, packed_nstend, ref_packed_nstend) 805 CALL kgen_verify_real_r8_dim1_alloc( "packed_prect", check_status, packed_prect, ref_packed_prect) 806 CALL kgen_verify_real_r8_dim1_alloc( "packed_preci", check_status, packed_preci, ref_packed_preci) 807 CALL kgen_verify_real_r8_dim2_alloc( "packed_nevapr", check_status, packed_nevapr, ref_packed_nevapr) 808 CALL kgen_verify_real_r8_dim2_alloc( "packed_evapsnow", check_status, packed_evapsnow, ref_packed_evapsnow) 809 CALL kgen_verify_real_r8_dim2_alloc( "packed_prain", check_status, packed_prain, ref_packed_prain) 810 CALL kgen_verify_real_r8_dim2_alloc( "packed_prodsnow", check_status, packed_prodsnow, ref_packed_prodsnow) 811 CALL kgen_verify_real_r8_dim2_alloc( "packed_cmeout", check_status, packed_cmeout, ref_packed_cmeout) 812 CALL kgen_verify_real_r8_dim2_alloc( "packed_qsout", check_status, packed_qsout, ref_packed_qsout) 813 CALL kgen_verify_real_r8_dim2_alloc( "packed_rflx", check_status, packed_rflx, ref_packed_rflx) 814 CALL kgen_verify_real_r8_dim2_alloc( "packed_sflx", check_status, packed_sflx, ref_packed_sflx) 815 CALL kgen_verify_real_r8_dim2_alloc( "packed_qrout", check_status, packed_qrout, ref_packed_qrout) 816 CALL kgen_verify_real_r8_dim2_alloc( "packed_qcsevap", check_status, packed_qcsevap, ref_packed_qcsevap) 817 CALL kgen_verify_real_r8_dim2_alloc( "packed_qisevap", check_status, packed_qisevap, ref_packed_qisevap) 818 CALL kgen_verify_real_r8_dim2_alloc( "packed_qvres", check_status, packed_qvres, ref_packed_qvres) 819 CALL kgen_verify_real_r8_dim2_alloc( "packed_cmei", check_status, packed_cmei, ref_packed_cmei) 820 CALL kgen_verify_real_r8_dim2_alloc( "packed_vtrmc", check_status, packed_vtrmc, ref_packed_vtrmc) 821 ! Temporarily increase tolerance to 5.0e-12 822 check_status%tolerance = 5.E-12 823 CALL kgen_verify_real_r8_dim2_alloc( "packed_vtrmi", check_status, packed_vtrmi, ref_packed_vtrmi) 824 check_status%tolerance = tolerance 825 CALL kgen_verify_real_r8_dim2_alloc( "packed_qcsedten", check_status, packed_qcsedten, ref_packed_qcsedten) 826 ! Temporarily increase tolerance to 1.0e-11 827 check_status%tolerance = 1.E-11 !djp djp 828 CALL kgen_verify_real_r8_dim2_alloc( "packed_qisedten", check_status, packed_qisedten, ref_packed_qisedten) 829 check_status%tolerance = tolerance 830 CALL kgen_verify_real_r8_dim2_alloc( "packed_qrsedten", check_status, packed_qrsedten, ref_packed_qrsedten) 831 ! Temporarily increase tolerance to 5.0e-12 832 check_status%tolerance = 1.E-11 833 CALL kgen_verify_real_r8_dim2_alloc( "packed_qssedten", check_status, packed_qssedten, ref_packed_qssedten) 834 check_status%tolerance = tolerance 835 CALL kgen_verify_real_r8_dim2_alloc( "packed_umr", check_status, packed_umr, ref_packed_umr) 836 CALL kgen_verify_real_r8_dim2_alloc( "packed_ums", check_status, packed_ums, ref_packed_ums) 837 CALL kgen_verify_real_r8_dim2_alloc( "packed_pra", check_status, packed_pra, ref_packed_pra) 838 CALL kgen_verify_real_r8_dim2_alloc( "packed_prc", check_status, packed_prc, ref_packed_prc) 839 CALL kgen_verify_real_r8_dim2_alloc( "packed_mnuccc", check_status, packed_mnuccc, ref_packed_mnuccc) 840 CALL kgen_verify_real_r8_dim2_alloc( "packed_mnucct", check_status, packed_mnucct, ref_packed_mnucct) 841 CALL kgen_verify_real_r8_dim2_alloc( "packed_msacwi", check_status, packed_msacwi, ref_packed_msacwi) 842 CALL kgen_verify_real_r8_dim2_alloc( "packed_psacws", check_status, packed_psacws, ref_packed_psacws) 843 CALL kgen_verify_real_r8_dim2_alloc( "packed_bergs", check_status, packed_bergs, ref_packed_bergs) 844 CALL kgen_verify_real_r8_dim2_alloc( "packed_berg", check_status, packed_berg, ref_packed_berg) 845 CALL kgen_verify_real_r8_dim2_alloc( "packed_melt", check_status, packed_melt, ref_packed_melt) 846 CALL kgen_verify_real_r8_dim2_alloc( "packed_homo", check_status, packed_homo, ref_packed_homo) 847 CALL kgen_verify_real_r8_dim2_alloc( "packed_qcres", check_status, packed_qcres, ref_packed_qcres) 848 CALL kgen_verify_real_r8_dim2_alloc( "packed_prci", check_status, packed_prci, ref_packed_prci) 849 CALL kgen_verify_real_r8_dim2_alloc( "packed_prai", check_status, packed_prai, ref_packed_prai) 850 CALL kgen_verify_real_r8_dim2_alloc( "packed_qires", check_status, packed_qires, ref_packed_qires) 851 CALL kgen_verify_real_r8_dim2_alloc( "packed_mnuccr", check_status, packed_mnuccr, ref_packed_mnuccr) 852 CALL kgen_verify_real_r8_dim2_alloc( "packed_pracs", check_status, packed_pracs, ref_packed_pracs) 853 CALL kgen_verify_real_r8_dim2_alloc( "packed_meltsdt", check_status, packed_meltsdt, ref_packed_meltsdt) 854 CALL kgen_verify_real_r8_dim2_alloc( "packed_frzrdt", check_status, packed_frzrdt, ref_packed_frzrdt) 855 CALL kgen_verify_real_r8_dim2_alloc( "packed_mnuccd", check_status, packed_mnuccd, ref_packed_mnuccd) 856 CALL kgen_verify_real_r8_dim2_alloc( "packed_nrout", check_status, packed_nrout, ref_packed_nrout) 857 CALL kgen_verify_real_r8_dim2_alloc( "packed_nsout", check_status, packed_nsout, ref_packed_nsout) 858 CALL kgen_verify_real_r8_dim2_alloc( "packed_refl", check_status, packed_refl, ref_packed_refl) 859 CALL kgen_verify_real_r8_dim2_alloc( "packed_arefl", check_status, packed_arefl, ref_packed_arefl) 860 CALL kgen_verify_real_r8_dim2_alloc( "packed_areflz", check_status, packed_areflz, ref_packed_areflz) 861 CALL kgen_verify_real_r8_dim2_alloc( "packed_frefl", check_status, packed_frefl, ref_packed_frefl) 862 CALL kgen_verify_real_r8_dim2_alloc( "packed_csrfl", check_status, packed_csrfl, ref_packed_csrfl) 863 CALL kgen_verify_real_r8_dim2_alloc( "packed_acsrfl", check_status, packed_acsrfl, ref_packed_acsrfl) 864 CALL kgen_verify_real_r8_dim2_alloc( "packed_fcsrfl", check_status, packed_fcsrfl, ref_packed_fcsrfl) 865 CALL kgen_verify_real_r8_dim2_alloc( "packed_rercld", check_status, packed_rercld, ref_packed_rercld) 866 CALL kgen_verify_real_r8_dim2_alloc( "packed_ncai", check_status, packed_ncai, ref_packed_ncai) 867 CALL kgen_verify_real_r8_dim2_alloc( "packed_ncal", check_status, packed_ncal, ref_packed_ncal) 868 CALL kgen_verify_real_r8_dim2_alloc( "packed_qrout2", check_status, packed_qrout2, ref_packed_qrout2) 869 CALL kgen_verify_real_r8_dim2_alloc( "packed_qsout2", check_status, packed_qsout2, ref_packed_qsout2) 870 CALL kgen_verify_real_r8_dim2_alloc( "packed_nrout2", check_status, packed_nrout2, ref_packed_nrout2) 871 CALL kgen_verify_real_r8_dim2_alloc( "packed_nsout2", check_status, packed_nsout2, ref_packed_nsout2) 872 CALL kgen_verify_real_r8_dim2_alloc( "packed_freqs", check_status, packed_freqs, ref_packed_freqs) 873 CALL kgen_verify_real_r8_dim2_alloc( "packed_freqr", check_status, packed_freqr, ref_packed_freqr) 874 CALL kgen_verify_real_r8_dim2_alloc( "packed_nfice", check_status, packed_nfice, ref_packed_nfice) 875 CALL kgen_verify_real_r8_dim2_alloc( "packed_prer_evap", check_status, packed_prer_evap, ref_packed_prer_evap) 876 CALL kgen_verify_real_r8_dim2_alloc( "packed_qcrat", check_status, packed_qcrat, ref_packed_qcrat) 877 ! Temporarily increase tolerance to 1.0e-11 878 check_status%tolerance = 1.E-11 879 CALL kgen_verify_real_r8_dim2_alloc( "packed_rel", check_status, packed_rel, ref_packed_rel) 880 check_status%tolerance = tolerance 881 CALL kgen_verify_real_r8_dim2_alloc( "packed_rei", check_status, packed_rei, ref_packed_rei) 882 ! Temporarily increase tolerance to 1.0e-11 883 check_status%tolerance = 1.E-11 884 CALL kgen_verify_real_r8_dim2_alloc( "packed_lambdac", check_status, packed_lambdac, ref_packed_lambdac) 885 check_status%tolerance = tolerance 886 CALL kgen_verify_real_r8_dim2_alloc( "packed_mu", check_status, packed_mu, ref_packed_mu) 887 CALL kgen_verify_real_r8_dim2_alloc( "packed_des", check_status, packed_des, ref_packed_des) 888 CALL kgen_verify_real_r8_dim2_alloc( "packed_dei", check_status, packed_dei, ref_packed_dei) 889 CALL kgen_verify_real_r8_dim2_alloc( "rel_fn_dum", check_status, rel_fn_dum, ref_rel_fn_dum) 890 CALL kgen_verify_real_r8_dim2_alloc( "dsout2_dum", check_status, dsout2_dum, ref_dsout2_dum) 891 CALL kgen_verify_real_r8_dim2_alloc( "drout_dum", check_status, drout_dum, ref_drout_dum) 892 CALL kgen_verify_real_r8_dim2_alloc( "reff_rain_dum", check_status, reff_rain_dum, ref_reff_rain_dum) 893 CALL kgen_verify_real_r8_dim2_alloc( "reff_snow_dum", check_status, reff_snow_dum, ref_reff_snow_dum) 894 CALL kgen_verify_character( "errstring", check_status, errstring, ref_errstring) 895 CALL kgen_print_check("micro_mg_tend", check_status) 896 CALL system_clock(start_clock, rate_clock) 897 DO kgen_intvar=1,10 898 CALL micro_mg_tend2_0(mgncol, nlev, dtime / num_steps, packed_t, packed_q, packed_qc, & 899 packed_qi, packed_nc, packed_ni, packed_qr, packed_qs, packed_nr, packed_ns, & 900 packed_relvar, packed_accre_enhan, packed_p, packed_pdel, packed_cldn, packed_liqcldf, & 901 packed_icecldf, packed_rate1ord_cw2pr_st, packed_naai, packed_npccn, packed_rndst, & 902 packed_nacon, packed_tlat, packed_qvlat, packed_qctend, packed_qitend, packed_nctend, & 903 packed_nitend, packed_qrtend, packed_qstend, packed_nrtend, packed_nstend, packed_rel, & 904 rel_fn_dum, packed_rei, packed_prect, packed_preci, packed_nevapr, packed_evapsnow, & 905 packed_prain, packed_prodsnow, packed_cmeout, packed_dei, packed_mu, packed_lambdac, & 906 packed_qsout, packed_des, packed_rflx, packed_sflx, packed_qrout, reff_rain_dum, & 907 reff_snow_dum, packed_qcsevap, packed_qisevap, packed_qvres, packed_cmei, packed_vtrmc, & 908 packed_vtrmi, packed_umr, packed_ums, packed_qcsedten, packed_qisedten, packed_qrsedten, & 909 packed_qssedten, packed_pra, packed_prc, packed_mnuccc, packed_mnucct, packed_msacwi, & 910 packed_psacws, packed_bergs, packed_berg, packed_melt, packed_homo, packed_qcres, & 911 packed_prci, packed_prai, packed_qires, packed_mnuccr, packed_pracs, packed_meltsdt, & 912 packed_frzrdt, packed_mnuccd, packed_nrout, packed_nsout, packed_refl, packed_arefl, & 913 packed_areflz, packed_frefl, packed_csrfl, packed_acsrfl, packed_fcsrfl, packed_rercld, & 914 packed_ncai, packed_ncal, packed_qrout2, packed_qsout2, packed_nrout2, packed_nsout2, & 915 drout_dum, dsout2_dum, packed_freqs, packed_freqr, packed_nfice, packed_qcrat, errstring, & 916 packed_tnd_qsnow, packed_tnd_nsnow, packed_re_ice, packed_prer_evap, packed_frzimm, & 917 packed_frzcnt, packed_frzdep) 918 END DO 919 CALL system_clock(stop_clock, rate_clock) 920 WRITE(*,*) 921 PRINT *, "Elapsed time (sec): ", (stop_clock - start_clock)/REAL(rate_clock*10) 922 ! Divide ptend by substeps. 923 ! Use summed outputs to produce averages 924 ! Check to make sure that the microphysics code is respecting the flags that control 925 ! whether MG should be prognosing cloud ice and cloud liquid or not. 926 !! calculate effective radius of convective liquid and ice using dcon and deicon (not used by code, not useful for 927 ! COSP) 928 !! hard-coded as average of hard-coded values used for deep/shallow convective detrainment (near line 1502/1505) 929 ! Reassign rate1 if modal aerosols 930 ! Sedimentation velocity for liquid stratus cloud droplet 931 ! Microphysical tendencies for use in the macrophysics at the next time step 932 ! Net micro_mg_cam condensation rate 933 ! For precip, accumulate only total precip in prec_pcw and snow_pcw variables. 934 ! Other precip output variables are set to 0 935 ! Do not subscript by ncol here, because in physpkg we divide the whole 936 ! array and need to avoid an FPE due to uninitialized data. 937 ! ------------------------------------------------------------ ! 938 ! Compute in cloud ice and liquid mixing ratios ! 939 ! Note that 'iclwp, iciwp' are used for radiation computation. ! 940 ! ------------------------------------------------------------ ! 941 ! Calculate cloud fraction for prognostic precip sizes. 942 ! ------------------------------------------------------ ! 943 ! ------------------------------------------------------ ! 944 ! All code from here to the end is on grid columns only ! 945 ! ------------------------------------------------------ ! 946 ! ------------------------------------------------------ ! 947 ! Average the fields which are needed later in this paramterization to be on the grid 948 ! If on subcolumns, average the rest of the pbuf fields which were modified on subcolumns but are not used further in 949 ! this parameterization (no need to assign in the non-subcolumn case -- the else step) 950 ! ------------------------------------- ! 951 ! Size distribution calculation ! 952 ! ------------------------------------- ! 953 ! Calculate rho (on subcolumns if turned on) for size distribution 954 ! parameter calculations and average it if needed 955 ! 956 ! State instead of state_loc to preserve answers for MG1 (and in any 957 ! case, it is unlikely to make much difference). 958 ! Effective radius for cloud liquid, fixed number. 959 ! Effective radius for cloud liquid, and size parameters 960 ! mu_grid and lambdac_grid. 961 ! Calculate ncic on the grid 962 ! Rain/Snow effective diameter. 963 ! Effective radius and diameter for cloud ice. 964 ! Limiters for low cloud fraction. 965 ! ------------------------------------- ! 966 ! Precipitation efficiency Calculation ! 967 ! ------------------------------------- ! 968 !----------------------------------------------------------------------- 969 ! Liquid water path 970 ! Compute liquid water paths, and column condensation 971 ! note: 1e-6 kgho2/kgair/s * 1000. pa / (9.81 m/s2) / 1000 kgh2o/m3 = 1e-7 m/s 972 ! this is 1ppmv of h2o in 10hpa 973 ! alternatively: 0.1 mm/day * 1.e-4 m/mm * 1/86400 day/s = 1.e-9 974 !----------------------------------------------------------------------- 975 ! precipitation efficiency calculation (accumulate cme and precip) 976 !minimum lwp threshold (kg/m3) 977 ! zero out precip efficiency and total averaged precip 978 ! accumulate precip and condensation 979 !----------------------------------------------------------------------- 980 ! vertical average of non-zero accretion, autoconversion and ratio. 981 ! vars: vprco_grid(i),vprao_grid(i),racau_grid(i),cnt_grid 982 ! --------------------- ! 983 ! History Output Fields ! 984 ! --------------------- ! 985 ! Column droplet concentration 986 ! Averaging for new output fields 987 ! Cloud top effective radius and number. 988 ! Evaporation of stratiform precipitation fields for UNICON 989 ! Assign the values to the pbuf pointers if they exist in pbuf 990 ! --------------------------------------------- ! 991 ! General outfield calls for microphysics ! 992 ! --------------------------------------------- ! 993 ! Output a handle of variables which are calculated on the fly 994 ! Output fields which have not been averaged already, averaging if use_subcol_microp is true 995 ! Example subcolumn outfld call 996 ! Output fields which are already on the grid 997 ! ptend_loc is deallocated in physics_update above 998 CONTAINS 999 1000 ! write subroutines 1001 SUBROUTINE kgen_read_real_r8_dim2_alloc(var, kgen_unit, printvar) 1002 INTEGER, INTENT(IN) :: kgen_unit 1003 CHARACTER(*), INTENT(IN), OPTIONAL :: printvar 1004 real(KIND=r8), INTENT(OUT), ALLOCATABLE, DIMENSION(:,:) :: var 1005 LOGICAL :: is_true 1006 INTEGER :: idx1,idx2 1007 INTEGER, DIMENSION(2,2) :: kgen_bound 1008 1009 READ(UNIT = kgen_unit) is_true 1010 1011 IF ( is_true ) THEN 1012 READ(UNIT = kgen_unit) kgen_bound(1, 1) 1013 READ(UNIT = kgen_unit) kgen_bound(2, 1) 1014 READ(UNIT = kgen_unit) kgen_bound(1, 2) 1015 READ(UNIT = kgen_unit) kgen_bound(2, 2) 1016 ALLOCATE(var(kgen_bound(2, 1) - kgen_bound(1, 1) + 1, kgen_bound(2, 2) - kgen_bound(1, 2) + 1)) 1017 READ(UNIT = kgen_unit) var 1018 IF ( PRESENT(printvar) ) THEN 1019 PRINT *, "** " // printvar // " **", var 1020 END IF 1021 END IF 1022 END SUBROUTINE kgen_read_real_r8_dim2_alloc 1023 1024 SUBROUTINE kgen_read_real_r8_dim3_alloc(var, kgen_unit, printvar) 1025 INTEGER, INTENT(IN) :: kgen_unit 1026 CHARACTER(*), INTENT(IN), OPTIONAL :: printvar 1027 real(KIND=r8), INTENT(OUT), ALLOCATABLE, DIMENSION(:,:,:) :: var 1028 LOGICAL :: is_true 1029 INTEGER :: idx1,idx2,idx3 1030 INTEGER, DIMENSION(2,3) :: kgen_bound 1031 1032 READ(UNIT = kgen_unit) is_true 1033 1034 IF ( is_true ) THEN 1035 READ(UNIT = kgen_unit) kgen_bound(1, 1) 1036 READ(UNIT = kgen_unit) kgen_bound(2, 1) 1037 READ(UNIT = kgen_unit) kgen_bound(1, 2) 1038 READ(UNIT = kgen_unit) kgen_bound(2, 2) 1039 READ(UNIT = kgen_unit) kgen_bound(1, 3) 1040 READ(UNIT = kgen_unit) kgen_bound(2, 3) 1041 ALLOCATE(var(kgen_bound(2, 1) - kgen_bound(1, 1) + 1, kgen_bound(2, 2) - kgen_bound(1, 2) + 1, kgen_bound(2, 3) - kgen_bound(1, 3) + 1)) 1042 READ(UNIT = kgen_unit) var 1043 IF ( PRESENT(printvar) ) THEN 1044 PRINT *, "** " // printvar // " **", var 1045 END IF 1046 END IF 1047 END SUBROUTINE kgen_read_real_r8_dim3_alloc 1048 1049 SUBROUTINE kgen_read_real_r8_dim2_ptr(var, kgen_unit, printvar) 1050 INTEGER, INTENT(IN) :: kgen_unit 1051 CHARACTER(*), INTENT(IN), OPTIONAL :: printvar 1052 real(KIND=r8), INTENT(OUT), POINTER, DIMENSION(:,:) :: var 1053 LOGICAL :: is_true 1054 INTEGER :: idx1,idx2 1055 INTEGER, DIMENSION(2,2) :: kgen_bound 1056 1057 READ(UNIT = kgen_unit) is_true 1058 1059 IF ( is_true ) THEN 1060 READ(UNIT = kgen_unit) kgen_bound(1, 1) 1061 READ(UNIT = kgen_unit) kgen_bound(2, 1) 1062 READ(UNIT = kgen_unit) kgen_bound(1, 2) 1063 READ(UNIT = kgen_unit) kgen_bound(2, 2) 1064 ALLOCATE(var(kgen_bound(2, 1) - kgen_bound(1, 1) + 1, kgen_bound(2, 2) - kgen_bound(1, 2) + 1)) 1065 READ(UNIT = kgen_unit) var 1066 IF ( PRESENT(printvar) ) THEN 1067 PRINT *, "** " // printvar // " **", var 1068 END IF 1069 END IF 1070 END SUBROUTINE kgen_read_real_r8_dim2_ptr 1071 1072 SUBROUTINE kgen_read_real_r8_dim1_alloc(var, kgen_unit, printvar) 1073 INTEGER, INTENT(IN) :: kgen_unit 1074 CHARACTER(*), INTENT(IN), OPTIONAL :: printvar 1075 real(KIND=r8), INTENT(OUT), ALLOCATABLE, DIMENSION(:) :: var 1076 LOGICAL :: is_true 1077 INTEGER :: idx1 1078 INTEGER, DIMENSION(2,1) :: kgen_bound 1079 1080 READ(UNIT = kgen_unit) is_true 1081 1082 IF ( is_true ) THEN 1083 READ(UNIT = kgen_unit) kgen_bound(1, 1) 1084 READ(UNIT = kgen_unit) kgen_bound(2, 1) 1085 ALLOCATE(var(kgen_bound(2, 1) - kgen_bound(1, 1) + 1)) 1086 READ(UNIT = kgen_unit) var 1087 IF ( PRESENT(printvar) ) THEN 1088 PRINT *, "** " // printvar // " **", var 1089 END IF 1090 END IF 1091 END SUBROUTINE kgen_read_real_r8_dim1_alloc 1092 1093 1094 ! verify subroutines 1095 SUBROUTINE kgen_verify_real_r8_dim2_alloc( varname, check_status, var, ref_var) 1096 character(*), intent(in) :: varname 1097 type(check_t), intent(inout) :: check_status 1098 real(KIND=r8), intent(in), DIMENSION(:,:), ALLOCATABLE :: var, ref_var 1099 real(KIND=r8) :: nrmsdiff, rmsdiff 1100 real(KIND=r8), allocatable, DIMENSION(:,:) :: temp, temp2 1101 integer :: n 1102 IF ( ALLOCATED(var) ) THEN 1103 check_status%numTotal = check_status%numTotal + 1 1104 IF ( ALL( var == ref_var ) ) THEN 1105 1106 check_status%numIdentical = check_status%numIdentical + 1 1107 if(check_status%verboseLevel > 1) then 1108 WRITE(*,*) 1109 WRITE(*,*) "All elements of ", trim(adjustl(varname)), " are IDENTICAL." 1110 !WRITE(*,*) "KERNEL: ", var 1111 !WRITE(*,*) "REF. : ", ref_var 1112 IF ( ALL( var == 0 ) ) THEN 1113 if(check_status%verboseLevel > 2) then 1114 WRITE(*,*) "All values are zero." 1115 end if 1116 END IF 1117 end if 1118 ELSE 1119 allocate(temp(SIZE(var,dim=1),SIZE(var,dim=2))) 1120 allocate(temp2(SIZE(var,dim=1),SIZE(var,dim=2))) 1121 1122 n = count(var/=ref_var) 1123 where(abs(ref_var) > check_status%minvalue) 1124 temp = ((var-ref_var)/ref_var)**2 1125 temp2 = (var-ref_var)**2 1126 elsewhere 1127 temp = (var-ref_var)**2 1128 temp2 = temp 1129 endwhere 1130 nrmsdiff = sqrt(sum(temp)/real(n)) 1131 rmsdiff = sqrt(sum(temp2)/real(n)) 1132 1133 if(check_status%verboseLevel > 0) then 1134 WRITE(*,*) 1135 WRITE(*,*) trim(adjustl(varname)), " is NOT IDENTICAL." 1136 WRITE(*,*) count( var /= ref_var), " of ", size( var ), " elements are different." 1137 if(check_status%verboseLevel > 1) then 1138 WRITE(*,*) "Average - kernel ", sum(var)/real(size(var)) 1139 WRITE(*,*) "Average - reference ", sum(ref_var)/real(size(ref_var)) 1140 endif 1141 WRITE(*,*) "RMS of difference is ",rmsdiff 1142 WRITE(*,*) "Normalized RMS of difference is ",nrmsdiff 1143 end if 1144 1145 if (nrmsdiff > check_status%tolerance) then 1146 check_status%numFatal = check_status%numFatal+1 1147 else 1148 check_status%numWarning = check_status%numWarning+1 1149 endif 1150 1151 deallocate(temp,temp2) 1152 END IF 1153 END IF 1154 END SUBROUTINE kgen_verify_real_r8_dim2_alloc 1155 1156 SUBROUTINE kgen_verify_real_r8_dim1_alloc( varname, check_status, var, ref_var) 1157 character(*), intent(in) :: varname 1158 type(check_t), intent(inout) :: check_status 1159 real(KIND=r8), intent(in), DIMENSION(:), ALLOCATABLE :: var, ref_var 1160 real(KIND=r8) :: nrmsdiff, rmsdiff 1161 real(KIND=r8), allocatable, DIMENSION(:) :: temp, temp2 1162 integer :: n 1163 IF ( ALLOCATED(var) ) THEN 1164 check_status%numTotal = check_status%numTotal + 1 1165 IF ( ALL( var == ref_var ) ) THEN 1166 1167 check_status%numIdentical = check_status%numIdentical + 1 1168 if(check_status%verboseLevel > 1) then 1169 WRITE(*,*) 1170 WRITE(*,*) "All elements of ", trim(adjustl(varname)), " are IDENTICAL." 1171 !WRITE(*,*) "KERNEL: ", var 1172 !WRITE(*,*) "REF. : ", ref_var 1173 IF ( ALL( var == 0 ) ) THEN 1174 if(check_status%verboseLevel > 2) then 1175 WRITE(*,*) "All values are zero." 1176 end if 1177 END IF 1178 end if 1179 ELSE 1180 allocate(temp(SIZE(var,dim=1))) 1181 allocate(temp2(SIZE(var,dim=1))) 1182 1183 n = count(var/=ref_var) 1184 where(abs(ref_var) > check_status%minvalue) 1185 temp = ((var-ref_var)/ref_var)**2 1186 temp2 = (var-ref_var)**2 1187 elsewhere 1188 temp = (var-ref_var)**2 1189 temp2 = temp 1190 endwhere 1191 nrmsdiff = sqrt(sum(temp)/real(n)) 1192 rmsdiff = sqrt(sum(temp2)/real(n)) 1193 1194 if(check_status%verboseLevel > 0) then 1195 WRITE(*,*) 1196 WRITE(*,*) trim(adjustl(varname)), " is NOT IDENTICAL." 1197 WRITE(*,*) count( var /= ref_var), " of ", size( var ), " elements are different." 1198 if(check_status%verboseLevel > 1) then 1199 WRITE(*,*) "Average - kernel ", sum(var)/real(size(var)) 1200 WRITE(*,*) "Average - reference ", sum(ref_var)/real(size(ref_var)) 1201 endif 1202 WRITE(*,*) "RMS of difference is ",rmsdiff 1203 WRITE(*,*) "Normalized RMS of difference is ",nrmsdiff 1204 end if 1205 1206 if (nrmsdiff > check_status%tolerance) then 1207 check_status%numFatal = check_status%numFatal+1 1208 else 1209 check_status%numWarning = check_status%numWarning+1 1210 endif 1211 1212 deallocate(temp,temp2) 1213 END IF 1214 END IF 1215 END SUBROUTINE kgen_verify_real_r8_dim1_alloc 1216 1217 SUBROUTINE kgen_verify_character( varname, check_status, var, ref_var) 1218 character(*), intent(in) :: varname 1219 type(check_t), intent(inout) :: check_status 1220 character(LEN=128), intent(in) :: var, ref_var 1221 check_status%numTotal = check_status%numTotal + 1 1222 IF ( var == ref_var ) THEN 1223 check_status%numIdentical = check_status%numIdentical + 1 1224 if(check_status%verboseLevel > 1) then 1225 WRITE(*,*) 1226 WRITE(*,*) trim(adjustl(varname)), " is IDENTICAL( ", var, " )." 1227 endif 1228 ELSE 1229 if(check_status%verboseLevel > 0) then 1230 WRITE(*,*) 1231 WRITE(*,*) trim(adjustl(varname)), " is NOT IDENTICAL." 1232 if(check_status%verboseLevel > 2) then 1233 WRITE(*,*) "KERNEL: ", var 1234 WRITE(*,*) "REF. : ", ref_var 1235 end if 1236 end if 1237 check_status%numFatal = check_status%numFatal + 1 1238 END IF 1239 END SUBROUTINE kgen_verify_character 1240 1241 END SUBROUTINE micro_mg_cam_tend 1242 1243 1244 END MODULE micro_mg_cam 1245