MODULE module_lightning_driver CONTAINS SUBROUTINE lightning_init ( & id, itimestep, restart, dt, dx & ,cu_physics,mp_physics,do_radar_ref & ,lightning_option, lightning_dt & ,lightning_start_seconds & ,ltngacttime & ,iccg_prescribed_num, iccg_prescribed_den & ,cellcount_method & ,ids, ide, jds, jde, kds, kde & ,ims, ime, jms, jme, kms, kme & ,its, ite, jts, jte, kts, kte & ,ic_flashcount, ic_flashrate & ,cg_flashcount, cg_flashrate & ) USE module_state_description USE module_wrf_error IMPLICIT NONE INTEGER, INTENT(IN) :: id INTEGER, INTENT(IN) :: itimestep LOGICAL, INTENT(IN) :: restart REAL, INTENT(IN) :: dt,dx INTEGER, INTENT(IN) :: cu_physics,mp_physics,do_radar_ref,lightning_option REAL, INTENT(IN) :: lightning_dt, lightning_start_seconds REAL, INTENT(INOUT) :: ltngacttime REAL, INTENT(IN) :: iccg_prescribed_num, iccg_prescribed_den INTEGER, INTENT(INOUT) :: cellcount_method INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte REAL, OPTIONAL, DIMENSION( ims:ime,jms:jme ), & INTENT(OUT) :: ic_flashcount, ic_flashrate, & cg_flashcount, cg_flashrate CHARACTER (LEN=80) :: message IF (lightning_option .eq. 0) THEN return ENDIF IF ( lightning_dt <= 0. ) THEN CALL nl_set_lightning_dt( id, dt ) ENDIF IF (itimestep .gt. 0 ) THEN return ENDIF ltngacttime = lightning_start_seconds IF (iccg_prescribed_den .eq. 0. .and. iccg_prescribed_num .eq. 0.) THEN CALL wrf_error_fatal3("",94,& ' lightning_init: iccg_prescribed cannot be 0.0/0.0') ENDIF IF (iccg_prescribed_den .ne. 0.) THEN IF (iccg_prescribed_num/iccg_prescribed_den .eq. -1.) THEN CALL wrf_error_fatal3("",99,& ' lightning_init: iccg_prescribed cannot be -1') ENDIF ENDIF ltng_select: SELECT CASE(lightning_option) CASE (ltng_crm_PR92w,ltng_crm_PR92z) IF ( do_radar_ref .eq. 0 .or. mp_physics .eq. 0) THEN CALL wrf_error_fatal3("",114,& ' lightning_init: Selected lightning option requires microphysics and do_radar_ref=1' ) ENDIF WRITE(message, * ) ' lightning_init: CRM lightning option used: ', lightning_option CALL wrf_debug ( 100 , message ) CASE (ltng_cpm_PR92z) IF ( cu_physics .ne. GDSCHEME .and. cu_physics .ne. G3SCHEME .and. cu_physics .ne. GFSCHEME ) THEN CALL wrf_error_fatal3("",124,& ' lightning_init: Selected lightning option requires GD, G3, or GF convective parameterization' ) ENDIF WRITE(message, * ) ' lightning_init: CPM lightning option selected: ', lightning_option CALL wrf_debug ( 100 , message ) CASE (ltng_lpi) WRITE(message, * ) ' lightning_init: LPIM lightning option selected: ', lightning_option CALL wrf_debug ( 100 , message ) CASE DEFAULT CALL wrf_error_fatal3("",137,& ' lightning_init: invalid lightning_option') END SELECT ltng_select IF (restart) return IF ( PRESENT( ic_flashcount ) .and. PRESENT( ic_flashrate ) .and. & PRESENT( cg_flashcount ) .and. PRESENT( cg_flashrate ) ) THEN CALL wrf_debug ( 100 , ' lightning_init: flash initializing lightning flash arrays' ) ic_flashrate(:,:) = 0. ic_flashcount(:,:) = 0. cg_flashrate(:,:) = 0. cg_flashcount(:,:) = 0. ELSE CALL wrf_error_fatal3("",154,& ' lightning_init: flash arrays not present' ) ENDIF IF ( ( cellcount_method .eq. 0 ) .and. (lightning_option .eq. ltng_crm_PR92w )) THEN IF ( (ime-ims+1)*dx .gt. 1E4 ) THEN cellcount_method = 1 WRITE(message, * ) ' lightning_init: setting auto cellcount_method to patch (cellcount_method=1' ELSE cellcount_method = 2 WRITE(message, * ) ' lightning_init: setting auto cellcount_method to domain (cellcount_method=2' ENDIF CALL wrf_debug( 100, message ) ENDIF CALL wrf_debug( 200, ' lightning_init: finishing') END SUBROUTINE lightning_init SUBROUTINE lightning_driver ( & curr_secs, dt, dx, dy, & xlat, xlon, xland, ht, & t_phy, p_phy, rho, u, v, w, & th_phy, pi_phy,dz8w, & z, moist, & ktop_deep, & refl, & current_time, & lightning_option, & lightning_dt, & lightning_start_seconds, & ltngacttime, & flashrate_factor, & iccg_method, & iccg_prescribed_num, & iccg_prescribed_den, & iccg_in_num, iccg_in_den, & cellcount_method, & cldtop_adjustment, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & ic_flashcount, ic_flashrate, & cg_flashcount, cg_flashrate, & lpi & ) USE module_state_description USE module_utility USE module_model_constants USE module_wrf_error USE module_ltng_crmpr92 USE module_ltng_cpmpr92z USE module_ltng_iccg USE module_ltng_lpi IMPLICIT NONE REAL(8), INTENT(IN ) :: curr_secs REAL, INTENT(IN ) :: dt, dx, dy REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: xlat, xlon, xland, ht REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: t_phy, p_phy, rho REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: th_phy, pi_phy, dz8w REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: u, v, w, z REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_moist), INTENT(IN ) :: moist INTEGER, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: ktop_deep REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: refl TYPE(WRFU_Time), INTENT(IN ) :: current_time REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT), OPTIONAL :: LPI INTEGER, INTENT(IN ) :: lightning_option REAL, INTENT(IN ) :: lightning_dt, lightning_start_seconds, flashrate_factor REAL, INTENT(INOUT) :: ltngacttime INTEGER, INTENT(IN ) :: iccg_method REAL, INTENT(IN ) :: iccg_prescribed_num, iccg_prescribed_den REAL, DIMENSION( ims:ime, jms:jme, 12), INTENT(IN ) :: iccg_in_num, iccg_in_den INTEGER, INTENT(IN ) :: cellcount_method REAL, INTENT(IN ) :: cldtop_adjustment INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: ic_flashcount , cg_flashcount REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT( OUT) :: ic_flashrate , cg_flashrate REAL(8) :: LtngActivationTime REAL(8) :: nextTime REAL, DIMENSION( ims:ime, jms:jme ) :: total_flashrate CHARACTER (LEN=80) :: message LOGICAL :: do_ltng REAL, PARAMETER :: reflthreshold = 20. REAL, DIMENSION( kms:kme ) :: cellcount IF ( lightning_option .eq. 0 ) RETURN nextTime = curr_secs + REAL(dt,8) LtngActivationTime = REAL(ltngacttime,8) do_ltng = LtngActivationTime >= curr_secs .and. LtngActivationTime <= nextTime IF( .not. do_ltng ) THEN RETURN ENDIF IF ( lightning_option .eq. ltng_crm_PR92w .or. & lightning_option .eq. ltng_crm_PR92z ) THEN CALL wrf_debug ( 100, ' lightning_driver: determining cloud extents for CRM' ) CALL countCells( & refl, reflthreshold, cellcount_method, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & cellcount ) WRITE(message, * ) ' lightning_driver: Max cell count = ', maxval(cellcount) CALL wrf_debug ( 100, message ) ENDIF CALL wrf_debug ( 100, ' lightning_driver: calculating flash rate' ) flashrate_select: SELECT CASE(lightning_option) CASE( ltng_crm_PR92w ) CALL wrf_debug ( 100, ' lightning_driver: calling Price and Rind 1992 (w_max, CRM)' ) CALL ltng_crmpr92w ( & dx, dy, xland, ht, z, t_phy, & w, refl, reflthreshold, cellcount, & cellcount_method, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & total_flashrate & ) CASE( ltng_crm_PR92z ) CALL wrf_debug ( 100, ' lightning_driver: calling Price and Rind 1992 (z_top, CRM)' ) CALL ltng_crmpr92z ( & dx, dy, xland, ht, z, t_phy, & refl, reflthreshold, cellcount, & cellcount_method, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & total_flashrate & ) CASE( ltng_cpm_PR92z ) CALL wrf_debug ( 100, ' lightning_driver: calling Price and Rind 1992 (z_top, CPM)' ) CALL ltng_cpmpr92z ( & dx, dy, xland, ht, z, t_phy, & ktop_deep, cldtop_adjustment, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & total_flashrate & ) CASE( ltng_lpi ) CALL wrf_debug ( 100, ' lightning_driver: calling Light Potential Index' ) IF(F_QG) THEN CALL calclpi(W=w, & Z=z, & PI_PHY=pi_phy, RHO_PHY=rho, & TH_PHY=TH_PHY,P_PHY=p_phy, & DZ8w=dz8w, & QV=moist(ims,kms,jms,P_QV), & QC=moist(ims,kms,jms,P_QC), & QR=moist(ims,kms,jms,P_QR), & QI=moist(ims,kms,jms,P_QI), & QS=moist(ims,kms,jms,P_QS), & QG=moist(ims,kms,jms,P_QG), & QH=moist(ims,kms,jms,P_QH), & lpi=lpi & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte) ELSE WRITE(wrf_err_message, * ) ' lightning_driver: LPI option needs Microphysics Option with Graupel ' CALL wrf_error_fatal3("",411,& wrf_err_message ) ENDIF CASE DEFAULT WRITE(wrf_err_message, * ) ' lightning_driver: The lightning option does not exist: lightning_opt = ', lightning_option CALL wrf_error_fatal3("",419,& wrf_err_message ) END SELECT flashrate_select CALL wrf_debug ( 100, ' lightning_driver: partitioning IC:CG') iccg_select: SELECT CASE(iccg_method) CASE( 0 ) iccg_select CALL wrf_debug( 100, ' lightning_driver: using option-default IC:CG method' ) iccg_method_default: SELECT CASE(lightning_option) CASE( ltng_crm_PR92w, ltng_crm_PR92z, ltng_cpm_PR92z ) iccg_method_default CALL iccg_boccippio( & xlat, xlon, & iccg_prescribed_num, iccg_prescribed_den, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & total_flashrate, & ic_flashrate, cg_flashrate & ) CASE DEFAULT iccg_method_default CALL wrf_debug ( 100, ' lightning_driver: no method-default IC:CG implemented, using user-prescribed constant') CALL iccg_user_prescribed( & iccg_prescribed_num, & iccg_prescribed_den, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & total_flashrate, & ic_flashrate, cg_flashrate & ) END SELECT iccg_method_default CASE( 1 ) iccg_select WRITE(message, * ) ' lightning_driver: using user-prescribed IC:CG ratio = ', iccg_prescribed_num/iccg_prescribed_den CALL wrf_debug ( 100, message ) CALL iccg_user_prescribed( & iccg_prescribed_num, & iccg_prescribed_den, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & total_flashrate, & ic_flashrate, cg_flashrate & ) CASE( 2 ) iccg_select CALL wrf_debug ( 100, ' lightning_driver: using Boccippio 2001 IC:CG climatology') CALL iccg_boccippio( & xlat, xlon, & iccg_prescribed_num, iccg_prescribed_den, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & total_flashrate, & ic_flashrate, cg_flashrate & ) CASE( 3 ) iccg_select iccg_pr93_select: SELECT CASE(lightning_option) CASE( ltng_crm_PR92w, ltng_crm_PR92z ) iccg_pr93_select CALL wrf_debug ( 100, ' lightning_driver: using Price and Rind 1993 IC:CG ratio (CRM)') CALL iccg_crm_pr93( & refl, reflthreshold, t_phy, z, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & total_flashrate, & ic_flashrate, cg_flashrate & ) CASE DEFAULT iccg_pr93_select CALL wrf_debug ( 100, ' lightning_driver: using Price and Rind 1993 IC:CG ratio (CPM)') CALL iccg_pr93( & ktop_deep, cldtop_adjustment, t_phy, z, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & total_flashrate, & ic_flashrate, cg_flashrate & ) END SELECT iccg_pr93_select CASE( 4 ) iccg_select CALL wrf_debug ( 100, ' lightning_driver: using input IC:CG ratio from iccg_in_(num|den)' ) CALL iccg_input( & iccg_prescribed_num, iccg_prescribed_den, & iccg_in_num, iccg_in_den, current_time, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & total_flashrate, & ic_flashrate, cg_flashrate & ) CASE DEFAULT iccg_select WRITE(wrf_err_message, * ) ' lightning_driver: Invalid IC:CG method (iccg_method) = ', lightning_option CALL wrf_error_fatal3("",547,& wrf_err_message ) END SELECT iccg_select CALL wrf_debug( 200, ' lightning_driver: converting flash rates to flash counts') ic_flashrate(its:ite,jts:jte) = ic_flashrate(its:ite,jts:jte) * flashrate_factor cg_flashrate(its:ite,jts:jte) = cg_flashrate(its:ite,jts:jte) * flashrate_factor ic_flashcount(its:ite,jts:jte) = ic_flashcount(its:ite,jts:jte) + ic_flashrate(its:ite,jts:jte) * lightning_dt cg_flashcount(its:ite,jts:jte) = cg_flashcount(its:ite,jts:jte) + cg_flashrate(its:ite,jts:jte) * lightning_dt do if( REAL(ltngacttime,8) <= nextTime ) then ltngacttime = ltngacttime + lightning_dt else exit endif enddo CALL wrf_debug ( 100, ' lightning_driver: returning from') END SUBROUTINE lightning_driver SUBROUTINE countCells( & refl, reflthreshold, cellcount_method, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & cellcount ) USE module_dm, only: wrf_dm_sum_real IMPLICIT NONE REAL, DIMENSION( ims:ime,kms:kme,jms:jme ), INTENT(IN ) :: refl REAL, INTENT(IN ) :: reflthreshold INTEGER, INTENT(IN ) :: cellcount_method INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte REAL, DIMENSION( kms:kme ), INTENT( OUT) :: cellcount INTEGER :: i,k,j cellcount(kts:kte) = 0. DO j=jts,jte DO k=kts,kte DO i=its,ite IF ( refl(i,k,j) .gt. reflthreshold ) THEN cellcount(k) = cellcount(k) + 1 ENDIF ENDDO ENDDO ENDDO IF ( cellcount_method .eq. 2 ) THEN DO k=kts,kte cellcount(k) = wrf_dm_sum_real(cellcount(k)) ENDDO ENDIF END SUBROUTINE END MODULE module_lightning_driver