phys/module_ltng_iccg.F

   1 ! WRF:MODEL_LAYER:PHYSICS
   2 !
   3 ! Lightning flash intracloud/cloud-to-ground (IC:CG) partitioning
   4 ! subroutines. Contain multiple common options for use by lightning_driver.
   5 !
   6 ! Inputs: total lightning flash rate (#/s)
   7 ! Outputs: ic flash rate (#/s), cg flash rate (#/s)
   8 !
   9 ! See comments preceeding each method for details
  10 !
  11 ! Contact: J. Wong <johnwong@ucar.edu>
  12 !
  13 !**********************************************************************
  14
  15
  16  MODULE module_ltng_iccg
  17  CONTAINS
  18
  19 !**********************************************************************
  20 !
  21 ! User prescribed using iccg_prescribed_num & iccg_prescribed_den
  22 !
  23 !**********************************************************************
  24  SUBROUTINE iccg_user_prescribed( &
  25                             iccg_prescribed_num, iccg_prescribed_den,   &
  26                           ! Order dependent args for domain, mem, and tile dims
  27                             ids, ide, jds, jde, kds, kde,               &
  28                             ims, ime, jms, jme, kms, kme,               &
  29                             ips, ipe, jps, jpe, kps, kpe,               &
  30                           ! Input
  31                             total_flashrate,                            &
  32                           ! Output
  33                             ic_flashrate, cg_flashrate                  &
  34                         )
  35 !-----------------------------------------------------------------
  36  IMPLICIT NONE
  37 !-----------------------------------------------------------------
  38
  39 ! IC:CG namelist settings
  40  REAL,    INTENT(IN   )    ::       iccg_prescribed_num, iccg_prescribed_den
  41
  42 ! Order dependent args for domain, mem, and tile dims
  43  INTEGER, INTENT(IN   )    ::       ids,ide, jds,jde, kds,kde
  44  INTEGER, INTENT(IN   )    ::       ims,ime, jms,jme, kms,kme
  45  INTEGER, INTENT(IN   )    ::       ips,ipe, jps,jpe, kps,kpe
  46
  47 ! Primary inputs and outpus
  48  REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   ) :: total_flashrate
  49  REAL, DIMENSION( ims:ime, jms:jme ), INTENT(  OUT) :: ic_flashrate, cg_flashrate
  50
  51 ! Local variables
  52  REAL :: ratio
  53
  54 !-----------------------------------------------------------------
  55  ic_flashrate(ips:ipe,jps:jpe) = 0.
  56  cg_flashrate(ips:ipe,jps:jpe) = 0.
  57
  58 ! All IC
  59  IF ( iccg_prescribed_den .eq. 0. ) THEN
  60     ic_flashrate(ips:ipe,jps:jpe) = total_flashrate(ips:ipe,jps:jpe)
  61     RETURN
  62  ENDIF
  63
  64 ! All CG
  65  IF ( iccg_prescribed_num .eq. 0. ) THEN
  66     cg_flashrate(ips:ipe,jps:jpe) = total_flashrate(ips:ipe,jps:jpe)
  67     RETURN
  68  ENDIF
  69
  70  ratio = iccg_prescribed_num/iccg_prescribed_den
  71
  72  WHERE ( total_flashrate(ips:ipe,jps:jpe) .ne. 0. )
  73     cg_flashrate(ips:ipe,jps:jpe) = total_flashrate(ips:ipe,jps:jpe) * (1./(ratio+1.))
  74     ic_flashrate(ips:ipe,jps:jpe) = total_flashrate(ips:ipe,jps:jpe) - cg_flashrate(ips:ipe,jps:jpe)
  75  END WHERE
  76
  77  END SUBROUTINE iccg_user_prescribed
  78
  79
  80
  81 !**********************************************************************
  82 !
  83 ! Boccippio et al 2001 NLDN/OTD 1995-1999 CONUS climatology
  84 !
  85 ! Boccippio, D. et al. 2001: Combined Satellite- and Surface-Based Estimation of the Intracloud-Cloud-to-Ground
  86 ! Lightning Ratio over the Continental United States. Mon. Wea. Rev., 129, 108-122.
  87 ! doi: http://dx.doi.org/10.1175/1520-0493(2001)129<0108:CSASBE>2.0.CO;2
  88 !
  89 ! Areas outside U.S. uses user prescribed ratio defined by iccg_prescribed_num
  90 ! & iccg_prescribed_den.
  91 !
  92 !**********************************************************************
  93  SUBROUTINE iccg_boccippio( &
  94                             xlat, xlon,                                &
  95                             iccg_prescribed_num, iccg_prescribed_den,  &
  96                           ! Order dependent args for domain, mem, and tile dims
  97                             ids, ide, jds, jde, kds, kde,              &
  98                             ims, ime, jms, jme, kms, kme,              &
  99                             ips, ipe, jps, jpe, kps, kpe,              &
 100                           ! Input
 101                             total_flashrate,                           &
 102                           ! Output
 103                             ic_flashrate, cg_flashrate                 &
 104                         )
 105 !-----------------------------------------------------------------
 106  IMPLICIT NONE
 107 !-----------------------------------------------------------------
 108 ! Inputs
 109  REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   ) :: xlat, xlon
 110  REAL,                                INTENT(IN   ) :: iccg_prescribed_num, iccg_prescribed_den
 111
 112 ! Order dependent args for domain, mem, and tile dims
 113  INTEGER, INTENT(IN   )    ::       ids,ide, jds,jde, kds,kde
 114  INTEGER, INTENT(IN   )    ::       ims,ime, jms,jme, kms,kme
 115  INTEGER, INTENT(IN   )    ::       ips,ipe, jps,jpe, kps,kpe
 116
 117 ! Primary inputs and outpus
 118  REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   ) :: total_flashrate
 119  REAL, DIMENSION( ims:ime, jms:jme ), INTENT(  OUT) :: ic_flashrate, cg_flashrate
 120
 121 ! Local variables
 122  REAL :: prescribed_ratio
 123  INTEGER :: i,j
 124 ! CONUS and tornado alley boundaries
 125  REAL, PARAMETER :: conus_lat_min = 25.
 126  REAL, PARAMETER :: conus_lat_max = 55.
 127  REAL, PARAMETER :: conus_lon_min = -120.
 128  REAL, PARAMETER :: conus_lon_max = -70.
 129  REAL, PARAMETER :: lon_cut_min   = -105.
 130  REAL, PARAMETER :: lon_cut_max   = -90.
 131  REAL, PARAMETER :: alley_cgfrac  = .22  ! tornado alley CG fraction
 132  REAL, PARAMETER :: else_cgfrac   = .4
 133 !-----------------------------------------------------------------
 134  prescribed_ratio = iccg_prescribed_num/iccg_prescribed_den
 135
 136  ic_flashrate(ips:ipe,jps:jpe) = 0.
 137  cg_flashrate(ips:ipe,jps:jpe) = 0.
 138
 139  jloop: DO j=jps,jpe
 140     iloop: DO i=ips,ipe
 141     IF ( total_flashrate(i,j) .gt. 0. ) THEN
 142         IF ( (xlat(i,j) .lt. conus_lat_min) .or. &
 143              (xlat(i,j) .gt. conus_lat_max) .or. &
 144              (xlon(i,j) .lt. conus_lon_min) .or. &
 145              (xlon(i,j) .gt. conus_lon_max) ) THEN
 146             ! Outside CONUS, use prescribed ratio
 147             IF ( iccg_prescribed_den .ne. 0. ) THEN
 148                 cg_flashrate(i,j) = total_flashrate(i,j) * (1./(prescribed_ratio+1.))
 149             ENDIF
 150         ELSE
 151             ! Inside CONUS
 152             IF((xlon(i,j) .gt. lon_cut_max) .or. (xlon(i,j) .lt. lon_cut_min)) THEN
 153                 ! Outside tornado alley
 154                 cg_flashrate(i,j) = total_flashrate(i,j) * else_cgfrac
 155             ELSE
 156                 ! Inside tornado alley
 157                 cg_flashrate(i,j) = total_flashrate(i,j) * alley_cgfrac
 158             ENDIF
 159         ENDIF
 160
 161         ic_flashrate(i,j) = total_flashrate(i,j) - cg_flashrate(i,j)
 162     ENDIF
 163     ENDDO iloop
 164  ENDDO jloop
 165
 166  END SUBROUTINE iccg_boccippio
 167
 168
 169 !**********************************************************************
 170 !
 171 ! Price and Rind 1993 base on cold cloud depth (CCD)
 172 !
 173 ! Price, C. and D. Rind (1993), What determines the cloud-to-ground lightning
 174 ! fraction in thunderstorms?, Geophys. Res. Lett., 20(6), 463-466, doi:10.1029/93GL00226.
 175 !
 176 ! Valid range of CCD is set to 5.5-14 km. Beyond this range CCD is assumed
 177 ! to be 5.5 or 14 for continuity.
 178 !
 179 !**********************************************************************
 180  SUBROUTINE iccg_pr93( &
 181                             kLNB, cldtop_adjustment, t, z,             &
 182                           ! Order dependent args for domain, mem, and tile dims
 183                             ids, ide, jds, jde, kds, kde,              &
 184                             ims, ime, jms, jme, kms, kme,              &
 185                             ips, ipe, jps, jpe, kps, kpe,              &
 186                           ! Input
 187                             total_flashrate,                           &
 188                           ! Output
 189                             ic_flashrate, cg_flashrate                 &
 190                         )
 191 !-----------------------------------------------------------------
 192  IMPLICIT NONE
 193 !-----------------------------------------------------------------
 194 ! Inputs
 195  INTEGER, DIMENSION( ims:ime,          jms:jme ), INTENT(IN   ) :: kLNB
 196  REAL,                                            INTENT(IN   ) :: cldtop_adjustment
 197  REAL,    DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN   ) :: t, z
 198
 199 ! Order dependent args for domain, mem, and tile dims
 200  INTEGER, INTENT(IN   )    ::       ids,ide, jds,jde, kds,kde
 201  INTEGER, INTENT(IN   )    ::       ims,ime, jms,jme, kms,kme
 202  INTEGER, INTENT(IN   )    ::       ips,ipe, jps,jpe, kps,kpe
 203
 204 ! Primary inputs and outpus
 205  REAL,    DIMENSION( ims:ime,          jms:jme ), INTENT(IN   ) :: total_flashrate
 206  REAL,    DIMENSION( ims:ime,          jms:jme ), INTENT(  OUT) :: ic_flashrate, cg_flashrate
 207
 208 ! Local variables
 209  INTEGER :: kfreeze
 210
 211  INTEGER :: i,j,k
 212  REAL    :: ratio, cgfrac, depth
 213
 214  REAL, PARAMETER :: dH_min = 5.5
 215  REAL, PARAMETER :: dH_max = 14.
 216
 217  REAL, PARAMETER :: coef_A = 0.021
 218  REAL, PARAMETER :: coef_B = -0.648
 219  REAL, PARAMETER :: coef_C = 7.493
 220  REAL, PARAMETER :: coef_D = -36.54
 221  REAL, PARAMETER :: coef_E = 63.09
 222 !-----------------------------------------------------------------
 223
 224  ic_flashrate(ips:ipe,jps:jpe) = 0.
 225  cg_flashrate(ips:ipe,jps:jpe) = 0.
 226
 227  jloop: DO j=jps,jpe
 228     iloop: DO i=ips,ipe
 229     IF ( total_flashrate(i,j) .gt. 0.) THEN
 230
 231         ! Look for freezing level
 232         kfreeze = kLNB(i,j)
 233         DO WHILE ( t(i,kfreeze,j) .lt. 273.15 )
 234             kfreeze = kfreeze - 1
 235         ENDDO
 236
 237         depth = ( z(i,kLNB(i,j),j) - z(i,kfreeze,j) ) * 1E-3 + cldtop_adjustment
 238         IF (depth .le. 0.) CONTINUE
 239         depth = max( dH_min, min( dH_max, depth ))
 240
 241         ratio = (((coef_A*depth+coef_B )*depth+coef_C)*depth+coef_D)*depth+coef_E
 242         cgfrac = 1./(ratio+1.)
 243
 244         cg_flashrate(i,j) = total_flashrate(i,j) * cgfrac
 245         ic_flashrate(i,j) = total_flashrate(i,j) - cg_flashrate(i,j)
 246     ENDIF
 247     ENDDO iloop
 248  ENDDO jloop
 249
 250  END SUBROUTINE iccg_pr93
 251
 252
 253 !**********************************************************************
 254 !
 255 ! Gridded user inputs
 256 !
 257 ! Gridded input of IC:CG from i0 or 16. Grids without input are denoted
 258 ! by 0/0 and will use iccg_prescribed_(num|den) instead.
 259 !
 260 !**********************************************************************
 261  SUBROUTINE iccg_input( &
 262                             iccg_prescribed_num, iccg_prescribed_den,  &
 263                             iccg_in_num, iccg_in_den, current_time,    &
 264                           ! Order dependent args for domain, mem, and tile dims
 265                             ids, ide, jds, jde, kds, kde,              &
 266                             ims, ime, jms, jme, kms, kme,              &
 267                             ips, ipe, jps, jpe, kps, kpe,              &
 268                           ! Input
 269                             total_flashrate,                           &
 270                           ! Output
 271                             ic_flashrate, cg_flashrate                 &
 272                         )
 273 !-----------------------------------------------------------------
 274  USE module_utility
 275
 276  IMPLICIT NONE
 277 !-----------------------------------------------------------------
 278 ! Inputs
 279  REAL,                                    INTENT(IN   ) :: iccg_prescribed_num, iccg_prescribed_den
 280  REAL, DIMENSION( ims:ime, jms:jme, 12 ), INTENT(IN   ) :: iccg_in_num, iccg_in_den
 281  TYPE(WRFU_Time),                         INTENT(IN   ) :: current_time  ! For use of IC:CG input
 282
 283 ! Order dependent args for domain, mem, and tile dims
 284  INTEGER, INTENT(IN   )    ::       ids,ide, jds,jde, kds,kde
 285  INTEGER, INTENT(IN   )    ::       ims,ime, jms,jme, kms,kme
 286  INTEGER, INTENT(IN   )    ::       ips,ipe, jps,jpe, kps,kpe
 287
 288 ! Primary inputs and outpus
 289  REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   ) :: total_flashrate
 290  REAL, DIMENSION( ims:ime, jms:jme ), INTENT(  OUT) :: ic_flashrate, cg_flashrate
 291
 292 ! Local variables
 293  REAL :: prescribed_ratio, input_ratio
 294  INTEGER :: current_month
 295  INTEGER :: i,j
 296 !-----------------------------------------------------------------
 297  prescribed_ratio = iccg_prescribed_num/iccg_prescribed_den
 298  CALL WRFU_TimeGet(current_time,mm=current_month)
 299
 300  DO i=ips,ipe
 301    DO j=jps,jpe
 302      IF (iccg_in_den(i,j,current_month) .eq. 0) THEN
 303        IF (iccg_in_num(i,j,current_month) .eq. 0) THEN
 304         ! This is the 0/0 case where we use namelist prescribed ratio instead of input
 305          cg_flashrate(i,j) = total_flashrate(i,j) * (1./(prescribed_ratio+1.))
 306        ENDIF
 307        cg_flashrate(i,j) = total_flashrate(i,j)
 308      ELSE
 309        input_ratio = iccg_in_num(i,j,current_month)/iccg_in_den(i,j,current_month)
 310        cg_flashrate(i,j) = total_flashrate(i,j) * (1./(input_ratio+1.))
 311      ENDIF
 312    ENDDO
 313  ENDDO
 314
 315  ic_flashrate(ips:ipe,jps:jpe) = total_flashrate(ips:ipe,jps:jpe) - cg_flashrate(ips:ipe,jps:jpe)
 316
 317  END SUBROUTINE iccg_input
 318
 319
 320  END MODULE module_ltng_iccg