! WRF:MODEL_LAYER:PHYSICS ! ! Lightning flash intracloud/cloud-to-ground (IC:CG) partitioning ! subroutines. Contain multiple common options for use by lightning_driver. ! ! Inputs: total lightning flash rate (#/s) ! Outputs: ic flash rate (#/s), cg flash rate (#/s) ! ! See comments preceeding each method for details ! ! Contact: J. Wong ! !********************************************************************** MODULE module_ltng_iccg CONTAINS !********************************************************************** ! ! User prescribed using iccg_prescribed_num & iccg_prescribed_den ! !********************************************************************** SUBROUTINE iccg_user_prescribed( & iccg_prescribed_num, iccg_prescribed_den, & ! Order dependent args for domain, mem, and tile dims ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe, & ! Input total_flashrate, & ! Output ic_flashrate, cg_flashrate & ) !----------------------------------------------------------------- IMPLICIT NONE !----------------------------------------------------------------- ! IC:CG namelist settings REAL, INTENT(IN ) :: iccg_prescribed_num, iccg_prescribed_den ! Order dependent args for domain, mem, and tile dims INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe ! Primary inputs and outpus REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: total_flashrate REAL, DIMENSION( ims:ime, jms:jme ), INTENT( OUT) :: ic_flashrate, cg_flashrate ! Local variables REAL :: ratio !----------------------------------------------------------------- ic_flashrate(ips:ipe,jps:jpe) = 0. cg_flashrate(ips:ipe,jps:jpe) = 0. ! All IC IF ( iccg_prescribed_den .eq. 0. ) THEN ic_flashrate(ips:ipe,jps:jpe) = total_flashrate(ips:ipe,jps:jpe) RETURN ENDIF ! All CG IF ( iccg_prescribed_num .eq. 0. ) THEN cg_flashrate(ips:ipe,jps:jpe) = total_flashrate(ips:ipe,jps:jpe) RETURN ENDIF ratio = iccg_prescribed_num/iccg_prescribed_den WHERE ( total_flashrate(ips:ipe,jps:jpe) .ne. 0. ) cg_flashrate(ips:ipe,jps:jpe) = total_flashrate(ips:ipe,jps:jpe) * (1./(ratio+1.)) ic_flashrate(ips:ipe,jps:jpe) = total_flashrate(ips:ipe,jps:jpe) - cg_flashrate(ips:ipe,jps:jpe) END WHERE END SUBROUTINE iccg_user_prescribed !********************************************************************** ! ! Boccippio et al 2001 NLDN/OTD 1995-1999 CONUS climatology ! ! Boccippio, D. et al. 2001: Combined Satellite- and Surface-Based Estimation of the Intracloud–Cloud-to-Ground ! Lightning Ratio over the Continental United States. Mon. Wea. Rev., 129, 108–122. ! doi: http://dx.doi.org/10.1175/1520-0493(2001)129<0108:CSASBE>2.0.CO;2 ! ! Areas outside U.S. uses user prescribed ratio defined by iccg_prescribed_num ! & iccg_prescribed_den. ! !********************************************************************** SUBROUTINE iccg_boccippio( & xlat, xlon, & iccg_prescribed_num, iccg_prescribed_den, & ! Order dependent args for domain, mem, and tile dims ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe, & ! Input total_flashrate, & ! Output ic_flashrate, cg_flashrate & ) !----------------------------------------------------------------- IMPLICIT NONE !----------------------------------------------------------------- ! Inputs REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: xlat, xlon REAL, INTENT(IN ) :: iccg_prescribed_num, iccg_prescribed_den ! Order dependent args for domain, mem, and tile dims INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe ! Primary inputs and outpus REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: total_flashrate REAL, DIMENSION( ims:ime, jms:jme ), INTENT( OUT) :: ic_flashrate, cg_flashrate ! Local variables REAL :: prescribed_ratio INTEGER :: i,j ! CONUS and tornado alley boundaries REAL, PARAMETER :: conus_lat_min = 25. REAL, PARAMETER :: conus_lat_max = 55. REAL, PARAMETER :: conus_lon_min = -120. REAL, PARAMETER :: conus_lon_max = -70. REAL, PARAMETER :: lon_cut_min = -105. REAL, PARAMETER :: lon_cut_max = -90. REAL, PARAMETER :: alley_cgfrac = .22 ! tornado alley CG fraction REAL, PARAMETER :: else_cgfrac = .4 !----------------------------------------------------------------- prescribed_ratio = iccg_prescribed_num/iccg_prescribed_den ic_flashrate(ips:ipe,jps:jpe) = 0. cg_flashrate(ips:ipe,jps:jpe) = 0. jloop: DO j=jps,jpe iloop: DO i=ips,ipe IF ( total_flashrate(i,j) .gt. 0. ) THEN IF ( (xlat(i,j) .lt. conus_lat_min) .or. & (xlat(i,j) .gt. conus_lat_max) .or. & (xlon(i,j) .lt. conus_lon_min) .or. & (xlon(i,j) .gt. conus_lon_max) ) THEN ! Outside CONUS, use prescribed ratio IF ( iccg_prescribed_den .ne. 0. ) THEN cg_flashrate(i,j) = total_flashrate(i,j) * (1./(prescribed_ratio+1.)) ENDIF ELSE ! Inside CONUS IF((xlon(i,j) .gt. lon_cut_max) .or. (xlon(i,j) .lt. lon_cut_min)) THEN ! Outside tornado alley cg_flashrate(i,j) = total_flashrate(i,j) * else_cgfrac ELSE ! Inside tornado alley cg_flashrate(i,j) = total_flashrate(i,j) * alley_cgfrac ENDIF ENDIF ic_flashrate(i,j) = total_flashrate(i,j) - cg_flashrate(i,j) ENDIF ENDDO iloop ENDDO jloop END SUBROUTINE iccg_boccippio !********************************************************************** ! ! Price and Rind 1993 base on cold cloud depth (CCD) ! ! Price, C. and D. Rind (1993), What determines the cloud‐to‐ground lightning ! fraction in thunderstorms?, Geophys. Res. Lett., 20(6), 463–466, doi:10.1029/93GL00226. ! ! Valid range of CCD is set to 5.5-14 km. Beyond this range CCD is assumed ! to be 5.5 or 14 for continuity. ! !********************************************************************** SUBROUTINE iccg_pr93( & kLNB, cldtop_adjustment, t, z, & ! Order dependent args for domain, mem, and tile dims ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe, & ! Input total_flashrate, & ! Output ic_flashrate, cg_flashrate & ) !----------------------------------------------------------------- IMPLICIT NONE !----------------------------------------------------------------- ! Inputs INTEGER, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: kLNB REAL, INTENT(IN ) :: cldtop_adjustment REAL, DIMENSION( ims:ims, kms:kme, jms:jme ), INTENT(IN ) :: t, z ! Order dependent args for domain, mem, and tile dims INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe ! Primary inputs and outpus REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: total_flashrate REAL, DIMENSION( ims:ime, jms:jme ), INTENT( OUT) :: ic_flashrate, cg_flashrate ! Local variables INTEGER :: kfreeze INTEGER :: i,j,k REAL :: ratio, cgfrac, depth REAL, PARAMETER :: dH_min = 5.5 REAL, PARAMETER :: dH_max = 14. REAL, PARAMETER :: coef_A = 0.021 REAL, PARAMETER :: coef_B = -0.648 REAL, PARAMETER :: coef_C = 7.493 REAL, PARAMETER :: coef_D = -36.54 REAL, PARAMETER :: coef_E = 63.09 !----------------------------------------------------------------- ic_flashrate(ips:ipe,jps:jpe) = 0. cg_flashrate(ips:ipe,jps:jpe) = 0. jloop: DO j=jps,jpe iloop: DO i=ips,ipe IF ( total_flashrate(i,j) .gt. 0.) THEN ! Look for freezing level kfreeze = kLNB(i,j) DO WHILE ( t(i,kfreeze,j) .lt. 273.15 ) kfreeze = kfreeze - 1 ENDDO depth = ( z(i,kLNB(i,j),j) - z(i,kfreeze,j) ) * 1E-3 + cldtop_adjustment IF (depth .le. 0.) CONTINUE depth = max( dH_min, min( dH_max, depth )) ratio = (((coef_A*depth+coef_B )*depth+coef_C)*depth+coef_D)*depth+coef_E cgfrac = 1./(ratio+1.) cg_flashrate(i,j) = total_flashrate(i,j) * cgfrac ic_flashrate(i,j) = total_flashrate(i,j) - cg_flashrate(i,j) ENDIF ENDDO iloop ENDDO jloop END SUBROUTINE iccg_pr93 !********************************************************************** ! ! Gridded user inputs ! ! Gridded input of IC:CG from i0 or 16. Grids without input are denoted ! by 0/0 and will use iccg_prescribed_(num|den) instead. ! !********************************************************************** SUBROUTINE iccg_input( & iccg_prescribed_num, iccg_prescribed_den, & iccg_in_num, iccg_in_den, current_time, & ! Order dependent args for domain, mem, and tile dims ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe, & ! Input total_flashrate, & ! Output ic_flashrate, cg_flashrate & ) !----------------------------------------------------------------- USE module_utility IMPLICIT NONE !----------------------------------------------------------------- ! Inputs REAL, INTENT(IN ) :: iccg_prescribed_num, iccg_prescribed_den REAL, DIMENSION( ims:ime, jms:jme, 12 ), INTENT(IN ) :: iccg_in_num, iccg_in_den TYPE(WRFU_Time), INTENT(IN ) :: current_time ! For use of IC:CG input ! Order dependent args for domain, mem, and tile dims INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe ! Primary inputs and outpus REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: total_flashrate REAL, DIMENSION( ims:ime, jms:jme ), INTENT( OUT) :: ic_flashrate, cg_flashrate ! Local variables REAL :: prescribed_ratio, input_ratio INTEGER :: current_month INTEGER :: i,j !----------------------------------------------------------------- prescribed_ratio = iccg_prescribed_num/iccg_prescribed_den CALL WRFU_TimeGet(current_time,mm=current_month) DO i=ips,ipe DO j=jps,jpe IF (iccg_in_den(i,j,current_month) .eq. 0) THEN IF (iccg_in_num(i,j,current_month) .eq. 0) THEN ! This is the 0/0 case where we use namelist prescribed ratio instead of input cg_flashrate(i,j) = total_flashrate(i,j) * (1./(prescribed_ratio+1.)) ENDIF cg_flashrate(i,j) = total_flashrate(i,j) ELSE input_ratio = iccg_in_num(i,j,current_month)/iccg_in_den(i,j,current_month) cg_flashrate(i,j) = total_flashrate(i,j) * (1./(input_ratio+1.)) ENDIF ENDDO ENDDO ic_flashrate(ips:ipe,jps:jpe) = total_flashrate(ips:ipe,jps:jpe) - cg_flashrate(ips:ipe,jps:jpe) END SUBROUTINE iccg_input !+++ kac +++ !********************************************************************** ! ! This is a custom IC:CG for a specific thunderstorm. Total LMA & NLDN CG ! flashes within 10-minute intervals are used to create IC:CG ratios per ! 10-min intervals for 10-min moving spatial masks. For any storms outside ! of the pre-defined storm masks, the Boccippio climatology is used -- the ! same as iccg_method=2 above. ! ! Boccippio et al 2001 NLDN/OTD 1995-1999 CONUS climatology ! ! Boccippio, D. et al. 2001: Combined Satellite- and Surface-Based Estimation of the Intracloud–Cloud-to-Ground ! Lightning Ratio over the Continental United States. Mon. Wea. Rev., 129, 108–122. ! doi: http://dx.doi.org/10.1175/1520-0493(2001)129<0108:CSASBE>2.0.CO;2 ! ! Areas outside U.S. uses user prescribed ratio defined by iccg_prescribed_num ! & iccg_prescribed_den. ! !********************************************************************** SUBROUTINE iccg_custom( & xlat, xlon, & iccg_prescribed_num, iccg_prescribed_den, & itimestep, dt, & ! Order dependent args for domain, mem, and tile dims ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe, & ! Input total_flashrate, & ! Output ic_flashrate, cg_flashrate & ) !----------------------------------------------------------------- IMPLICIT NONE !----------------------------------------------------------------- ! Inputs REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: xlat, xlon REAL, INTENT(IN ) :: iccg_prescribed_num, iccg_prescribed_den INTEGER, INTENT(IN ) :: itimestep REAL, INTENT(IN ) :: dt ! Order dependent args for domain, mem, and tile dims INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe ! Primary inputs and outpus REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: total_flashrate REAL, DIMENSION( ims:ime, jms:jme ), INTENT( OUT) :: ic_flashrate, cg_flashrate ! Local variables REAL :: prescribed_ratio INTEGER :: i,j,t REAL :: masktime CHARACTER (LEN=250) :: message ! CONUS and tornado alley boundaries REAL, PARAMETER :: conus_lat_min = 25. REAL, PARAMETER :: conus_lat_max = 55. REAL, PARAMETER :: conus_lon_min = -120. REAL, PARAMETER :: conus_lon_max = -70. REAL, PARAMETER :: lon_cut_min = -105. REAL, PARAMETER :: lon_cut_max = -90. REAL, PARAMETER :: alley_cgfrac = .22 ! tornado alley CG fraction REAL, PARAMETER :: else_cgfrac = .4 ! 10-min storm mask boundaries (custom for specific storm) ! The mask_time goes from 22:10:00 (15000s after 18Z) to 02:00:00 (28800s after 18Z) ! because of the 60-min model delay in storm onset. End analysis when aircraft returned. ! I'm starting the time at 22:00:00 (14400s after 18Z) because flashes are grouped in ! 10-min intervals that go from 22:00 GT time LE 22:10. I'm also setting the end time ! to my desired end time, plus one second, so I can do 22:00 GT time LT 22:10:01 and ! still capture my desired time range with the IF statement (22:00:01 to 22:10:00). ! The mask will follow this pattern. ! The observed masks and IC:CG ratios go until 04:19:00Z (or 04:59:00Z model time). REAL, DIMENSION(0:23), PARAMETER :: & mask_s = (/ 14400, 15000, 15600, 16200, 16800, 17400, & 18000, 18600, 19200, 19800, 20400, 21000, & 21600, 22200, 22800, 23400, 24000, 24600, & 25200, 25800, 26400, 27000, 27600, 28200 /) REAL, DIMENSION(0:23), PARAMETER :: & mask_e = (/ 15001, 15601, 16201, 16801, 17401, 18001, & 18601, 19201, 19801, 20401, 21001, 21601, & 22201, 22801, 23401, 24001, 24601, 25201, & 25801, 26401, 27001, 27601, 28201, 28801 /) ! The mask times here are from the model and correspond with 22:00 GT time LE 02:00 model time. REAL, DIMENSION(0:23), PARAMETER :: & mask_left = (/ -98.6251,-98.6251,-98.6216,-98.6218,-98.6202,-98.5303, & -98.4854,-98.4296,-98.3396,-98.2835,-98.2276,-98.2276, & -98.1937,-98.1706,-98.0026,-97.9131,-97.8348,-97.8124, & -97.7564,-97.7005,-97.7004,-97.6447,-97.6223,-97.6110 /) REAL, DIMENSION(0:23), PARAMETER :: & mask_right = (/ -97.9951,-97.8263,-97.6010,-97.4327,-97.4328,-97.4328, & -97.3544,-97.2984,-97.2201,-97.0635,-96.8844,-96.7053, & -96.5377,-96.3153,-96.2045,-96.0932,-96.0605,-95.9270, & -95.7945,-95.6850,-95.5406,-95.5417,-95.4322,-95.3242 /) REAL, DIMENSION(0:23), PARAMETER :: & mask_top = (/ 37.0404, 37.0856, 37.1038, 37.1578, 37.1578, 37.1942, & 37.2123, 37.2485, 37.2667, 37.2847, 37.3114, 37.3379, & 37.3374, 37.2195, 37.1564, 37.1739, 37.0839, 37.0651, & 37.0103, 36.9735, 36.9454, 36.9454, 36.8996, 36.7637 /) REAL, DIMENSION(0:23), PARAMETER :: & mask_bot = (/ 36.8065, 36.7618, 36.2493, 36.2223, 35.9974, 35.9079, & 35.8720, 35.8632, 35.7825, 35.7285, 35.7103, 35.6828, & 35.6193, 35.5644, 35.5103, 35.4559, 35.4558, 35.4370, & 35.3642, 35.2285, 35.2274, 35.1375, 35.0467, 34.9558 /) ! IC:CG ratios REAL, DIMENSION(0:23), PARAMETER :: & mask_iccg = (/ 0.00, 0.00, 3.00, 7.75, 2.00, 1.68, & 0.27, 0.08, 0.86, 3.70, 3.21, 1.25, & 3.29, 5.11, 3.63, 6.85, 5.94, 5.55, & 4.30, 4.67, 6.50, 6.38, 6.88, 8.24 /) !----------------------------------------------------------------- prescribed_ratio = iccg_prescribed_num/iccg_prescribed_den masktime = (itimestep - 1) * dt !masktime seems to be one index ahead of itimestep ! WRITE(message,*)'masktime,itimestep,dt',masktime,itimestep,dt ! CALL wrf_debug(0,message) ic_flashrate(ips:ipe,jps:jpe) = 0. cg_flashrate(ips:ipe,jps:jpe) = 0. jloop: DO j=jps,jpe iloop: DO i=ips,ipe IF ( total_flashrate(i,j) .gt. 0. ) THEN IF ( (xlat(i,j) .lt. conus_lat_min) .or. & (xlat(i,j) .gt. conus_lat_max) .or. & (xlon(i,j) .lt. conus_lon_min) .or. & (xlon(i,j) .gt. conus_lon_max) ) THEN ! Outside CONUS, use prescribed ratio IF ( iccg_prescribed_den .ne. 0. ) THEN cg_flashrate(i,j) = total_flashrate(i,j) * (1./(prescribed_ratio+1.)) ENDIF ELSE ! Inside CONUS IF((xlon(i,j) .gt. lon_cut_max) .or. (xlon(i,j) .lt. lon_cut_min)) THEN ! Outside tornado alley cg_flashrate(i,j) = total_flashrate(i,j) * else_cgfrac ELSE ! Inside tornado alley !+++ kac +++ !BEFORE TIME MASK STARTS IF ( (masktime .le. mask_s(0)) .or. (masktime .ge. mask_e(23)) ) THEN ! Use the Boccippio method outside of the masktime cg_flashrate(i,j) = total_flashrate(i,j) * alley_cgfrac ENDIF !MASK EXISTS SO LOOP THROUGH ALL 10MIN INTERVALS AND DECIDE IF POINT IN OR OUT OF MASK tloop: DO t=0,23 IF ( (masktime .gt. mask_s(t)) .and. (masktime .lt. mask_e(t)) ) THEN IF ( (xlon(i,j) .gt. mask_left(t)) .and. & (xlon(i,j) .lt. mask_right(t)) .and. & (xlat(i,j) .gt. mask_bot(t)) .and. & (xlat(i,j) .lt. mask_top(t)) ) THEN ! Use the custom IC:CG ratios within the specified time and mask cg_flashrate(i,j) = total_flashrate(i,j) * (1./(mask_iccg(t)+1.)) WRITE(message,*)'mask_iccg',mask_iccg(t) CALL wrf_debug(0,message) ELSE ! Use the Boccippio method outside of the mask cg_flashrate(i,j) = total_flashrate(i,j) * alley_cgfrac WRITE(message,*)'alley_cgfrac' CALL wrf_debug(0,message) ENDIF ENDIF ENDDO tloop !--- kac --- !OUTSIDE INSIDE TORNADO ALLEY ENDIF !OUTSIDE INSIDE STATEMENT ENDIF ic_flashrate(i,j) = total_flashrate(i,j) - cg_flashrate(i,j) !END total_flashrate STATEMENT ENDIF ENDDO iloop ENDDO jloop END SUBROUTINE iccg_custom !--- kac --- END MODULE module_ltng_iccg