phys/module_ltng_crmpr92.F

   1 ! WRF:MODEL_LAYER:PHYSICS
   2 !
   3 ! Lightning flash rate prediction based on max vert. verlocity. Implemented
   4 ! for resolutions permitting resolved deep convection.
   5 !
   6 ! Price, C., and D. Rind (1992), A Simple Lightning Parameterization for Calculating
   7 !   Global Lightning Distributions, J. Geophys. Res., 97(D9), 9919-9933, doi:10.1029/92JD00719.
   8 !
   9 ! Wong, J., M. Barth, and D. Noone (2012), Evaluating a Lightning Parameterization
  10 !   at Resolutions with Partially-Resolved Convection, GMDD, in preparation.
  11 !
  12 ! Unlike previous implementation, this version will produce slightly inconsistent
  13 ! IC and CG grid-flash rates against NO emission after production via calling
  14 ! lightning_nox_decaria.
  15 !
  16 ! Contact: J. Wong <johnwong@ucar.edu>
  17 !
  18 !**********************************************************************
  19
  20  MODULE module_ltng_crmpr92
  21  CONTAINS
  22
  23  SUBROUTINE ltng_crmpr92w ( &
  24                           ! Frequently used prognostics
  25                             dx, dy, xland, ht, z, t,              &
  26                           ! Scheme specific prognostics
  27                             w, refl, reflthreshold, cellcount,    &
  28                           ! Scheme specific namelist inputs
  29                             cellcount_method,                     &
  30                           ! Order dependent args for domain, mem, and tile dims
  31                             ids, ide, jds, jde, kds, kde,         &
  32                             ims, ime, jms, jme, kms, kme,         &
  33                             ips, ipe, jps, jpe, kps, kpe,         &
  34                           ! Mandatory output for all quantitative schemes
  35                             total_flashrate                       &
  36                           )
  37 !-----------------------------------------------------------------
  38 ! Framework
  39  USE module_state_description
  40
  41 ! Model layer
  42  USE module_model_constants
  43  USE module_wrf_error
  44
  45  USE module_dm, only: wrf_dm_max_real
  46
  47  IMPLICIT NONE
  48 !-----------------------------------------------------------------
  49
  50 ! Frequently used prognostics
  51  REAL,    INTENT(IN   )    ::       dx, dy
  52
  53  REAL,    DIMENSION( ims:ime,          jms:jme ), INTENT(IN   ) :: xland, ht
  54  REAL,    DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN   ) :: z, t
  55
  56 ! Scheme specific prognostics
  57  REAL,    DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN   ) :: w
  58  REAL,    DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN   ) :: refl
  59  REAL,                                            INTENT(IN   ) :: reflthreshold
  60  REAL,    DIMENSION(          kms:kme          ), INTENT(IN   ) :: cellcount
  61
  62 ! Scheme specific namelist inputs
  63  INTEGER, INTENT(IN   )    ::       cellcount_method
  64
  65 ! Order dependent args for domain, mem, and tile (patch) dims
  66  INTEGER, INTENT(IN   )    ::       ids,ide, jds,jde, kds,kde
  67  INTEGER, INTENT(IN   )    ::       ims,ime, jms,jme, kms,kme
  68  INTEGER, INTENT(IN   )    ::       ips,ipe, jps,jpe, kps,kpe
  69
  70 ! Mandatory outputs for all quantitative schemes
  71  REAL,    DIMENSION( ims:ime,          jms:jme ), INTENT(  OUT) :: total_flashrate
  72
  73 ! Local variables
  74  REAL :: wmax            ! max w in patch or domain
  75  REAL :: total_fr,ave_fr ! cloud flash rate
  76  INTEGER :: i,k,j
  77  INTEGER :: k_maxcount
  78  REAL :: maxcount
  79  CHARACTER (LEN=250) :: message
  80
  81 !-----------------------------------------------------------------
  82
  83  total_flashrate( ips:ipe,jps:jpe ) = 0.
  84
  85  IF ( maxval(cellcount(kps:kpe)) .eq. 0 ) RETURN
  86
  87 ! Compute flash rate across cell
  88  wmax = maxval(w(ips:ipe,kps:kpe,jps:jpe))
  89  IF ( cellcount_method .eq. 2 ) THEN
  90    wmax = wrf_dm_max_real(wmax)
  91  ENDIF
  92
  93  total_fr = 5.7e-6 * wmax**4.5
  94
  95 ! Locating widest part of convective core
  96  k_maxcount = kps
  97  maxcount = cellcount(kps)
  98  DO k=kps+1,kpe
  99    IF ( cellcount(k) .gt. maxcount ) THEN
 100      k_maxcount = k
 101      maxcount = cellcount(k)
 102    ENDIF
 103  ENDDO
 104
 105 ! Distributing across convective core
 106  ave_fr = total_fr/maxcount/60.
 107  WHERE( refl(ips:ipe,k_maxcount,jps:jpe) .gt. reflthreshold )
 108    total_flashrate(ips:ipe,jps:jpe) = ave_fr
 109  ENDWHERE
 110
 111  END SUBROUTINE ltng_crmpr92w
 112
 113  SUBROUTINE ltng_crmpr92z ( &
 114                           ! Frequently used prognostics
 115                             dx, dy, xland, ht, z, t,              &
 116                           ! Scheme specific prognostics
 117                             refl, reflthreshold, cellcount,       &
 118                           ! Scheme specific namelist inputs
 119                             cellcount_method,                     &
 120                           ! Order dependent args for domain, mem, and tile dims
 121                             ids, ide, jds, jde, kds, kde,         &
 122                             ims, ime, jms, jme, kms, kme,         &
 123                             ips, ipe, jps, jpe, kps, kpe,         &
 124                           ! Mandatory output for all quantitative schemes
 125                             total_flashrate                       &
 126                           )
 127 !-----------------------------------------------------------------
 128 ! Framework
 129  USE module_state_description
 130
 131 ! Model layer
 132  USE module_model_constants
 133  USE module_wrf_error
 134
 135  USE module_dm, only: wrf_dm_max_real
 136
 137  IMPLICIT NONE
 138 !-----------------------------------------------------------------
 139
 140 ! Frequently used prognostics
 141  REAL,    INTENT(IN   )    ::       dx, dy
 142
 143  REAL,    DIMENSION( ims:ime,          jms:jme ), INTENT(IN   ) :: xland, ht
 144  REAL,    DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN   ) :: z, t
 145
 146 ! Scheme specific prognostics
 147  REAL,    DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN   ) :: refl
 148  REAL,                                            INTENT(IN   ) :: reflthreshold
 149  REAL,    DIMENSION(          kms:kme          ), INTENT(IN   ) :: cellcount
 150
 151 ! Scheme specific namelist inputs
 152  INTEGER, INTENT(IN   )    ::       cellcount_method
 153
 154 ! Order dependent args for domain, mem, and tile (patch) dims
 155  INTEGER, INTENT(IN   )    ::       ids,ide, jds,jde, kds,kde
 156  INTEGER, INTENT(IN   )    ::       ims,ime, jms,jme, kms,kme
 157  INTEGER, INTENT(IN   )    ::       ips,ipe, jps,jpe, kps,kpe
 158
 159 ! Mandatory outputs for all quantitative schemes
 160  REAL,    DIMENSION( ims:ime,          jms:jme ), INTENT(  OUT) :: total_flashrate
 161
 162 ! Local variables
 163  REAL :: zmax            ! max w in patch or domain
 164  REAL :: total_fr,ave_fr ! cloud flash rate
 165  INTEGER :: i,k,j
 166  INTEGER :: k_maxcount, count
 167  REAL :: maxcount, mostlyLand
 168  CHARACTER (LEN=250) :: message
 169
 170 !-----------------------------------------------------------------
 171
 172  total_flashrate( ips:ipe,jps:jpe ) = 0.
 173
 174  IF ( maxval(cellcount(kps:kpe)) .eq. 0 ) RETURN
 175
 176 ! Compute flash rate across cell
 177  k = kpe
 178  do while ( cellcount(k) .eq. 0 .and. k .gt. kps)
 179    k = k-1
 180  ENDDO
 181  zmax = 0.
 182  mostlyland = 0.
 183  count = 0
 184  DO i=ips,ipe
 185    DO j=jps,jpe
 186      IF ( (refl(i,k,j) .gt. reflthreshold) .and. (t(i,k,j) .lt. 273.15) ) THEN
 187        IF (z(i,k,j)-ht(i,j) .gt. zmax) THEN
 188          zmax = z(i,k,j)-ht(i,j)
 189        ENDIF
 190        count = count + 1
 191        mostlyland = mostlyland + xland(i,j)
 192      ENDIF
 193    ENDDO
 194  ENDDO
 195  mostlyland = mostlyland/count
 196
 197  zmax = zmax * 1.e-3
 198  WRITE(message, * ) ' ltng_crmpr92z: reflectivity cloud top height: ', zmax
 199  CALL wrf_debug ( 15, message )
 200
 201  if ( cellcount_method .eq. 2 ) THEN
 202    zmax = wrf_dm_max_real(zmax)
 203  endif
 204
 205  if ( mostlyLand .lt. 1.5 ) then
 206     total_fr = 3.44E-5 * (zmax**4.9)  ! PR 92 continental eq
 207  else
 208     total_fr = 6.57E-6 * (zmax**4.9)  ! Michalon 99 marine eq
 209  ENDIF
 210
 211 ! Locating widest part of convective core
 212  k_maxcount = kps
 213  maxcount = cellcount(kps)
 214  DO k=kps+1,kpe
 215    IF ( cellcount(k) .gt. maxcount ) THEN
 216      k_maxcount = k
 217      maxcount = cellcount(k)
 218    ENDIF
 219  ENDDO
 220
 221 ! Distributing across convective core
 222  ave_fr = total_fr/maxcount/60.
 223  WHERE( refl(ips:ipe,k_maxcount,jps:jpe) .gt. reflthreshold  )
 224    total_flashrate(ips:ipe,jps:jpe) = ave_fr
 225  ENDWHERE
 226
 227  END SUBROUTINE ltng_crmpr92z
 228
 229 !**********************************************************************
 230 !
 231 ! Price and Rind 1993 base on cold cloud depth (CCD)
 232 !
 233 ! Price, C. and D. Rind (1993), What determines the cloud-to-ground lightning
 234 ! fraction in thunderstorms?, Geophys. Res. Lett., 20(6), 463-466, doi:10.1029/93GL00226.
 235 !
 236 ! Valid range of CCD is set to 5.5-14 km. Beyond this range CCD is assumed
 237 ! to be 5.5 or 14 for continuity.
 238 !
 239 !**********************************************************************
 240  SUBROUTINE iccg_crm_pr93( &
 241                             refl, reflthreshold, t, z,                 &
 242                           ! Order dependent args for domain, mem, and tile dims
 243                             ids, ide, jds, jde, kds, kde,              &
 244                             ims, ime, jms, jme, kms, kme,              &
 245                             ips, ipe, jps, jpe, kps, kpe,              &
 246                           ! Input
 247                             total_flashrate,                           &
 248                           ! Output
 249                             ic_flashrate, cg_flashrate                 &
 250                         )
 251 !-----------------------------------------------------------------
 252  IMPLICIT NONE
 253 !-----------------------------------------------------------------
 254 ! Inputs
 255  REAL,    DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN   ) :: refl, t, z
 256  REAL,                                            INTENT(IN   ) :: reflthreshold
 257
 258 ! Order dependent args for domain, mem, and tile dims
 259  INTEGER, INTENT(IN   )    ::       ids,ide, jds,jde, kds,kde
 260  INTEGER, INTENT(IN   )    ::       ims,ime, jms,jme, kms,kme
 261  INTEGER, INTENT(IN   )    ::       ips,ipe, jps,jpe, kps,kpe
 262
 263 ! Primary inputs and outpus
 264  REAL,    DIMENSION( ims:ime,          jms:jme ), INTENT(IN   ) :: total_flashrate
 265  REAL,    DIMENSION( ims:ime,          jms:jme ), INTENT(  OUT) :: ic_flashrate, cg_flashrate
 266
 267 ! Local variables
 268  INTEGER :: kfreeze, ktop
 269
 270  INTEGER :: i,j,k
 271  REAL    :: ratio, cgfrac, depth
 272
 273  REAL, PARAMETER :: dH_min = 5.5
 274  REAL, PARAMETER :: dH_max = 14.
 275
 276  REAL, PARAMETER :: coef_A = 0.021
 277  REAL, PARAMETER :: coef_B = -0.648
 278  REAL, PARAMETER :: coef_C = 7.493
 279  REAL, PARAMETER :: coef_D = -36.54
 280  REAL, PARAMETER :: coef_E = 63.09
 281 !-----------------------------------------------------------------
 282
 283  ic_flashrate(ips:ipe,jps:jpe) = 0.
 284  cg_flashrate(ips:ipe,jps:jpe) = 0.
 285
 286  jloop: DO j=jps,jpe
 287     iloop: DO i=ips,ipe
 288     IF ( total_flashrate(i,j) .gt. 0.) THEN
 289         ktop = kpe
 290         do while ( refl(i,ktop,j) .lt. reflthreshold .and. ktop .gt. kps)
 291           ktop = ktop-1
 292         enddo
 293
 294         kfreeze = ktop
 295         DO WHILE ( t(i,kfreeze,j) .lt. 273.15 .and. kfreeze .gt. kps )
 296             kfreeze = kfreeze - 1
 297         ENDDO
 298
 299         depth = ( z(i,ktop,j) - z(i,kfreeze,j) ) * 1E-3
 300         IF (depth .le. 0.) CONTINUE
 301         depth = max( dH_min, min( dH_max, depth ))
 302
 303         ratio = (((coef_A*depth+coef_B )*depth+coef_C)*depth+coef_D)*depth+coef_E
 304         cgfrac = 1./(ratio+1.)
 305
 306         cg_flashrate(i,j) = total_flashrate(i,j) * cgfrac
 307         ic_flashrate(i,j) = total_flashrate(i,j) - cg_flashrate(i,j)
 308     ENDIF
 309     ENDDO iloop
 310  ENDDO jloop
 311
 312  END SUBROUTINE iccg_crm_pr93
 313
 314  END MODULE module_ltng_crmpr92