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