1 !WRF:MEDIATION_LAYER:PHYSICS
3 ! Contains initialization subroutine lightning_init and driver subroutine
7 ! 3.5? - rewritten and added init, separate out flash rate
8 ! parameterization from emission
9 ! 3.4.0 - Added cpm option
10 ! 3.3.x - lightning_driver written by M. Barth called in
11 ! emission_driver in chem
13 ! Contact: J. Wong <johnwong@ucar.edu>
15 !**********************************************************************
17 MODULE module_lightning_driver
20 !**********************************************************************
22 ! SUBROUTINE lightning_init
24 ! Performs compatibility checks and zero out flash arrays at first timestep.
26 !**********************************************************************
28 SUBROUTINE lightning_init ( &
29 id, itimestep, restart, dt, dx &
30 ! Namelist control options
31 ,cu_physics,mp_physics,do_radar_ref &
32 ,lightning_option, lightning_dt &
33 ,lightning_start_seconds &
35 ,iccg_prescribed_num, iccg_prescribed_den &
37 ! Order dependent args for domain, mem, and tile dims
38 ,ids, ide, jds, jde, kds, kde &
39 ,ims, ime, jms, jme, kms, kme &
40 ,its, ite, jts, jte, kts, kte &
41 ! IC and CG flash rates and accumulated flash count
42 ,ic_flashcount, ic_flashrate &
43 ,cg_flashcount, cg_flashrate &
45 ,lnox_opt,lnox_passive &
46 ! LNOx tracers (chemistry only)
47 ,lnox_total, lnox_ic, lnox_cg &
50 !-----------------------------------------------------------------
51 USE module_state_description
54 !-----------------------------------------------------------------
56 INTEGER, INTENT(IN) :: id
57 INTEGER, INTENT(IN) :: itimestep
58 LOGICAL, INTENT(IN) :: restart
59 REAL, INTENT(IN) :: dt,dx
60 INTEGER, INTENT(IN) :: cu_physics,mp_physics,do_radar_ref,lightning_option
61 REAL, INTENT(IN) :: lightning_dt, lightning_start_seconds
62 REAL, INTENT(INOUT) :: ltngacttime
63 REAL, INTENT(IN) :: iccg_prescribed_num, iccg_prescribed_den
64 INTEGER, INTENT(INOUT) :: cellcount_method
65 INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
66 ims, ime, jms, jme, kms, kme, &
67 its, ite, jts, jte, kts, kte
69 ! Making these optional just in case qualitative lightning indices get implemented
70 REAL, OPTIONAL, DIMENSION( ims:ime,jms:jme ), &
71 INTENT(OUT) :: ic_flashcount, ic_flashrate, &
72 cg_flashcount, cg_flashrate
75 INTEGER, INTENT(IN) :: lnox_opt
76 LOGICAL, INTENT(IN) :: lnox_passive
77 REAL, OPTIONAL, DIMENSION( ims:ime,kms:kme,jms:jme ), &
78 INTENT(OUT) :: lnox_total, lnox_ic, lnox_cg
81 CHARACTER (LEN=80) :: message
83 !-----------------------------------------------------------------
85 !-- do not reset unless it is the first timestep or lightning_option is on
86 IF (lightning_option .eq. 0) THEN
90 !-- check to see if lightning_dt is less than zero
91 IF ( lightning_dt <= 0. ) THEN
92 CALL nl_set_lightning_dt( id, dt )
95 !-- restarting? Code after this point is only executed on the very
96 ! first time step of the simulation
97 IF (itimestep .gt. 0 ) THEN
101 ltngacttime = lightning_start_seconds
103 !-- check to see if the prescribed IC:CG ratio is valid (0/0 and -1 are not allowed)
104 IF (iccg_prescribed_den .eq. 0. .and. iccg_prescribed_num .eq. 0.) THEN
105 CALL wrf_error_fatal (' lightning_init: iccg_prescribed cannot be 0.0/0.0')
107 IF (iccg_prescribed_den .ne. 0.) THEN
108 IF (iccg_prescribed_num/iccg_prescribed_den .eq. -1.) THEN
109 CALL wrf_error_fatal (' lightning_init: iccg_prescribed cannot be -1')
114 !-- check to see if lightning_option is valid
116 ! Add new schemes here so it is recognized and proper checks are performed
118 ltng_select: SELECT CASE(lightning_option)
120 ! Convective resolved/permitted
121 CASE (ltng_crm_PR92w,ltng_crm_PR92z)
122 IF ( do_radar_ref .eq. 0 .or. mp_physics .eq. 0) THEN
123 CALL wrf_error_fatal( ' lightning_init: Selected lightning option requires microphysics and do_radar_ref=1' )
126 WRITE(message, * ) ' lightning_init: CRM lightning option used: ', lightning_option
127 CALL wrf_debug ( 100 , message )
129 ! Convective parameterized
130 CASE (ltng_cpm_PR92z)
131 IF ( cu_physics .ne. GDSCHEME .and. cu_physics .ne. G3SCHEME .and. cu_physics .ne. GFSCHEME ) THEN
132 CALL wrf_error_fatal( ' lightning_init: Selected lightning option requires GD, G3, or GF convective parameterization' )
135 WRITE(message, * ) ' lightning_init: CPM lightning option selected: ', lightning_option
136 CALL wrf_debug ( 100 , message )
141 WRITE(message, * ) ' lightning_init: LPIM lightning option selected: ', lightning_option
142 CALL wrf_debug ( 100 , message )
144 ! Non-existing options
146 CALL wrf_error_fatal ( ' lightning_init: invalid lightning_option')
147 END SELECT ltng_select
149 !-- do not re-initialize for restarts
153 IF ( PRESENT( ic_flashcount ) .and. PRESENT( ic_flashrate ) .and. &
154 PRESENT( cg_flashcount ) .and. PRESENT( cg_flashrate ) ) THEN
155 CALL wrf_debug ( 100 , ' lightning_init: flash initializing lightning flash arrays' )
157 ic_flashrate(:,:) = 0.
158 ic_flashcount(:,:) = 0.
159 cg_flashrate(:,:) = 0.
160 cg_flashcount(:,:) = 0.
162 CALL wrf_error_fatal ( ' lightning_init: flash arrays not present' )
165 !-- Resolve auto-cellcount method option (cellcount_method=0)
166 IF ( ( cellcount_method .eq. 0 ) .and. (lightning_option .eq. ltng_crm_PR92w )) THEN
167 IF ( (ime-ims+1)*dx .gt. 1E4 ) THEN ! use patch only if path size > 10 km
169 WRITE(message, * ) ' lightning_init: setting auto cellcount_method to patch (cellcount_method=1'
172 WRITE(message, * ) ' lightning_init: setting auto cellcount_method to domain (cellcount_method=2'
174 CALL wrf_debug( 100, message )
177 #if ( WRF_CHEM == 1 )
179 CALL wrf_debug( 100, ' lightning_init: initializing and validating WRF-Chem only arrays and settings')
181 IF ( lnox_opt .ne. lnox_opt_none .and. lightning_option .eq. 0 ) THEN
182 CALL wrf_error_fatal ( ' lightning_init: cannot set LNOx without lightning_option')
185 IF ( lnox_opt .eq. lnox_opt_decaria .and. ( do_radar_ref .eq. 0 .or. mp_physics .eq. 0 ) ) THEN
186 CALL wrf_error_fatal ( ' lightning_init: lnox_opt_decaria requires microphysics and do_radar_ref' )
189 IF (PRESENT( lnox_total )) lnox_total(:,:,:) = 0.
190 IF (PRESENT( lnox_cg )) lnox_cg(:,:,:) = 0.
191 IF (PRESENT( lnox_ic )) lnox_ic(:,:,:) = 0.
195 CALL wrf_debug( 200, ' lightning_init: finishing')
197 END SUBROUTINE lightning_init
200 !**********************************************************************
202 ! SUBROUTINE lightning_driver
204 ! Redirect to the appropriate lightning subroutine.
206 !**********************************************************************
208 SUBROUTINE lightning_driver ( &
209 ! Frequently used prognostics
210 curr_secs, dt, dx, dy, &
211 xlat, xlon, xland, ht, &
212 t_phy, p_phy, rho, u, v, w, &
213 th_phy, pi_phy,dz8w, &
215 ! Scheme specific prognostics
219 ! Mandatory namelist inputs
222 lightning_start_seconds, &
225 ! IC:CG namelist settings
227 iccg_prescribed_num, &
228 iccg_prescribed_den, &
230 iccg_in_num, iccg_in_den, &
231 ! Scheme specific namelist inputs
234 ! Order dependent args for domain, mem, and tile dims
235 ids, ide, jds, jde, kds, kde, &
236 ims, ime, jms, jme, kms, kme, &
237 its, ite, jts, jte, kts, kte, &
238 ! Mandatory outputs for all quantitative schemes
239 ic_flashcount, ic_flashrate, &
240 cg_flashcount, cg_flashrate, &
243 !-----------------------------------------------------------------
245 USE module_state_description
249 USE module_model_constants
252 ! Parameterization options
253 USE module_ltng_crmpr92 ! lightning_option == 1, ltng_crm_PR92w
254 ! lightning_option == 2, ltng_crm_PR92z
255 USE module_ltng_cpmpr92z ! lightning_option == 11, ltng_cpm_PR92z
266 !-----------------------------------------------------------------
268 ! Frequently used prognostics
269 REAL(8), INTENT(IN ) :: curr_secs
270 REAL, INTENT(IN ) :: dt, dx, dy
272 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: xlat, xlon, xland, ht
273 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: t_phy, p_phy, rho
274 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: th_phy, pi_phy, dz8w
275 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: u, v, w, z
276 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_moist), INTENT(IN ) :: moist
278 ! Scheme specific prognostics
279 INTEGER, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: ktop_deep ! model LNB from cu_physics
280 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: refl ! reflectivity from mp_physics
281 TYPE(WRFU_Time), INTENT(IN ) :: current_time ! For use of IC:CG input
283 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT), OPTIONAL :: LPI
284 ! Mandatory namelist inputs
285 INTEGER, INTENT(IN ) :: lightning_option
286 REAL, INTENT(IN ) :: lightning_dt, lightning_start_seconds, flashrate_factor
287 REAL, INTENT(INOUT) :: ltngacttime
289 ! IC:CG namelist settings
290 INTEGER, INTENT(IN ) :: iccg_method
291 REAL, INTENT(IN ) :: iccg_prescribed_num, iccg_prescribed_den
292 REAL, DIMENSION( ims:ime, jms:jme, 12), INTENT(IN ) :: iccg_in_num, iccg_in_den
294 ! Scheme specific namelist inputs
295 INTEGER, INTENT(IN ) :: cellcount_method ! used in CRM
296 REAL, INTENT(IN ) :: cldtop_adjustment ! used in CPM
298 ! Order dependent args for domain, mem, and tile dims
299 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
300 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
301 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
303 ! Mandatory outputs for all quantitative schemes
304 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: ic_flashcount , cg_flashcount
305 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT( OUT) :: ic_flashrate , cg_flashrate
309 REAL(8) :: LtngActivationTime
311 REAL, DIMENSION( ims:ime, jms:jme ) :: total_flashrate
312 CHARACTER (LEN=80) :: message
315 REAL, PARAMETER :: reflthreshold = 20. ! reflectivity threshold for CRM schemes
316 REAL, DIMENSION( kms:kme ) :: cellcount
318 !-----------------------------------------------------------------
320 IF ( lightning_option .eq. 0 ) RETURN
322 nextTime = curr_secs + REAL(dt,8)
323 LtngActivationTime = REAL(ltngacttime,8)
324 do_ltng = LtngActivationTime >= curr_secs .and. LtngActivationTime <= nextTime
326 IF( .not. do_ltng ) THEN
330 !-----------------------------------------------------------------
331 ! This driver performs several steps in order to produce lightning
332 ! flash rate and flash count diagnostics:
334 ! 1. Determine cloud extents for specific CRM schemes
335 ! 2. Total flash rate assignment to 2D array
336 ! 3. Partitioning of total lightning into IC & CG
337 ! 4. Scale flash rate by flashrate_factor and lightning_dt
339 !-----------------------------------------------------------------
341 IF ( lightning_option .eq. ltng_crm_PR92w .or. &
342 lightning_option .eq. ltng_crm_PR92z ) THEN
343 CALL wrf_debug ( 100, ' lightning_driver: determining cloud extents for CRM' )
346 refl, reflthreshold, cellcount_method, &
347 ! Order dependent args for domain, mem, and tile dims
348 ids, ide, jds, jde, kds, kde, &
349 ims, ime, jms, jme, kms, kme, &
350 its, ite, jts, jte, kts, kte, &
353 WRITE(message, * ) ' lightning_driver: Max cell count = ', maxval(cellcount)
354 CALL wrf_debug ( 100, message )
357 !-----------------------------------------------------------------
359 CALL wrf_debug ( 100, ' lightning_driver: calculating flash rate' )
360 flashrate_select: SELECT CASE(lightning_option)
362 ! CRM lightning options
363 CASE( ltng_crm_PR92w )
364 CALL wrf_debug ( 100, ' lightning_driver: calling Price and Rind 1992 (w_max, CRM)' )
366 CALL ltng_crmpr92w ( &
367 ! Frequently used prognostics
368 dx, dy, xland, ht, z, t_phy, &
369 ! Scheme specific prognostics
370 w, refl, reflthreshold, cellcount, &
371 ! Scheme specific namelist inputs
373 ! Order dependent args for domain, mem, and tile dims
374 ids, ide, jds, jde, kds, kde, &
375 ims, ime, jms, jme, kms, kme, &
376 its, ite, jts, jte, kts, kte, &
377 ! Mandatory output for all quantitative schemes
380 CASE( ltng_crm_PR92z )
381 CALL wrf_debug ( 100, ' lightning_driver: calling Price and Rind 1992 (z_top, CRM)' )
382 CALL ltng_crmpr92z ( &
383 ! Frequently used prognostics
384 dx, dy, xland, ht, z, t_phy, &
385 ! Scheme specific prognostics
386 refl, reflthreshold, cellcount, &
387 ! Scheme specific namelist inputs
389 ! Order dependent args for domain, mem, and tile dims
390 ids, ide, jds, jde, kds, kde, &
391 ims, ime, jms, jme, kms, kme, &
392 its, ite, jts, jte, kts, kte, &
393 ! Mandatory output for all quantitative schemes
396 ! CASE ( another_crm_option)
399 ! CPM lightning options
400 CASE( ltng_cpm_PR92z )
401 CALL wrf_debug ( 100, ' lightning_driver: calling Price and Rind 1992 (z_top, CPM)' )
403 CALL ltng_cpmpr92z ( &
404 ! Frequently used prognostics
405 dx, dy, xland, ht, z, t_phy, &
406 ktop_deep, cldtop_adjustment, &
407 ! Order dependent args for domain, mem, and tile dims
408 ids, ide, jds, jde, kds, kde, &
409 ims, ime, jms, jme, kms, kme, &
410 its, ite, jts, jte, kts, kte, &
411 ! Mandatory output for all quantitative schemes
415 ! LPI lightning options
417 CALL wrf_debug ( 100, ' lightning_driver: calling Light Potential Index' )
421 PI_PHY=pi_phy, RHO_PHY=rho, &
422 TH_PHY=TH_PHY,P_PHY=p_phy, &
424 QV=moist(ims,kms,jms,P_QV), & !Qv=qv_curr
425 QC=moist(ims,kms,jms,P_QC), & !Qc=qc_curr
426 QR=moist(ims,kms,jms,P_QR), & !QR=qr_curr
427 QI=moist(ims,kms,jms,P_QI), & !QI=qi_curr
428 QS=moist(ims,kms,jms,P_QS), & !qs_curr
429 QG=moist(ims,kms,jms,P_QG), & !qg_curr
430 ! QH=moist(ims,kms,jms,P_QH), & !qh_curr
432 ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
433 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
434 ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte)
436 WRITE(wrf_err_message, * ) ' lightning_driver: LPI option needs Microphysics Option with Graupel '
437 CALL wrf_error_fatal ( wrf_err_message )
440 ! CASE ( another_cpm_option)
442 ! Invalid lightning options
444 WRITE(wrf_err_message, * ) ' lightning_driver: The lightning option does not exist: lightning_opt = ', lightning_option
445 CALL wrf_error_fatal ( wrf_err_message )
447 END SELECT flashrate_select
449 IF (lightning_option.eq.3) GOTO 100
451 !-----------------------------------------------------------------
453 CALL wrf_debug ( 100, ' lightning_driver: partitioning IC:CG')
454 iccg_select: SELECT CASE(iccg_method)
455 ! Flash rate option defaults
456 CASE( 0 ) iccg_select
457 CALL wrf_debug( 100, ' lightning_driver: using option-default IC:CG method' )
458 iccg_method_default: SELECT CASE(lightning_option)
460 CASE( ltng_crm_PR92w, ltng_crm_PR92z, ltng_cpm_PR92z ) iccg_method_default
461 CALL iccg_boccippio( &
463 iccg_prescribed_num, iccg_prescribed_den, &
464 ! Order dependent args for domain, mem, and tile dims
465 ids, ide, jds, jde, kds, kde, &
466 ims, ime, jms, jme, kms, kme, &
467 its, ite, jts, jte, kts, kte, &
471 ic_flashrate, cg_flashrate &
474 CASE DEFAULT iccg_method_default
475 CALL wrf_debug ( 100, ' lightning_driver: no method-default IC:CG implemented, using user-prescribed constant')
476 CALL iccg_user_prescribed( &
477 iccg_prescribed_num, &
478 iccg_prescribed_den, &
479 ! Order dependent args for domain, mem, and tile dims
480 ids, ide, jds, jde, kds, kde, &
481 ims, ime, jms, jme, kms, kme, &
482 its, ite, jts, jte, kts, kte, &
486 ic_flashrate, cg_flashrate &
489 END SELECT iccg_method_default
491 ! Used-prescribed constant
492 CASE( 1 ) iccg_select
493 WRITE(message, * ) ' lightning_driver: using user-prescribed IC:CG ratio = ', iccg_prescribed_num/iccg_prescribed_den
494 CALL wrf_debug ( 100, message )
495 CALL iccg_user_prescribed( &
496 iccg_prescribed_num, &
497 iccg_prescribed_den, &
498 ! Order dependent args for domain, mem, and tile dims
499 ids, ide, jds, jde, kds, kde, &
500 ims, ime, jms, jme, kms, kme, &
501 its, ite, jts, jte, kts, kte, &
505 ic_flashrate, cg_flashrate &
508 ! Boccippio et al, 2001
509 CASE( 2 ) iccg_select
510 CALL wrf_debug ( 100, ' lightning_driver: using Boccippio 2001 IC:CG climatology')
511 CALL iccg_boccippio( &
513 iccg_prescribed_num, iccg_prescribed_den, &
514 ! Order dependent args for domain, mem, and tile dims
515 ids, ide, jds, jde, kds, kde, &
516 ims, ime, jms, jme, kms, kme, &
517 its, ite, jts, jte, kts, kte, &
521 ic_flashrate, cg_flashrate &
524 ! Price and Rind, 1993
525 CASE( 3 ) iccg_select
526 iccg_pr93_select: SELECT CASE(lightning_option)
527 CASE( ltng_crm_PR92w, ltng_crm_PR92z ) iccg_pr93_select
528 CALL wrf_debug ( 100, ' lightning_driver: using Price and Rind 1993 IC:CG ratio (CRM)')
529 CALL iccg_crm_pr93( &
530 refl, reflthreshold, t_phy, z, &
531 ! Order dependent args for domain, mem, and tile dims
532 ids, ide, jds, jde, kds, kde, &
533 ims, ime, jms, jme, kms, kme, &
534 its, ite, jts, jte, kts, kte, &
538 ic_flashrate, cg_flashrate &
541 CASE DEFAULT iccg_pr93_select
542 CALL wrf_debug ( 100, ' lightning_driver: using Price and Rind 1993 IC:CG ratio (CPM)')
544 ktop_deep, cldtop_adjustment, t_phy, z, &
545 ! Order dependent args for domain, mem, and tile dims
546 ids, ide, jds, jde, kds, kde, &
547 ims, ime, jms, jme, kms, kme, &
548 its, ite, jts, jte, kts, kte, &
552 ic_flashrate, cg_flashrate &
554 END SELECT iccg_pr93_select
556 CASE( 4 ) iccg_select
557 CALL wrf_debug ( 100, ' lightning_driver: using input IC:CG ratio from iccg_in_(num|den)' )
559 iccg_prescribed_num, iccg_prescribed_den, &
560 iccg_in_num, iccg_in_den, current_time, &
561 ! Order dependent args for domain, mem, and tile dims
562 ids, ide, jds, jde, kds, kde, &
563 ims, ime, jms, jme, kms, kme, &
564 its, ite, jts, jte, kts, kte, &
568 ic_flashrate, cg_flashrate &
571 ! Invalid IC:CG method
572 CASE DEFAULT iccg_select
573 WRITE(wrf_err_message, * ) ' lightning_driver: Invalid IC:CG method (iccg_method) = ', lightning_option
574 CALL wrf_error_fatal ( wrf_err_message )
576 END SELECT iccg_select
578 !-----------------------------------------------------------------
580 CALL wrf_debug( 200, ' lightning_driver: converting flash rates to flash counts')
582 ic_flashrate(its:ite,jts:jte) = ic_flashrate(its:ite,jts:jte) * flashrate_factor
583 cg_flashrate(its:ite,jts:jte) = cg_flashrate(its:ite,jts:jte) * flashrate_factor
585 ic_flashcount(its:ite,jts:jte) = ic_flashcount(its:ite,jts:jte) + ic_flashrate(its:ite,jts:jte) * lightning_dt
586 cg_flashcount(its:ite,jts:jte) = cg_flashcount(its:ite,jts:jte) + cg_flashrate(its:ite,jts:jte) * lightning_dt
590 if( REAL(ltngacttime,8) <= nextTime ) then
591 ltngacttime = ltngacttime + lightning_dt
597 !-----------------------------------------------------------------
599 CALL wrf_debug ( 100, ' lightning_driver: returning from')
601 END SUBROUTINE lightning_driver
604 !**********************************************************************
606 ! SUBROUTINE countCells
608 ! For counting number of cells where reflectivity exceeds a certain
609 ! threshold. Typically used by CRM schemes to redistribute lightning
610 ! within convective cores.
612 ! Departure from original implementation:
613 ! Output includes domain-wide cellcounts if cellcount_method = 2
615 !**********************************************************************
617 SUBROUTINE countCells( &
619 refl, reflthreshold, cellcount_method, &
620 ! Order dependent args for domain, mem, and tile dims
621 ids, ide, jds, jde, kds, kde, &
622 ims, ime, jms, jme, kms, kme, &
623 its, ite, jts, jte, kts, kte, &
627 USE module_dm, only: wrf_dm_sum_real
630 !-----------------------------------------------------------------
633 REAL, DIMENSION( ims:ime,kms:kme,jms:jme ), INTENT(IN ) :: refl
634 REAL, INTENT(IN ) :: reflthreshold
635 INTEGER, INTENT(IN ) :: cellcount_method
637 ! Order dependent args for domain, mem, and tile dims
638 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
639 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
640 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
644 REAL, DIMENSION( kms:kme ), INTENT( OUT) :: cellcount
649 !-----------------------------------------------------------------
651 cellcount(kts:kte) = 0.
655 IF ( refl(i,k,j) .gt. reflthreshold ) THEN
656 cellcount(k) = cellcount(k) + 1
662 IF ( cellcount_method .eq. 2 ) THEN
664 cellcount(k) = wrf_dm_sum_real(cellcount(k))
670 END MODULE module_lightning_driver