From b66dd91659af11301877190779f087719bedf4fe Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Fri, 24 Jun 2022 16:44:26 -0600 Subject: [PATCH 01/28] pass lightning flash frequency to mediator for CTSM modified: Externals.cfg modified: bld/build-namelist modified: bld/namelist_files/namelist_definition.xml modified: src/chemistry/mozart/mo_lightning.F90 modified: src/chemistry/pp_none/chemistry.F90 modified: src/control/camsrfexch.F90 modified: src/cpl/nuopc/atm_import_export.F90 modified: src/physics/cam/physpkg.F90 --- Externals.cfg | 4 +- bld/build-namelist | 4 +- bld/namelist_files/namelist_definition.xml | 19 +- src/chemistry/mozart/mo_lightning.F90 | 206 ++++++++++----------- src/chemistry/pp_none/chemistry.F90 | 35 ++-- src/control/camsrfexch.F90 | 2 + src/cpl/nuopc/atm_import_export.F90 | 14 ++ src/physics/cam/physpkg.F90 | 2 +- 8 files changed, 156 insertions(+), 130 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index d18f817c03..b71ac52c0c 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -21,9 +21,9 @@ externals = Externals.cfg required = True [cmeps] -tag = cmeps0.14.5 +branch = lightning_coupling protocol = git -repo_url = https://github.com/ESCOMP/CMEPS.git +repo_url = https://github.com/fvitt/CMEPS.git local_path = components/cmeps required = True diff --git a/bld/build-namelist b/bld/build-namelist index c28f53e2d6..ca6103bae0 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -4049,7 +4049,7 @@ my %nl_group = (); foreach my $name (@nl_groups) { $nl_group{$name} = ''; } # Dry deposition, MEGAN VOC emis and ozone namelists -@comp_groups = qw(drydep_inparm megan_emis_nl fire_emis_nl carma_inparm ndep_inparm ozone_coupling_nl); +@comp_groups = qw(drydep_inparm megan_emis_nl fire_emis_nl carma_inparm ndep_inparm ozone_coupling_nl lightning_coupling_nl); # nature of ozone data passed to surface models -- only if cmeps (nuopc) coupling is used if ($opts{'cmeps'}) { @@ -4058,6 +4058,8 @@ if ($opts{'cmeps'}) { } else { add_default($nl, 'atm_ozone_frequency', 'val'=>'multiday_average'); } + # for lightning flash freq to CTSM + add_default($nl, 'atm_lightning_flash_freq', 'val'=>'.true.'); } $outfile = "$opts{'dir'}/drv_flds_in"; $nl->write($outfile, 'groups'=>\@comp_groups); diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 6608541143..1cd5391035 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -3545,7 +3545,7 @@ Include effects of precip evaporation on turbulent moments Switch for CLUBB_ADV parameter that turns on advection of CLUBB pdf moments by -the dynamics core. Very experimental. +the dynamics core. Very experimental. @@ -3894,7 +3894,7 @@ xpyp only. -Flag to apply a locally calculated ustar to momentum surface fluxes in the +Flag to apply a locally calculated ustar to momentum surface fluxes in the clubb interface. @@ -3960,8 +3960,8 @@ Flag to turn on the clubb monotonic flux limiter for vm (meridional momemtum). -Flag to use an "upwind" discretization rather than a centered discretization -for the portion of the wp3 turbulent advection term for ADG1 that is linearized +Flag to use an "upwind" discretization rather than a centered discretization +for the portion of the wp3 turbulent advection term for ADG1 that is linearized in terms of wp3(t+1). (Requires ADG1 PDF and l_standard_term_ta=true). @@ -3988,7 +3988,7 @@ Flag to use smooth Heaviside 'Peskin' in computation of invrs_tau. -Use the standard discretization for the turbulent advection terms. Setting to +Use the standard discretization for the turbulent advection terms. Setting to .false. means that a_1 and a_3 are pulled outside of the derivative in advance_wp2_wp3_module.F90 and in advance_xp2_xpyp_module.F90. @@ -4070,7 +4070,7 @@ production) term. -Flag used to calculate convective velocity using a variable estimate of layer +Flag used to calculate convective velocity using a variable estimate of layer depth based on the depth over which wpthlp is positive near the ground when true @@ -7268,6 +7268,13 @@ coarser temporal resolution. Default: set by build-namelist. + +If TRUE atmosphere model will provide prognosed lightning flash frequency. +Default: FALSE + + + 0 .or. xno_ndx>0 - if (.not.has_no_lightning_prod) return - - - if( lght_no_prd_factor /= 1._r8 ) then - factor = factor*lght_no_prd_factor - end if - - - if (masterproc) write(iulog,*) 'lght_inti: lightning no production scaling factor = ',factor - - !---------------------------------------------------------------------- - ! ... vdist(kk,itype) = % of lightning nox between (kk-1) and (kk) - ! km for profile itype - !---------------------------------------------------------------------- - vdist(:,1) = (/ 3.0_r8, 3.0_r8, 3.0_r8, 3.0_r8, 3.4_r8, 3.5_r8, 3.6_r8, 4.0_r8, & ! midlat cont - 5.0_r8, 7.0_r8, 9.0_r8, 14.0_r8, 16.0_r8, 14.0_r8, 8.0_r8, 0.5_r8 /) - vdist(:,2) = (/ 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 6.1_r8, & ! trop marine - 17.0_r8, 15.4_r8, 14.5_r8, 13.0_r8, 12.5_r8, 2.8_r8, 0.9_r8, 0.3_r8 /) - vdist(:,3) = (/ 2.0_r8, 2.0_r8, 2.0_r8, 1.5_r8, 1.5_r8, 1.5_r8, 3.0_r8, 5.8_r8, & ! trop cont - 7.6_r8, 9.6_r8, 11.0_r8, 14.0_r8, 14.0_r8, 14.0_r8, 8.2_r8, 2.3_r8 /) - - allocate( prod_no(pcols,pver,begchunk:endchunk),stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'lght_inti: failed to allocate prod_no; error = ',astat - call endrun - end if - allocate( flash_freq(pcols,begchunk:endchunk),stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'lght_inti: failed to allocate flash_freq; error = ',astat - call endrun - end if - allocate( glob_prod_no_col(pcols,begchunk:endchunk),stat=astat ) - if( astat /= 0 ) then - write(iulog,*) 'lght_inti: failed to allocate glob_prod_no_col; error = ',astat - call endrun - end if - prod_no(:,:,:) = 0._r8 - flash_freq(:,:) = 0._r8 - geo_factor = ngcols_p/(4._r8*pi) + character(len=*),parameter :: prefix = 'lightning_inti: ' + + calc_nox_prod = present(lght_no_prd_factor) + + if (calc_nox_prod) then + factor = 0.1_r8*lght_no_prd_factor + + if (masterproc) write(iulog,*) prefix,'lightning no production scaling factor = ',factor + + !---------------------------------------------------------------------- + ! ... vdist(kk,itype) = % of lightning nox between (kk-1) and (kk) + ! km for profile itype + !---------------------------------------------------------------------- + allocate(vdist(16,3),stat=astat) + if( astat /= 0 ) then + write(iulog,*) prefix,'failed to allocate vdist; error = ',astat + call endrun(prefix//'failed to allocate vdist') + end if + vdist(:,1) = (/ 3.0_r8, 3.0_r8, 3.0_r8, 3.0_r8, 3.4_r8, 3.5_r8, 3.6_r8, 4.0_r8, & ! midlat cont + 5.0_r8, 7.0_r8, 9.0_r8, 14.0_r8, 16.0_r8, 14.0_r8, 8.0_r8, 0.5_r8 /) + vdist(:,2) = (/ 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 2.5_r8, 6.1_r8, & ! trop marine + 17.0_r8, 15.4_r8, 14.5_r8, 13.0_r8, 12.5_r8, 2.8_r8, 0.9_r8, 0.3_r8 /) + vdist(:,3) = (/ 2.0_r8, 2.0_r8, 2.0_r8, 1.5_r8, 1.5_r8, 1.5_r8, 3.0_r8, 5.8_r8, & ! trop cont + 7.6_r8, 9.6_r8, 11.0_r8, 14.0_r8, 14.0_r8, 14.0_r8, 8.2_r8, 2.3_r8 /) + + allocate( prod_no(pcols,pver,begchunk:endchunk),stat=astat ) + if( astat /= 0 ) then + write(iulog,*) 'lght_inti: failed to allocate prod_no; error = ',astat + call endrun + end if + geo_factor = ngcols_p/(4._r8*pi) + + call addfld( 'LNO_COL_PROD', horiz_only, 'I', 'TG N/YR', 'lighting column NO source' ) + call addfld( 'LNO_PROD', (/ 'lev' /), 'I', '/cm3/s', 'lighting insitu NO source' ) + call addfld( 'FLASHENGY', horiz_only, 'I', ' ', 'lighting flash rate' ) ! flash frequency in grid box per minute (PPP) + + call phys_getopts( history_cesm_forcing_out = history_cesm_forcing ) + if ( history_cesm_forcing ) then + call add_default('LNO_COL_PROD',1,' ') + endif + endif - call addfld( 'LNO_COL_PROD', horiz_only, 'I', 'TG N/YR', 'lighting column NO source' ) - call addfld( 'LNO_PROD', (/ 'lev' /), 'I', '/cm3/s', 'lighting insitu NO source' ) call addfld( 'FLASHFRQ', horiz_only, 'I', '1/MIN', 'lighting flash rate' ) ! flash frequency in grid box per minute (PPP) - call addfld( 'FLASHENGY', horiz_only, 'I', ' ', 'lighting flash rate' ) ! flash frequency in grid box per minute (PPP) call addfld( 'CLDHGT', horiz_only, 'I', 'KM', 'cloud top height' ) ! cloud top height call addfld( 'DCHGZONE', horiz_only, 'I', 'KM', 'depth of discharge zone' ) ! depth of discharge zone call addfld( 'CGIC', horiz_only, 'I', 'RATIO', 'ratio of cloud-ground/intracloud discharges' ) ! ratio of cloud-ground/intracloud discharges - if ( history_cesm_forcing ) then - call add_default('LNO_COL_PROD',1,' ') - endif - end subroutine lightning_inti - subroutine lightning_no_prod( state, pbuf2d, cam_in ) + subroutine lightning_no_prod( state, pbuf2d, cam_in, cam_out ) !---------------------------------------------------------------------- ! ... set no production from lightning !---------------------------------------------------------------------- use physics_types, only : physics_state - use physics_buffer, only : pbuf_get_index, physics_buffer_desc, pbuf_get_field, pbuf_get_chunk use physconst, only : rga use phys_grid, only : get_rlat_all_p, get_wght_all_p use cam_history, only : outfld - use camsrfexch, only : cam_in_t + use camsrfexch, only : cam_in_t, cam_out_t use shr_reprosum_mod, only : shr_reprosum_calc - use mo_constants, only : rearth, d2r - implicit none + use mo_constants, only : rearth, d2r !---------------------------------------------------------------------- ! ... dummy args @@ -136,6 +118,7 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) type(physics_buffer_desc), pointer :: pbuf2d(:,:) type(cam_in_t), intent(in) :: cam_in(begchunk:endchunk) ! physics state + type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk) ! physics state !---------------------------------------------------------------------- ! ... local variables @@ -172,6 +155,9 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) real(r8) :: rlats(pcols,begchunk:endchunk) ! column latitudes in chunks real(r8) :: wght(pcols) + real(r8) :: glob_prod_no_col(pcols,begchunk:endchunk) + real(r8) :: flash_freq(pcols,begchunk:endchunk) + !---------------------------------------------------------------------- ! ... parameters to determine cg/ic ratio [price and rind, 1993] !---------------------------------------------------------------------- @@ -187,20 +173,21 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) integer :: cldtop_ndx, cldbot_ndx real(r8) :: flash_freq_land, flash_freq_ocn - if (.not.has_no_lightning_prod) return - !---------------------------------------------------------------------- ! ... initialization !---------------------------------------------------------------------- flash_freq(:,:) = 0._r8 - prod_no(:,:,:) = 0._r8 - prod_no_col(:,:) = 0._r8 cldhgt(:,:) = 0._r8 dchgzone(:,:) = 0._r8 cgic(:,:) = 0._r8 flash_energy(:,:) = 0._r8 - glob_prod_no_col(:,:) = 0._r8 + + if (calc_nox_prod) then + prod_no(:,:,:) = 0._r8 + prod_no_col(:,:) = 0._r8 + glob_prod_no_col(:,:) = 0._r8 + end if cldtop_ndx = pbuf_get_index('CLDTOP') cldbot_ndx = pbuf_get_index('CLDBOT') @@ -276,36 +263,51 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) else if( dchgz > 14._r8 ) then cgic(i,c) = .02_r8 end if - !-------------------------------------------------------------------------------- - ! ... compute flash energy (cg*6.7e9 + ic*6.7e8) - ! and convert to total energy per second - ! set ic = cg - !-------------------------------------------------------------------------------- - flash_energy(i,c) = 6.7e9_r8 * flash_freq(i,c)/60._r8 - !-------------------------------------------------------------------------------- - ! ... LKE Aug 23, 2005: scale production to account for different grid - ! box sizes. This requires a reduction in the overall fudge factor - ! (e.g., from 1.2 to 0.5) - !-------------------------------------------------------------------------------- - flash_energy(i,c) = flash_energy(i,c) * wght(i) * geo_factor - !-------------------------------------------------------------------------------- - ! ... compute number of n atoms produced per second - ! and convert to n atoms per second per cm2 and apply fudge factor - !-------------------------------------------------------------------------------- - prod_no_col(i,c) = 1.e17_r8*flash_energy(i,c)/(1.e4_r8*rearth*rearth*wght(i)) * factor - - !-------------------------------------------------------------------------------- - ! ... compute global no production rate in tgn/yr: - ! tgn per second: * 14.00674 * 1.65979e-24 * 1.e-12 - ! nb: 1.65979e-24 = 1/avo - ! tgn per year: * secpyr - !-------------------------------------------------------------------------------- - glob_prod_no_col(i,c) = 1.e17_r8*flash_energy(i,c) & - * 14.00674_r8 * 1.65979e-24_r8 * 1.e-12_r8 * secpyr * factor + cam_out(c)%lightning_flash_freq(i) = flash_freq(i,c)*cgic(i,c) + + if (calc_nox_prod) then + !-------------------------------------------------------------------------------- + ! ... compute flash energy (cg*6.7e9 + ic*6.7e8) + ! and convert to total energy per second + ! set ic = cg + !-------------------------------------------------------------------------------- + flash_energy(i,c) = 6.7e9_r8 * flash_freq(i,c)/60._r8 + !-------------------------------------------------------------------------------- + ! ... LKE Aug 23, 2005: scale production to account for different grid + ! box sizes. This requires a reduction in the overall fudge factor + ! (e.g., from 1.2 to 0.5) + !-------------------------------------------------------------------------------- + flash_energy(i,c) = flash_energy(i,c) * wght(i) * geo_factor + !-------------------------------------------------------------------------------- + ! ... compute number of n atoms produced per second + ! and convert to n atoms per second per cm2 and apply fudge factor + !-------------------------------------------------------------------------------- + prod_no_col(i,c) = 1.e17_r8*flash_energy(i,c)/(1.e4_r8*rearth*rearth*wght(i)) * factor + + !-------------------------------------------------------------------------------- + ! ... compute global no production rate in tgn/yr: + ! tgn per second: * 14.00674 * 1.65979e-24 * 1.e-12 + ! nb: 1.65979e-24 = 1/avo + ! tgn per year: * secpyr + !-------------------------------------------------------------------------------- + glob_prod_no_col(i,c) = 1.e17_r8*flash_energy(i,c) & + * 14.00674_r8 * 1.65979e-24_r8 * 1.e-12_r8 * secpyr * factor + end if end if cloud_layer end do Col_loop end do Chunk_loop + + do c = begchunk,endchunk + lchnk = state(c)%lchnk + call outfld( 'FLASHFRQ', flash_freq(:,c), pcols, lchnk ) + call outfld( 'CGIC', cgic(:,c), pcols, lchnk ) + call outfld( 'CLDHGT', cldhgt(:,c), pcols, lchnk ) + call outfld( 'DCHGZONE', dchgzone(:,c), pcols, lchnk ) + enddo + + if (.not.calc_nox_prod) return + !-------------------------------------------------------------------------------- ! ... Accumulate global total, convert to flashes per second ! ... Accumulate global NO production rate @@ -374,11 +376,7 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) lchnk = state(c)%lchnk call outfld( 'LNO_PROD', prod_no(:,:,c), pcols, lchnk ) call outfld( 'LNO_COL_PROD', glob_prod_no_col(:,c), pcols, lchnk ) - call outfld( 'FLASHFRQ', flash_freq(:,c), pcols, lchnk ) call outfld( 'FLASHENGY', flash_energy(:,c), pcols, lchnk ) - call outfld( 'CLDHGT', cldhgt(:,c), pcols, lchnk ) - call outfld( 'DCHGZONE', dchgzone(:,c), pcols, lchnk ) - call outfld( 'CGIC', cgic(:,c), pcols, lchnk ) enddo end subroutine lightning_no_prod diff --git a/src/chemistry/pp_none/chemistry.F90 b/src/chemistry/pp_none/chemistry.F90 index bdb8c9ae0b..c5d00deb6a 100644 --- a/src/chemistry/pp_none/chemistry.F90 +++ b/src/chemistry/pp_none/chemistry.F90 @@ -7,7 +7,7 @@ module chemistry use shr_kind_mod, only: r8 => shr_kind_r8 use physics_types, only: physics_state, physics_ptend use ppgrid, only: begchunk, endchunk, pcols - + implicit none private @@ -27,7 +27,7 @@ module chemistry public :: chem_write_restart public :: chem_read_restart public :: chem_init_restart - public :: chem_readnl ! read chem namelist + public :: chem_readnl ! read chem namelist public :: chem_reset_fluxes public :: chem_emissions @@ -61,10 +61,10 @@ end function chem_is subroutine chem_register use aero_model, only : aero_model_register - !----------------------------------------------------------------------- - ! + !----------------------------------------------------------------------- + ! ! Purpose: register advected constituents for parameterized greenhouse gas chemistry - ! + ! !----------------------------------------------------------------------- ! for prescribed aerosols @@ -95,12 +95,12 @@ end function chem_is_active !================================================================================================ function chem_implements_cnst(name) - !----------------------------------------------------------------------- - ! + !----------------------------------------------------------------------- + ! ! Purpose: return true if specified constituent is implemented by this package - ! + ! ! Author: B. Eaton - ! + ! !----------------------------------------------------------------------- implicit none !-----------------------------Arguments--------------------------------- @@ -115,14 +115,15 @@ end function chem_implements_cnst !=============================================================================== subroutine chem_init(phys_state, pbuf2d) - !----------------------------------------------------------------------- - ! + !----------------------------------------------------------------------- + ! ! Purpose: initialize parameterized greenhouse gas chemistry ! (declare history variables) - ! + ! !----------------------------------------------------------------------- use physics_buffer, only : physics_buffer_desc use aero_model, only : aero_model_init + use mo_lightning, only : lightning_inti type(physics_state), intent(in):: phys_state(begchunk:endchunk) type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -130,6 +131,8 @@ subroutine chem_init(phys_state, pbuf2d) ! for prescribed aerosols call aero_model_init(pbuf2d) + call lightning_inti() + end subroutine chem_init !=============================================================================== @@ -138,7 +141,7 @@ subroutine chem_timestep_init(phys_state, pbuf2d) use physics_buffer, only : physics_buffer_desc use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, & is_perpetual - type(physics_state), intent(in):: phys_state(begchunk:endchunk) + type(physics_state), intent(in):: phys_state(begchunk:endchunk) type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -162,7 +165,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dt, pbuf, fh2o) type(cam_out_t), intent(in) :: cam_out type(physics_buffer_desc), pointer :: pbuf(:) real(r8), optional, intent(out) :: fh2o(pcols) ! h2o flux to balance source from chemistry - + return end subroutine chem_timestep_tend @@ -215,7 +218,7 @@ subroutine chem_init_restart(File) end subroutine chem_init_restart !================================================================================ subroutine chem_reset_fluxes( fptr, cam_in ) - use camsrfexch, only : cam_in_t + use camsrfexch, only : cam_in_t real(r8), pointer :: fptr(:,:) ! pointer into array data type(cam_in_t), intent(inout) :: cam_in(begchunk:endchunk) @@ -223,7 +226,7 @@ subroutine chem_reset_fluxes( fptr, cam_in ) end subroutine chem_reset_fluxes !================================================================================ subroutine chem_emissions( state, cam_in ) - use camsrfexch, only: cam_in_t + use camsrfexch, only: cam_in_t ! Arguments: diff --git a/src/control/camsrfexch.F90 b/src/control/camsrfexch.F90 index 6715b6f4cd..c49a11139a 100644 --- a/src/control/camsrfexch.F90 +++ b/src/control/camsrfexch.F90 @@ -61,6 +61,7 @@ module camsrfexch real(r8) :: co2prog(pcols) ! prognostic co2 real(r8) :: co2diag(pcols) ! diagnostic co2 real(r8) :: ozone(pcols) ! surface ozone concentration (mole/mole) + real(r8) :: lightning_flash_freq(pcols) ! scaled lightning flash frequency (/min??) real(r8) :: psl(pcols) real(r8) :: bcphiwet(pcols) ! wet deposition of hydrophilic black carbon real(r8) :: bcphidry(pcols) ! dry deposition of hydrophilic black carbon @@ -302,6 +303,7 @@ subroutine atm2hub_alloc( cam_out ) cam_out(c)%co2prog(:) = 0._r8 cam_out(c)%co2diag(:) = 0._r8 cam_out(c)%ozone(:) = 0._r8 + cam_out(c)%lightning_flash_freq= 0._r8 cam_out(c)%psl(:) = 0._r8 cam_out(c)%bcphidry(:) = 0._r8 cam_out(c)%bcphodry(:) = 0._r8 diff --git a/src/cpl/nuopc/atm_import_export.F90 b/src/cpl/nuopc/atm_import_export.F90 index 11e4eb6772..b8cb11ef4a 100644 --- a/src/cpl/nuopc/atm_import_export.F90 +++ b/src/cpl/nuopc/atm_import_export.F90 @@ -151,6 +151,7 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_dens' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_pslv' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_o3' ) + call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_lght' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_rainc' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_rainl' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_snowc' ) @@ -903,6 +904,7 @@ subroutine export_fields( gcomp, cam_out, rc) real(r8), pointer :: fldptr_ptem(:) , fldptr_pslv(:) real(r8), pointer :: fldptr_co2prog(:) , fldptr_co2diag(:) real(r8), pointer :: fldptr_ozone(:) + real(r8), pointer :: fldptr_lght(:) character(len=*), parameter :: subname='(atm_import_export:export_fields)' !--------------------------------------------------------------------------- @@ -1032,6 +1034,18 @@ subroutine export_fields( gcomp, cam_out, rc) end do end if + call state_getfldptr(exportState, 'Sa_lght', fldptr=fldptr_lght, exists=exists, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (exists) then + g = 1 + do c = begchunk,endchunk + do i = 1,get_ncols_p(c) + fldptr_lght(g) = cam_out(c)%lightning_flash_freq(i) ! lightninig flash frequency + g = g + 1 + end do + end do + end if + call state_getfldptr(exportState, 'Sa_co2prog', fldptr=fldptr_co2prog, exists=exists, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (exists) then diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 061591f9ad..4775d69311 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -1253,7 +1253,7 @@ subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, & #endif ! Set lightning production of NO call t_startf ('lightning_no_prod') - call lightning_no_prod( phys_state, pbuf2d, cam_in ) + call lightning_no_prod( phys_state, pbuf2d, cam_in, cam_out ) call t_stopf ('lightning_no_prod') call t_barrierf('sync_ac_physics', mpicom) From 6a89a319d5c3fa68d55cd4f6280ebdd0dd5ebe0e Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 13 Jul 2022 16:46:47 -0600 Subject: [PATCH 02/28] Improve cld-to-grnd lightning documentation; change "atm_lightning_flash_freq" to "atm_provides_lightning"; minor cleanup modified: bld/build-namelist modified: bld/namelist_files/namelist_definition.xml modified: src/chemistry/mozart/mo_lightning.F90 modified: src/chemistry/pp_none/chemistry.F90 modified: src/control/camsrfexch.F90 modified: src/cpl/nuopc/atm_import_export.F90 --- bld/build-namelist | 2 +- bld/namelist_files/namelist_definition.xml | 3 +-- src/chemistry/mozart/mo_lightning.F90 | 9 ++++++--- src/chemistry/pp_none/chemistry.F90 | 2 +- src/control/camsrfexch.F90 | 4 ++-- src/cpl/nuopc/atm_import_export.F90 | 2 +- 6 files changed, 12 insertions(+), 10 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index ca6103bae0..d6a0a0e0e1 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -4059,7 +4059,7 @@ if ($opts{'cmeps'}) { add_default($nl, 'atm_ozone_frequency', 'val'=>'multiday_average'); } # for lightning flash freq to CTSM - add_default($nl, 'atm_lightning_flash_freq', 'val'=>'.true.'); + add_default($nl, 'atm_provides_lightning', 'val'=>'.true.'); } $outfile = "$opts{'dir'}/drv_flds_in"; $nl->write($outfile, 'groups'=>\@comp_groups); diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 1cd5391035..101c675077 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -7268,13 +7268,12 @@ coarser temporal resolution. Default: set by build-namelist. - If TRUE atmosphere model will provide prognosed lightning flash frequency. Default: FALSE - Date: Fri, 15 Jul 2022 08:02:22 -0600 Subject: [PATCH 03/28] Fix restart issue -- use pbuf field for flash freq field modified: src/chemistry/mozart/chemistry.F90 modified: src/chemistry/mozart/mo_chemini.F90 modified: src/chemistry/mozart/mo_lightning.F90 modified: src/chemistry/pp_none/chemistry.F90 modified: src/control/camsrfexch.F90 modified: src/physics/cam/physpkg.F90 --- src/chemistry/mozart/chemistry.F90 | 3 +++ src/chemistry/mozart/mo_chemini.F90 | 2 +- src/chemistry/mozart/mo_lightning.F90 | 34 ++++++++++++++++++++++----- src/chemistry/pp_none/chemistry.F90 | 7 +++++- src/control/camsrfexch.F90 | 11 ++++++++- src/physics/cam/physpkg.F90 | 2 +- 6 files changed, 49 insertions(+), 10 deletions(-) diff --git a/src/chemistry/mozart/chemistry.F90 b/src/chemistry/mozart/chemistry.F90 index 5637ebc1f7..75f889c1b4 100644 --- a/src/chemistry/mozart/chemistry.F90 +++ b/src/chemistry/mozart/chemistry.F90 @@ -320,6 +320,9 @@ subroutine chem_register ! add fields to pbuf needed by aerosol models call aero_model_register() + ! add prognostic lightning flash freq pbuf fld + call lightning_register() + end subroutine chem_register !================================================================================================ diff --git a/src/chemistry/mozart/mo_chemini.F90 b/src/chemistry/mozart/mo_chemini.F90 index d66458e8fc..218aa2314e 100644 --- a/src/chemistry/mozart/mo_chemini.F90 +++ b/src/chemistry/mozart/mo_chemini.F90 @@ -164,7 +164,7 @@ subroutine chemini & !----------------------------------------------------------------------- ! ... initialize the lightning module !----------------------------------------------------------------------- - call lightning_inti(lght_no_prd_factor) + call lightning_inti(pbuf2d,lght_no_prd_factor) if (masterproc) write(iulog,*) 'chemini: after lightning_inti on node ',iam !----------------------------------------------------------------------- diff --git a/src/chemistry/mozart/mo_lightning.F90 b/src/chemistry/mozart/mo_lightning.F90 index 1f924b243a..782a991f45 100644 --- a/src/chemistry/mozart/mo_lightning.F90 +++ b/src/chemistry/mozart/mo_lightning.F90 @@ -10,9 +10,13 @@ module mo_lightning use cam_logfile, only : iulog use spmd_utils, only : masterproc, mpicom + use physics_buffer, only : pbuf_get_index, physics_buffer_desc, pbuf_get_field, pbuf_get_chunk + use physics_buffer, only : pbuf_add_field, pbuf_set_field, dtype_r8 + implicit none private + public :: lightning_register public :: lightning_inti public :: lightning_no_prod public :: prod_no @@ -25,9 +29,22 @@ module mo_lightning logical :: calc_nox_prod = .false. + integer :: flsh_frq_ndx = -1 + contains - subroutine lightning_inti( lght_no_prd_factor ) + !---------------------------------------------------------------------- + ! register phys buffer field for cloud to ground lightning flash frequency + ! to pass to the mediator for land model + !---------------------------------------------------------------------- + subroutine lightning_register() + + call pbuf_add_field('LGHT_FLASH_FREQ','global',dtype_r8,(/pcols/),flsh_frq_ndx) ! per minute + + end subroutine lightning_register + + + subroutine lightning_inti( pbuf2d, lght_no_prd_factor ) !---------------------------------------------------------------------- ! ... initialize the lightning module !---------------------------------------------------------------------- @@ -36,10 +53,12 @@ subroutine lightning_inti( lght_no_prd_factor ) use cam_history, only : addfld, add_default, horiz_only use phys_control, only : phys_getopts + use time_manager, only : is_first_step !---------------------------------------------------------------------- ! ... dummy args !---------------------------------------------------------------------- + type(physics_buffer_desc), pointer :: pbuf2d(:,:) real(r8),optional, intent(in) :: lght_no_prd_factor ! lightning no production factor !---------------------------------------------------------------------- @@ -96,18 +115,20 @@ subroutine lightning_inti( lght_no_prd_factor ) call addfld( 'DCHGZONE', horiz_only, 'I', 'KM', 'depth of discharge zone' ) ! depth of discharge zone call addfld( 'CGIC', horiz_only, 'I', 'RATIO', 'ratio of cloud-ground/intracloud discharges' ) ! ratio of cloud-ground/intracloud discharges + if (is_first_step()) then + call pbuf_set_field(pbuf2d, flsh_frq_ndx, 0.0_r8) + endif end subroutine lightning_inti - subroutine lightning_no_prod( state, pbuf2d, cam_in, cam_out ) + subroutine lightning_no_prod( state, pbuf2d, cam_in ) !---------------------------------------------------------------------- ! ... set no production from lightning !---------------------------------------------------------------------- use physics_types, only : physics_state - use physics_buffer, only : pbuf_get_index, physics_buffer_desc, pbuf_get_field, pbuf_get_chunk use physconst, only : rga use phys_grid, only : get_rlat_all_p, get_wght_all_p use cam_history, only : outfld - use camsrfexch, only : cam_in_t, cam_out_t + use camsrfexch, only : cam_in_t use shr_reprosum_mod, only : shr_reprosum_calc use mo_constants, only : rearth, d2r @@ -118,7 +139,6 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in, cam_out ) type(physics_buffer_desc), pointer :: pbuf2d(:,:) type(cam_in_t), intent(in) :: cam_in(begchunk:endchunk) ! physics state - type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk) ! physics state !---------------------------------------------------------------------- ! ... local variables @@ -172,6 +192,7 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in, cam_out ) real(r8), parameter :: lat25 = 25._r8*d2r ! 25 degrees latitude in radians integer :: cldtop_ndx, cldbot_ndx real(r8) :: flash_freq_land, flash_freq_ocn + real(r8), pointer :: lightning_flash_freq(:) !---------------------------------------------------------------------- ! ... initialization @@ -213,6 +234,7 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in, cam_out ) Chunk_loop : do c = begchunk,endchunk ncol = state(c)%ncol lchnk = state(c)%lchnk + call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk), flsh_frq_ndx, lightning_flash_freq ) call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk), cldtop_ndx, cldtop ) call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk), cldbot_ndx, cldbot ) zsurf(:ncol) = state(c)%phis(:ncol)*rga @@ -267,7 +289,7 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in, cam_out ) cgic(i,c) = .02_r8 end if - cam_out(c)%lightning_flash_freq(i) = flash_freq(i,c)*cgic(i,c) ! cld-to-grnd flash frq (per min) + lightning_flash_freq(i) = flash_freq(i,c)*cgic(i,c) ! cld-to-grnd flash frq (per min) if (calc_nox_prod) then !-------------------------------------------------------------------------------- diff --git a/src/chemistry/pp_none/chemistry.F90 b/src/chemistry/pp_none/chemistry.F90 index 9aacbf8167..3e1a0adfe4 100644 --- a/src/chemistry/pp_none/chemistry.F90 +++ b/src/chemistry/pp_none/chemistry.F90 @@ -61,6 +61,7 @@ end function chem_is subroutine chem_register use aero_model, only : aero_model_register + use mo_lightning, only : lightning_register !----------------------------------------------------------------------- ! ! Purpose: register advected constituents for parameterized greenhouse gas chemistry @@ -70,6 +71,9 @@ subroutine chem_register ! for prescribed aerosols call aero_model_register() + ! add prognostic lightning flash freq pbuf fld + call lightning_register() + end subroutine chem_register !================================================================================================ @@ -131,7 +135,8 @@ subroutine chem_init(phys_state, pbuf2d) ! for prescribed aerosols call aero_model_init(pbuf2d) - call lightning_inti() + ! prognostic lightning flashes + call lightning_inti(pbuf2d) end subroutine chem_init diff --git a/src/control/camsrfexch.F90 b/src/control/camsrfexch.F90 index 44e0afdbaa..469ef242a0 100644 --- a/src/control/camsrfexch.F90 +++ b/src/control/camsrfexch.F90 @@ -429,7 +429,7 @@ subroutine cam_export(state,cam_out,pbuf) integer :: psl_idx integer :: prec_dp_idx, snow_dp_idx, prec_sh_idx, snow_sh_idx integer :: prec_sed_idx,snow_sed_idx,prec_pcw_idx,snow_pcw_idx - integer :: srf_ozone_idx + integer :: srf_ozone_idx, lightning_idx real(r8), pointer :: psl(:) @@ -442,6 +442,7 @@ subroutine cam_export(state,cam_out,pbuf) real(r8), pointer :: prec_pcw(:) ! total precipitation from Hack convection real(r8), pointer :: snow_pcw(:) ! snow from Hack convection real(r8), pointer :: o3_ptr(:,:), srf_o3_ptr(:) + real(r8), pointer :: lightning_ptr(:) !----------------------------------------------------------------------- lchnk = state%lchnk @@ -459,6 +460,7 @@ subroutine cam_export(state,cam_out,pbuf) prec_pcw_idx = pbuf_get_index('PREC_PCW', errcode=i) snow_pcw_idx = pbuf_get_index('SNOW_PCW', errcode=i) srf_ozone_idx = pbuf_get_index('SRFOZONE', errcode=i) + lightning_idx = pbuf_get_index('LGHT_FLASH_FREQ', errcode=i) if (prec_dp_idx > 0) then call pbuf_get_field(pbuf, prec_dp_idx, prec_dp) @@ -518,6 +520,13 @@ subroutine cam_export(state,cam_out,pbuf) cam_out%ozone(:ncol) = o3_ptr(:ncol,pver) * mwdry/mwo3 ! mole/mole endif + ! get cloud to ground lightning flash freq (/min) to export to surface models + if (lightning_idx>0) then + call pbuf_get_field(pbuf, lightning_idx, lightning_ptr) + cam_out%lightning_flash_freq(:ncol) = lightning_ptr(:ncol) + end if + + ! ! Precipation and snow rates from shallow convection, deep convection and stratiform processes. ! Compute total convective and stratiform precipitation and snow rates diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 4775d69311..9ee1b64e8c 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -1253,7 +1253,7 @@ subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, & #endif ! Set lightning production of NO call t_startf ('lightning_no_prod') - call lightning_no_prod( phys_state, pbuf2d, cam_in, cam_out ) + call lightning_no_prod( phys_state, pbuf2d, cam_in ) call t_stopf ('lightning_no_prod') call t_barrierf('sync_ac_physics', mpicom) From 9f0650e25b61ed86010f0d3bb556d25aae2e398a Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Fri, 15 Jul 2022 12:45:45 -0600 Subject: [PATCH 04/28] Check namelist setting of atm_provides_lightning modified: bld/build-namelist modified: src/cpl/nuopc/atm_import_export.F90 --- bld/build-namelist | 6 +++++- src/cpl/nuopc/atm_import_export.F90 | 10 +++++++++- 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index d6a0a0e0e1..97cbb0b27c 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -4059,7 +4059,11 @@ if ($opts{'cmeps'}) { add_default($nl, 'atm_ozone_frequency', 'val'=>'multiday_average'); } # for lightning flash freq to CTSM - add_default($nl, 'atm_provides_lightning', 'val'=>'.true.'); + if ($phys =~ /cam/) { + add_default($nl, 'atm_provides_lightning', 'val'=>'.true.'); + } else { + add_default($nl, 'atm_provides_lightning', 'val'=>'.false.'); + } } $outfile = "$opts{'dir'}/drv_flds_in"; $nl->write($outfile, 'groups'=>\@comp_groups); diff --git a/src/cpl/nuopc/atm_import_export.F90 b/src/cpl/nuopc/atm_import_export.F90 index bf09168f26..e238fe4eb9 100644 --- a/src/cpl/nuopc/atm_import_export.F90 +++ b/src/cpl/nuopc/atm_import_export.F90 @@ -76,6 +76,7 @@ subroutine read_surface_fields_namelists() use shr_fire_emis_mod , only : shr_fire_emis_readnl use shr_carma_mod , only : shr_carma_readnl use shr_ndep_mod , only : shr_ndep_readnl + use shr_lightning_coupling_mod, only : shr_lightning_coupling_readnl character(len=*), parameter :: nl_file_name = 'drv_flds_in' @@ -105,6 +106,8 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) logical :: flds_co2a ! use case logical :: flds_co2b ! use case logical :: flds_co2c ! use case + logical :: atm_provides_lightning + integer :: ndep_nflds, megan_nflds, emis_nflds character(len=128) :: fldname character(len=*), parameter :: subname='(atm_import_export:advertise_fields)' !------------------------------------------------------------------------------- @@ -151,7 +154,6 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_dens' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_pslv' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_o3' ) - call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_lght' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_rainc' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_rainl' ) call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_snowc' ) @@ -194,6 +196,12 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) call set_active_Faxa_noy(.true.) end if + ! lightning flash freq + call shr_lightning_coupling_readnl("drv_flds_in", atm_provides_lightning) + if (atm_provides_lightning) then + call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_lght') + end if + ! Now advertise above export fields if (masterproc) write(iulog,*) trim(subname)//' advertise export fields' do n = 1,fldsFrAtm_num From 8566caa42019189c6fd016c95313a5f34a42dc1a Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Fri, 15 Jul 2022 18:31:29 -0600 Subject: [PATCH 05/28] calc lightning only when cam phys is used modified: bld/build-namelist modified: src/chemistry/mozart/mo_lightning.F90 --- bld/build-namelist | 2 +- src/chemistry/mozart/mo_lightning.F90 | 22 +++++++++++++++------- 2 files changed, 16 insertions(+), 8 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 97cbb0b27c..5b8fc99e96 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -4059,7 +4059,7 @@ if ($opts{'cmeps'}) { add_default($nl, 'atm_ozone_frequency', 'val'=>'multiday_average'); } # for lightning flash freq to CTSM - if ($phys =~ /cam/) { + if ($phys =~ /^cam/) { add_default($nl, 'atm_provides_lightning', 'val'=>'.true.'); } else { add_default($nl, 'atm_provides_lightning', 'val'=>'.false.'); diff --git a/src/chemistry/mozart/mo_lightning.F90 b/src/chemistry/mozart/mo_lightning.F90 index 782a991f45..284ae40a68 100644 --- a/src/chemistry/mozart/mo_lightning.F90 +++ b/src/chemistry/mozart/mo_lightning.F90 @@ -28,8 +28,10 @@ module mo_lightning real(r8), allocatable :: vdist(:,:) ! vertical distribution of lightning logical :: calc_nox_prod = .false. + logical :: calc_lightning = .false. integer :: flsh_frq_ndx = -1 + integer :: cldtop_ndx = -1, cldbot_ndx = -1 contains @@ -43,7 +45,6 @@ subroutine lightning_register() end subroutine lightning_register - subroutine lightning_inti( pbuf2d, lght_no_prd_factor ) !---------------------------------------------------------------------- ! ... initialize the lightning module @@ -64,11 +65,17 @@ subroutine lightning_inti( pbuf2d, lght_no_prd_factor ) !---------------------------------------------------------------------- ! ... local variables !---------------------------------------------------------------------- - integer :: astat + integer :: astat, err logical :: history_cesm_forcing - character(len=*),parameter :: prefix = 'lightning_inti: ' + + cldtop_ndx = pbuf_get_index('CLDTOP',errcode=err) + cldbot_ndx = pbuf_get_index('CLDBOT',errcode=err) + calc_lightning = cldtop_ndx>0 .and. cldbot_ndx>0 + + if (.not.calc_lightning) return + calc_nox_prod = present(lght_no_prd_factor) if (calc_nox_prod) then @@ -190,10 +197,14 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) real(r8), parameter :: m2km = 1.e-3_r8 real(r8), parameter :: km2cm = 1.e5_r8 real(r8), parameter :: lat25 = 25._r8*d2r ! 25 degrees latitude in radians - integer :: cldtop_ndx, cldbot_ndx + real(r8) :: flash_freq_land, flash_freq_ocn real(r8), pointer :: lightning_flash_freq(:) + if (.not.calc_lightning) return + + nullify(lightning_flash_freq) + !---------------------------------------------------------------------- ! ... initialization !---------------------------------------------------------------------- @@ -210,9 +221,6 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) glob_prod_no_col(:,:) = 0._r8 end if - cldtop_ndx = pbuf_get_index('CLDTOP') - cldbot_ndx = pbuf_get_index('CLDBOT') - !-------------------------------------------------------------------------------- ! ... estimate flash frequency and resulting no emissions ! [price, penner, prather, 1997 (jgr)] From 4afeaae67e7617522e71959cde128cbe52467353 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Fri, 22 Jul 2022 15:25:10 -0600 Subject: [PATCH 06/28] apply namelist scaling factor to flash freq modified: bld/build-namelist modified: bld/namelist_files/namelist_definition.xml modified: src/chemistry/mozart/chemistry.F90 modified: src/chemistry/mozart/mo_chemini.F90 modified: src/chemistry/mozart/mo_lightning.F90 modified: src/control/runtime_opts.F90 modified: src/cpl/nuopc/atm_import_export.F90 --- bld/build-namelist | 6 +- bld/namelist_files/namelist_definition.xml | 8 +-- src/chemistry/mozart/chemistry.F90 | 10 ---- src/chemistry/mozart/mo_chemini.F90 | 4 +- src/chemistry/mozart/mo_lightning.F90 | 68 +++++++++++++++++++--- src/control/runtime_opts.F90 | 2 + src/cpl/nuopc/atm_import_export.F90 | 4 +- 7 files changed, 71 insertions(+), 31 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 5b8fc99e96..98b7f68a06 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3397,14 +3397,16 @@ if ( length($nl->get_value('soil_erod_file'))>0 ) { else { if ($chem =~ /trop_strat/ or $chem =~ /waccm_ma/ or $chem =~ /waccm_tsmlt/ or $chem =~ /trop_mozart/) { add_default($nl, 'dust_emis_fact', 'ver'=>'chem'); - # set scaling of lightning NOx production - add_default($nl, 'lght_no_prd_factor' ); } else { add_default($nl, 'dust_emis_fact'); } } } +if ($phys =~ /^cam/) { + # Lightning scaling + add_default($nl, 'lght_no_prd_factor'); +} # Seasalt emissions tuning factor if ($chem =~ /_mam(\d)/) { diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 101c675077..68bb88be5b 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -6183,14 +6183,8 @@ List of species that are constrained in the stratosphere. Default: set by build-namelist. - -Full pathname of dataset for land mask applied to the lighting NOx production -Default: set by build-namelist. - - + group="lightning_nl" valid_values="" > Multiplication factor applied to the lighting NOx production Default: 1.0. diff --git a/src/chemistry/mozart/chemistry.F90 b/src/chemistry/mozart/chemistry.F90 index 75f889c1b4..9ff7fc7fa2 100644 --- a/src/chemistry/mozart/chemistry.F90 +++ b/src/chemistry/mozart/chemistry.F90 @@ -59,10 +59,6 @@ module chemistry character(len=shr_kind_cl) :: bndtvg = ' ' ! pathname for greenhouse gas loss rate character(len=shr_kind_cl) :: h2orates = ' ' ! pathname for greenhouse gas (lyman-alpha H2O loss) - ! lightning - - real(r8) :: lght_no_prd_factor = 1._r8 - ! photolysis character(len=shr_kind_cl) :: rsf_file = 'rsf_file' @@ -380,7 +376,6 @@ subroutine chem_readnl(nlfile) xs_coef_file, xs_short_file, & exo_coldens_file, & xs_long_file, rsf_file, photo_max_zen, & - lght_no_prd_factor, & depvel_lnd_file, drydep_srf_file, & srf_emis_type, srf_emis_cycle_yr, srf_emis_fixed_ymd, srf_emis_fixed_tod, srf_emis_specifier, & fstrat_file, fstrat_list, & @@ -457,10 +452,6 @@ subroutine chem_readnl(nlfile) call mpibcast (bndtvg, len(bndtvg), mpichar, 0, mpicom) call mpibcast (h2orates, len(h2orates), mpichar, 0, mpicom) - ! lightning - - call mpibcast (lght_no_prd_factor,1, mpir8, 0, mpicom) - ! photolysis call mpibcast (rsf_file, len(rsf_file), mpichar, 0, mpicom) @@ -770,7 +761,6 @@ subroutine chem_init(phys_state, pbuf2d) , ext_frc_fixed_ymd & , ext_frc_fixed_tod & , exo_coldens_file & - , lght_no_prd_factor & , pbuf2d & ) diff --git a/src/chemistry/mozart/mo_chemini.F90 b/src/chemistry/mozart/mo_chemini.F90 index 218aa2314e..597617fffc 100644 --- a/src/chemistry/mozart/mo_chemini.F90 +++ b/src/chemistry/mozart/mo_chemini.F90 @@ -36,7 +36,6 @@ subroutine chemini & , ext_frc_fixed_ymd & , ext_frc_fixed_tod & , exo_coldens_file & - , lght_no_prd_factor & , pbuf2d & ) @@ -94,7 +93,6 @@ subroutine chemini & character(len=*), dimension(:), intent(in) :: srf_emis_specifier character(len=*), dimension(:), intent(in) :: ext_frc_specifier character(len=*), intent(in) :: exo_coldens_file - real(r8), intent(in) :: lght_no_prd_factor character(len=*), intent(in) :: ext_frc_type integer, intent(in) :: ext_frc_cycle_yr integer, intent(in) :: ext_frc_fixed_ymd @@ -164,7 +162,7 @@ subroutine chemini & !----------------------------------------------------------------------- ! ... initialize the lightning module !----------------------------------------------------------------------- - call lightning_inti(pbuf2d,lght_no_prd_factor) + call lightning_inti(pbuf2d, calc_nox_prod_rate=.true.) if (masterproc) write(iulog,*) 'chemini: after lightning_inti on node ',iam !----------------------------------------------------------------------- diff --git a/src/chemistry/mozart/mo_lightning.F90 b/src/chemistry/mozart/mo_lightning.F90 index 284ae40a68..998465d4a4 100644 --- a/src/chemistry/mozart/mo_lightning.F90 +++ b/src/chemistry/mozart/mo_lightning.F90 @@ -16,6 +16,8 @@ module mo_lightning implicit none private + + public :: lightning_readnl public :: lightning_register public :: lightning_inti public :: lightning_no_prod @@ -33,19 +35,68 @@ module mo_lightning integer :: flsh_frq_ndx = -1 integer :: cldtop_ndx = -1, cldbot_ndx = -1 + real(r8) :: lght_no_prd_factor = -huge(1._r8) + contains - !---------------------------------------------------------------------- + !------------------------------------------------------------------------- + ! Read namelist options + !------------------------------------------------------------------------- + subroutine lightning_readnl(nlfile) + use namelist_utils, only : find_group_name + use spmd_utils, only : mpicom, masterprocid, mpi_real8 + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + integer :: unitn, ierr + character(len=*), parameter :: subname = 'lightning_readnl' + + ! =================== + ! Namelist definition + ! =================== + namelist /lightning_nl/ lght_no_prd_factor + + ! ============= + ! Read namelist + ! ============= + if (masterproc) then + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'lightning_nl', status=ierr) + if (ierr == 0) then + read(unitn, lightning_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + end if + + ! ============================ + ! Broadcast namelist variables + ! ============================ + call mpi_bcast(lght_no_prd_factor, 1, mpi_real8, masterprocid, mpicom, ierr) + + if (masterproc) then + write(iulog,*) subname,' lght_no_prd_factor: ',lght_no_prd_factor + end if + + factor = 0.1_r8*lght_no_prd_factor + + end subroutine lightning_readnl + + !------------------------------------------------------------------------- ! register phys buffer field for cloud to ground lightning flash frequency ! to pass to the mediator for land model - !---------------------------------------------------------------------- + !------------------------------------------------------------------------- subroutine lightning_register() call pbuf_add_field('LGHT_FLASH_FREQ','global',dtype_r8,(/pcols/),flsh_frq_ndx) ! per minute end subroutine lightning_register - subroutine lightning_inti( pbuf2d, lght_no_prd_factor ) + !------------------------------------------------------------------------- + !------------------------------------------------------------------------- + subroutine lightning_inti( pbuf2d, calc_nox_prod_rate ) !---------------------------------------------------------------------- ! ... initialize the lightning module !---------------------------------------------------------------------- @@ -60,7 +111,7 @@ subroutine lightning_inti( pbuf2d, lght_no_prd_factor ) ! ... dummy args !---------------------------------------------------------------------- type(physics_buffer_desc), pointer :: pbuf2d(:,:) - real(r8),optional, intent(in) :: lght_no_prd_factor ! lightning no production factor + logical,optional, intent(in) :: calc_nox_prod_rate !---------------------------------------------------------------------- ! ... local variables @@ -76,10 +127,11 @@ subroutine lightning_inti( pbuf2d, lght_no_prd_factor ) if (.not.calc_lightning) return - calc_nox_prod = present(lght_no_prd_factor) + if (present(calc_nox_prod_rate)) then + calc_nox_prod = calc_nox_prod_rate + end if if (calc_nox_prod) then - factor = 0.1_r8*lght_no_prd_factor if (masterproc) write(iulog,*) prefix,'lightning no production scaling factor = ',factor @@ -127,6 +179,8 @@ subroutine lightning_inti( pbuf2d, lght_no_prd_factor ) endif end subroutine lightning_inti + !------------------------------------------------------------------------- + !------------------------------------------------------------------------- subroutine lightning_no_prod( state, pbuf2d, cam_in ) !---------------------------------------------------------------------- ! ... set no production from lightning @@ -297,7 +351,7 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) cgic(i,c) = .02_r8 end if - lightning_flash_freq(i) = flash_freq(i,c)*cgic(i,c) ! cld-to-grnd flash frq (per min) + lightning_flash_freq(i) = flash_freq(i,c)*cgic(i,c) * factor ! cld-to-grnd flash frq (per min) if (calc_nox_prod) then !-------------------------------------------------------------------------------- diff --git a/src/control/runtime_opts.F90 b/src/control/runtime_opts.F90 index 356ec0f6d4..f8f182c30b 100644 --- a/src/control/runtime_opts.F90 +++ b/src/control/runtime_opts.F90 @@ -98,6 +98,7 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) use lunar_tides, only: lunar_tides_readnl use upper_bc, only: ubc_readnl use phys_grid_ctem, only: phys_grid_ctem_readnl + use mo_lightning, only: lightning_readnl !---------------------------Arguments----------------------------------- @@ -165,6 +166,7 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) call rad_data_readnl(nlfilename) call modal_aer_opt_readnl(nlfilename) call chem_readnl(nlfilename) + call lightning_readnl(nlfilename) call prescribed_volcaero_readnl(nlfilename) call prescribed_strataero_readnl(nlfilename) call solar_data_readnl(nlfilename) diff --git a/src/cpl/nuopc/atm_import_export.F90 b/src/cpl/nuopc/atm_import_export.F90 index e238fe4eb9..20dc11b20a 100644 --- a/src/cpl/nuopc/atm_import_export.F90 +++ b/src/cpl/nuopc/atm_import_export.F90 @@ -199,7 +199,7 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) ! lightning flash freq call shr_lightning_coupling_readnl("drv_flds_in", atm_provides_lightning) if (atm_provides_lightning) then - call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_lght') + call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_lightning') end if ! Now advertise above export fields @@ -1042,7 +1042,7 @@ subroutine export_fields( gcomp, cam_out, rc) end do end if - call state_getfldptr(exportState, 'Sa_lght', fldptr=fldptr_lght, exists=exists, rc=rc) + call state_getfldptr(exportState, 'Sa_lightning', fldptr=fldptr_lght, exists=exists, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (exists) then g = 1 From 1481f619bb15cb1fb8fae8829b0633c2d6b06d67 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 1 Feb 2023 11:30:27 -0700 Subject: [PATCH 07/28] code clean up modified: src/chemistry/mozart/chemistry.F90 modified: src/chemistry/mozart/mo_chemini.F90 modified: src/chemistry/mozart/mo_lightning.F90 modified: src/chemistry/pp_none/chemistry.F90 modified: src/control/camsrfexch.F90 modified: src/physics/cam/physpkg.F90 --- src/chemistry/mozart/chemistry.F90 | 3 -- src/chemistry/mozart/mo_chemini.F90 | 7 ----- src/chemistry/mozart/mo_lightning.F90 | 41 +++++++++++++-------------- src/chemistry/pp_none/chemistry.F90 | 40 +++++++++++--------------- src/control/camsrfexch.F90 | 3 +- src/physics/cam/physpkg.F90 | 10 ++++++- 6 files changed, 46 insertions(+), 58 deletions(-) diff --git a/src/chemistry/mozart/chemistry.F90 b/src/chemistry/mozart/chemistry.F90 index 9ff7fc7fa2..7e845b34ff 100644 --- a/src/chemistry/mozart/chemistry.F90 +++ b/src/chemistry/mozart/chemistry.F90 @@ -316,9 +316,6 @@ subroutine chem_register ! add fields to pbuf needed by aerosol models call aero_model_register() - ! add prognostic lightning flash freq pbuf fld - call lightning_register() - end subroutine chem_register !================================================================================================ diff --git a/src/chemistry/mozart/mo_chemini.F90 b/src/chemistry/mozart/mo_chemini.F90 index 597617fffc..9c31b2ba61 100644 --- a/src/chemistry/mozart/mo_chemini.F90 +++ b/src/chemistry/mozart/mo_chemini.F90 @@ -47,7 +47,6 @@ subroutine chemini & use mo_srf_emissions, only : srf_emissions_inti use mo_sulf, only : sulf_inti use mo_photo, only : photo_inti - use mo_lightning, only : lightning_inti use mo_drydep, only : drydep_inti use mo_imp_sol, only : imp_slv_inti use mo_exp_sol, only : exp_sol_inti @@ -159,12 +158,6 @@ subroutine chemini & call sad_inti(pbuf2d) if (masterproc) write(iulog,*) 'chemini: after sad_inti on node ',iam - !----------------------------------------------------------------------- - ! ... initialize the lightning module - !----------------------------------------------------------------------- - call lightning_inti(pbuf2d, calc_nox_prod_rate=.true.) - if (masterproc) write(iulog,*) 'chemini: after lightning_inti on node ',iam - !----------------------------------------------------------------------- ! ... initialize the dry deposition module !----------------------------------------------------------------------- diff --git a/src/chemistry/mozart/mo_lightning.F90 b/src/chemistry/mozart/mo_lightning.F90 index 998465d4a4..0596e77b12 100644 --- a/src/chemistry/mozart/mo_lightning.F90 +++ b/src/chemistry/mozart/mo_lightning.F90 @@ -19,7 +19,7 @@ module mo_lightning public :: lightning_readnl public :: lightning_register - public :: lightning_inti + public :: lightning_init public :: lightning_no_prod public :: prod_no @@ -44,7 +44,7 @@ module mo_lightning !------------------------------------------------------------------------- subroutine lightning_readnl(nlfile) use namelist_utils, only : find_group_name - use spmd_utils, only : mpicom, masterprocid, mpi_real8 + use spmd_utils, only : mpicom, masterprocid, mpi_real8, mpi_success character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -75,6 +75,9 @@ subroutine lightning_readnl(nlfile) ! Broadcast namelist variables ! ============================ call mpi_bcast(lght_no_prd_factor, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//': MPI_BCAST ERROR: lght_no_prd_factor') + end if if (masterproc) then write(iulog,*) subname,' lght_no_prd_factor: ',lght_no_prd_factor @@ -96,7 +99,7 @@ end subroutine lightning_register !------------------------------------------------------------------------- !------------------------------------------------------------------------- - subroutine lightning_inti( pbuf2d, calc_nox_prod_rate ) + subroutine lightning_init( pbuf2d ) !---------------------------------------------------------------------- ! ... initialize the lightning module !---------------------------------------------------------------------- @@ -111,15 +114,13 @@ subroutine lightning_inti( pbuf2d, calc_nox_prod_rate ) ! ... dummy args !---------------------------------------------------------------------- type(physics_buffer_desc), pointer :: pbuf2d(:,:) - logical,optional, intent(in) :: calc_nox_prod_rate !---------------------------------------------------------------------- ! ... local variables !---------------------------------------------------------------------- integer :: astat, err logical :: history_cesm_forcing - character(len=*),parameter :: prefix = 'lightning_inti: ' - + character(len=*),parameter :: prefix = 'lightning_init: ' cldtop_ndx = pbuf_get_index('CLDTOP',errcode=err) cldbot_ndx = pbuf_get_index('CLDBOT',errcode=err) @@ -127,9 +128,7 @@ subroutine lightning_inti( pbuf2d, calc_nox_prod_rate ) if (.not.calc_lightning) return - if (present(calc_nox_prod_rate)) then - calc_nox_prod = calc_nox_prod_rate - end if + calc_nox_prod = flsh_frq_ndx>0 if (calc_nox_prod) then @@ -153,7 +152,7 @@ subroutine lightning_inti( pbuf2d, calc_nox_prod_rate ) allocate( prod_no(pcols,pver,begchunk:endchunk),stat=astat ) if( astat /= 0 ) then - write(iulog,*) 'lght_inti: failed to allocate prod_no; error = ',astat + write(iulog,*) prefix, 'failed to allocate prod_no; error = ',astat call endrun end if geo_factor = ngcols_p/(4._r8*pi) @@ -167,6 +166,10 @@ subroutine lightning_inti( pbuf2d, calc_nox_prod_rate ) call add_default('LNO_COL_PROD',1,' ') endif + if (is_first_step()) then + call pbuf_set_field(pbuf2d, flsh_frq_ndx, 0.0_r8) + endif + endif call addfld( 'FLASHFRQ', horiz_only, 'I', '1/MIN', 'lighting flash rate' ) ! flash frequency in grid box per minute (PPP) @@ -174,10 +177,7 @@ subroutine lightning_inti( pbuf2d, calc_nox_prod_rate ) call addfld( 'DCHGZONE', horiz_only, 'I', 'KM', 'depth of discharge zone' ) ! depth of discharge zone call addfld( 'CGIC', horiz_only, 'I', 'RATIO', 'ratio of cloud-ground/intracloud discharges' ) ! ratio of cloud-ground/intracloud discharges - if (is_first_step()) then - call pbuf_set_field(pbuf2d, flsh_frq_ndx, 0.0_r8) - endif - end subroutine lightning_inti + end subroutine lightning_init !------------------------------------------------------------------------- !------------------------------------------------------------------------- @@ -197,15 +197,14 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) ! ... dummy args !---------------------------------------------------------------------- type(physics_state), intent(in) :: state(begchunk:endchunk) ! physics state - type(physics_buffer_desc), pointer :: pbuf2d(:,:) type(cam_in_t), intent(in) :: cam_in(begchunk:endchunk) ! physics state !---------------------------------------------------------------------- ! ... local variables !---------------------------------------------------------------------- - real(r8), parameter :: land = 1._r8 - real(r8), parameter :: secpyr = 365._r8 * 8.64e4_r8 + real(r8), parameter :: land = 1._r8 + real(r8), parameter :: secpyr = 365._r8 * 8.64e4_r8 integer :: i, c integer :: cldtind ! level index for cloud top @@ -253,11 +252,11 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) real(r8), parameter :: lat25 = 25._r8*d2r ! 25 degrees latitude in radians real(r8) :: flash_freq_land, flash_freq_ocn - real(r8), pointer :: lightning_flash_freq(:) + real(r8), pointer :: cld2grnd_flash_freq(:) if (.not.calc_lightning) return - nullify(lightning_flash_freq) + nullify(cld2grnd_flash_freq) !---------------------------------------------------------------------- ! ... initialization @@ -296,7 +295,7 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) Chunk_loop : do c = begchunk,endchunk ncol = state(c)%ncol lchnk = state(c)%lchnk - call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk), flsh_frq_ndx, lightning_flash_freq ) + call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk), flsh_frq_ndx, cld2grnd_flash_freq ) call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk), cldtop_ndx, cldtop ) call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk), cldbot_ndx, cldbot ) zsurf(:ncol) = state(c)%phis(:ncol)*rga @@ -351,7 +350,7 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) cgic(i,c) = .02_r8 end if - lightning_flash_freq(i) = flash_freq(i,c)*cgic(i,c) * factor ! cld-to-grnd flash frq (per min) + cld2grnd_flash_freq(i) = cam_in(c)%landfrac(i)*flash_freq_land *cgic(i,c) * factor ! cld-to-grnd flash frq (per min) if (calc_nox_prod) then !-------------------------------------------------------------------------------- diff --git a/src/chemistry/pp_none/chemistry.F90 b/src/chemistry/pp_none/chemistry.F90 index 3e1a0adfe4..bdb8c9ae0b 100644 --- a/src/chemistry/pp_none/chemistry.F90 +++ b/src/chemistry/pp_none/chemistry.F90 @@ -7,7 +7,7 @@ module chemistry use shr_kind_mod, only: r8 => shr_kind_r8 use physics_types, only: physics_state, physics_ptend use ppgrid, only: begchunk, endchunk, pcols - + implicit none private @@ -27,7 +27,7 @@ module chemistry public :: chem_write_restart public :: chem_read_restart public :: chem_init_restart - public :: chem_readnl ! read chem namelist + public :: chem_readnl ! read chem namelist public :: chem_reset_fluxes public :: chem_emissions @@ -61,19 +61,15 @@ end function chem_is subroutine chem_register use aero_model, only : aero_model_register - use mo_lightning, only : lightning_register - !----------------------------------------------------------------------- - ! + !----------------------------------------------------------------------- + ! ! Purpose: register advected constituents for parameterized greenhouse gas chemistry - ! + ! !----------------------------------------------------------------------- ! for prescribed aerosols call aero_model_register() - ! add prognostic lightning flash freq pbuf fld - call lightning_register() - end subroutine chem_register !================================================================================================ @@ -99,12 +95,12 @@ end function chem_is_active !================================================================================================ function chem_implements_cnst(name) - !----------------------------------------------------------------------- - ! + !----------------------------------------------------------------------- + ! ! Purpose: return true if specified constituent is implemented by this package - ! + ! ! Author: B. Eaton - ! + ! !----------------------------------------------------------------------- implicit none !-----------------------------Arguments--------------------------------- @@ -119,15 +115,14 @@ end function chem_implements_cnst !=============================================================================== subroutine chem_init(phys_state, pbuf2d) - !----------------------------------------------------------------------- - ! + !----------------------------------------------------------------------- + ! ! Purpose: initialize parameterized greenhouse gas chemistry ! (declare history variables) - ! + ! !----------------------------------------------------------------------- use physics_buffer, only : physics_buffer_desc use aero_model, only : aero_model_init - use mo_lightning, only : lightning_inti type(physics_state), intent(in):: phys_state(begchunk:endchunk) type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -135,9 +130,6 @@ subroutine chem_init(phys_state, pbuf2d) ! for prescribed aerosols call aero_model_init(pbuf2d) - ! prognostic lightning flashes - call lightning_inti(pbuf2d) - end subroutine chem_init !=============================================================================== @@ -146,7 +138,7 @@ subroutine chem_timestep_init(phys_state, pbuf2d) use physics_buffer, only : physics_buffer_desc use time_manager, only: get_curr_date, get_perp_date, get_curr_calday, & is_perpetual - type(physics_state), intent(in):: phys_state(begchunk:endchunk) + type(physics_state), intent(in):: phys_state(begchunk:endchunk) type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -170,7 +162,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dt, pbuf, fh2o) type(cam_out_t), intent(in) :: cam_out type(physics_buffer_desc), pointer :: pbuf(:) real(r8), optional, intent(out) :: fh2o(pcols) ! h2o flux to balance source from chemistry - + return end subroutine chem_timestep_tend @@ -223,7 +215,7 @@ subroutine chem_init_restart(File) end subroutine chem_init_restart !================================================================================ subroutine chem_reset_fluxes( fptr, cam_in ) - use camsrfexch, only : cam_in_t + use camsrfexch, only : cam_in_t real(r8), pointer :: fptr(:,:) ! pointer into array data type(cam_in_t), intent(inout) :: cam_in(begchunk:endchunk) @@ -231,7 +223,7 @@ subroutine chem_reset_fluxes( fptr, cam_in ) end subroutine chem_reset_fluxes !================================================================================ subroutine chem_emissions( state, cam_in ) - use camsrfexch, only: cam_in_t + use camsrfexch, only: cam_in_t ! Arguments: diff --git a/src/control/camsrfexch.F90 b/src/control/camsrfexch.F90 index 469ef242a0..fd059321c9 100644 --- a/src/control/camsrfexch.F90 +++ b/src/control/camsrfexch.F90 @@ -303,7 +303,7 @@ subroutine atm2hub_alloc( cam_out ) cam_out(c)%co2prog(:) = 0._r8 cam_out(c)%co2diag(:) = 0._r8 cam_out(c)%ozone(:) = 0._r8 - cam_out(c)%lightning_flash_freq(:) = 0._r8 + cam_out(c)%lightning_flash_freq(:) = -huge(1._r8) cam_out(c)%psl(:) = 0._r8 cam_out(c)%bcphidry(:) = 0._r8 cam_out(c)%bcphodry(:) = 0._r8 @@ -526,7 +526,6 @@ subroutine cam_export(state,cam_out,pbuf) cam_out%lightning_flash_freq(:ncol) = lightning_ptr(:ncol) end if - ! ! Precipation and snow rates from shallow convection, deep convection and stratiform processes. ! Compute total convective and stratiform precipitation and snow rates diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 9ee1b64e8c..244ac339f6 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -114,6 +114,7 @@ subroutine phys_register use cam_control_mod, only: moist_physics use chemistry, only: chem_register + use mo_lightning, only: lightning_register use cloud_fraction, only: cldfrc_register use rk_stratiform, only: rk_stratiform_register use microp_driver, only: microp_driver_register @@ -267,6 +268,9 @@ subroutine phys_register ! register chemical constituents including aerosols ... call chem_register() + ! add prognostic lightning flash freq pbuf fld + call lightning_register() + ! co2 constituents call co2_register() @@ -716,6 +720,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use cam_control_mod, only: initial_run use check_energy, only: check_energy_init use chemistry, only: chem_init + use mo_lightning, only: lightning_init use prescribed_ozone, only: prescribed_ozone_init use prescribed_ghg, only: prescribed_ghg_init use prescribed_aero, only: prescribed_aero_init @@ -858,6 +863,9 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! Prognostic chemistry. call chem_init(phys_state,pbuf2d) + ! Lightning flash frq and NOx prod + call lightning_init( pbuf2d ) + ! Prescribed tracers call prescribed_ozone_init() call prescribed_ghg_init() @@ -1251,7 +1259,7 @@ subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, & ! call get_met_srf2( cam_in ) #endif - ! Set lightning production of NO + ! lightning flash freq and prod rate of NOx call t_startf ('lightning_no_prod') call lightning_no_prod( phys_state, pbuf2d, cam_in ) call t_stopf ('lightning_no_prod') From 047793b2b5442a4c08b7e6e385bbe0ee35953257 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Fri, 3 Feb 2023 06:03:47 -0700 Subject: [PATCH 08/28] corrections for later cmeps modified: src/chemistry/mozart/mo_lightning.F90 modified: src/control/camsrfexch.F90 modified: src/cpl/nuopc/atm_import_export.F90 modified: src/physics/cam_dev/physpkg.F90 --- src/chemistry/mozart/mo_lightning.F90 | 3 +++ src/control/camsrfexch.F90 | 2 +- src/cpl/nuopc/atm_import_export.F90 | 7 +++---- src/physics/cam_dev/physpkg.F90 | 12 ++++++++++-- 4 files changed, 17 insertions(+), 7 deletions(-) diff --git a/src/chemistry/mozart/mo_lightning.F90 b/src/chemistry/mozart/mo_lightning.F90 index 0596e77b12..6565b0d845 100644 --- a/src/chemistry/mozart/mo_lightning.F90 +++ b/src/chemistry/mozart/mo_lightning.F90 @@ -308,6 +308,9 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) end do zint(:ncol,pver+1,c) = state(c)%zi(:ncol,pver+1) + zsurf(:ncol) + + cld2grnd_flash_freq(:) = 0.0_r8 + col_loop : do i = 1,ncol !-------------------------------------------------------------------------------- ! ... find cloud top and bottom level above 273k diff --git a/src/control/camsrfexch.F90 b/src/control/camsrfexch.F90 index fd059321c9..966959edc8 100644 --- a/src/control/camsrfexch.F90 +++ b/src/control/camsrfexch.F90 @@ -303,7 +303,7 @@ subroutine atm2hub_alloc( cam_out ) cam_out(c)%co2prog(:) = 0._r8 cam_out(c)%co2diag(:) = 0._r8 cam_out(c)%ozone(:) = 0._r8 - cam_out(c)%lightning_flash_freq(:) = -huge(1._r8) + cam_out(c)%lightning_flash_freq(:) = 0.0_r8 cam_out(c)%psl(:) = 0._r8 cam_out(c)%bcphidry(:) = 0._r8 cam_out(c)%bcphodry(:) = 0._r8 diff --git a/src/cpl/nuopc/atm_import_export.F90 b/src/cpl/nuopc/atm_import_export.F90 index 20dc11b20a..2723a856a1 100644 --- a/src/cpl/nuopc/atm_import_export.F90 +++ b/src/cpl/nuopc/atm_import_export.F90 @@ -57,7 +57,8 @@ module atm_import_export integer :: drydep_nflds = -huge(1) ! number of dry deposition velocity fields lnd-> atm integer :: megan_nflds = -huge(1) ! number of MEGAN voc fields from lnd-> atm integer :: emis_nflds = -huge(1) ! number of fire emission fields from lnd-> atm - integer, public :: ndep_nflds = -huge(1) ! number of nitrogen deposition fields from atm->lnd/ocn + integer, public :: ndep_nflds = -huge(1) ! number of nitrogen deposition fields from atm->lnd/ocn + logical :: atm_provides_lightning = .false. ! cld to grnd lightning flash freq (min-1) character(*),parameter :: F01 = "('(cam_import_export) ',a,i8,2x,i8,2x,d21.14)" character(*),parameter :: F02 = "('(cam_import_export) ',a,i8,2x,i8,2x,i8,2x,d21.14)" character(*),parameter :: u_FILE_u = __FILE__ @@ -86,6 +87,7 @@ subroutine read_surface_fields_namelists() call shr_megan_readnl(nl_file_name, megan_nflds) call shr_fire_emis_readnl(nl_file_name, emis_nflds) call shr_carma_readnl(nl_file_name, carma_fields) + call shr_lightning_coupling_readnl(nl_file_name, atm_provides_lightning) end subroutine read_surface_fields_namelists @@ -106,8 +108,6 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) logical :: flds_co2a ! use case logical :: flds_co2b ! use case logical :: flds_co2c ! use case - logical :: atm_provides_lightning - integer :: ndep_nflds, megan_nflds, emis_nflds character(len=128) :: fldname character(len=*), parameter :: subname='(atm_import_export:advertise_fields)' !------------------------------------------------------------------------------- @@ -197,7 +197,6 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) end if ! lightning flash freq - call shr_lightning_coupling_readnl("drv_flds_in", atm_provides_lightning) if (atm_provides_lightning) then call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_lightning') end if diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index d2fe6f7ca0..2baeea8cf6 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -110,6 +110,7 @@ subroutine phys_register use cam_control_mod, only: moist_physics use chemistry, only: chem_register + use mo_lightning, only: lightning_register use cloud_fraction, only: cldfrc_register use microp_driver, only: microp_driver_register use microp_aero, only: microp_aero_register @@ -253,6 +254,9 @@ subroutine phys_register ! register chemical constituents including aerosols ... call chem_register() + ! add prognostic lightning flash freq pbuf fld + call lightning_register() + ! co2 constituents call co2_register() @@ -699,6 +703,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use cam_control_mod, only: initial_run use check_energy, only: check_energy_init use chemistry, only: chem_init + use mo_lightning, only: lightning_init use prescribed_ozone, only: prescribed_ozone_init use prescribed_ghg, only: prescribed_ghg_init use prescribed_aero, only: prescribed_aero_init @@ -831,6 +836,9 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! Prognostic chemistry. call chem_init(phys_state,pbuf2d) + ! Lightning flash frq and NOx prod + call lightning_init( pbuf2d ) + ! Prescribed tracers call prescribed_ozone_init() call prescribed_ghg_init() @@ -1192,9 +1200,9 @@ subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, & ! call get_met_srf2( cam_in ) #endif - ! Set lightning production of NO + ! lightning flash freq and prod rate of NOx call t_startf ('lightning_no_prod') - call lightning_no_prod( phys_state, pbuf2d, cam_in ) + call lightning_no_prod( phys_state, pbuf2d, cam_in ) call t_stopf ('lightning_no_prod') call t_barrierf('sync_ac_physics', mpicom) From db9bb12147a3ad75433c151f5e128ef5b4c99d79 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Fri, 3 Feb 2023 12:37:10 -0700 Subject: [PATCH 09/28] atm_provides_lightning is FALSE if simple phys or aquaplanet modified: bld/build-namelist modified: src/control/camsrfexch.F90 --- bld/build-namelist | 6 +++--- src/control/camsrfexch.F90 | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 98b7f68a06..2ce9e3f0f7 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -4061,10 +4061,10 @@ if ($opts{'cmeps'}) { add_default($nl, 'atm_ozone_frequency', 'val'=>'multiday_average'); } # for lightning flash freq to CTSM - if ($phys =~ /^cam/) { - add_default($nl, 'atm_provides_lightning', 'val'=>'.true.'); - } else { + if ($simple_phys or $aqua_mode) { add_default($nl, 'atm_provides_lightning', 'val'=>'.false.'); + } else { + add_default($nl, 'atm_provides_lightning', 'val'=>'.true.'); } } $outfile = "$opts{'dir'}/drv_flds_in"; diff --git a/src/control/camsrfexch.F90 b/src/control/camsrfexch.F90 index 966959edc8..fd059321c9 100644 --- a/src/control/camsrfexch.F90 +++ b/src/control/camsrfexch.F90 @@ -303,7 +303,7 @@ subroutine atm2hub_alloc( cam_out ) cam_out(c)%co2prog(:) = 0._r8 cam_out(c)%co2diag(:) = 0._r8 cam_out(c)%ozone(:) = 0._r8 - cam_out(c)%lightning_flash_freq(:) = 0.0_r8 + cam_out(c)%lightning_flash_freq(:) = -huge(1._r8) cam_out(c)%psl(:) = 0._r8 cam_out(c)%bcphidry(:) = 0._r8 cam_out(c)%bcphodry(:) = 0._r8 From 39d1c7de65f54881c689ba8673b30a7f42efae2f Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Tue, 7 Feb 2023 06:24:01 -0700 Subject: [PATCH 10/28] remove factor from cld2grnd flash freq; fix typos modified: src/chemistry/mozart/mo_lightning.F90 --- src/chemistry/mozart/mo_lightning.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/chemistry/mozart/mo_lightning.F90 b/src/chemistry/mozart/mo_lightning.F90 index 6565b0d845..6c6eff1be9 100644 --- a/src/chemistry/mozart/mo_lightning.F90 +++ b/src/chemistry/mozart/mo_lightning.F90 @@ -157,9 +157,9 @@ subroutine lightning_init( pbuf2d ) end if geo_factor = ngcols_p/(4._r8*pi) - call addfld( 'LNO_COL_PROD', horiz_only, 'I', 'TG N/YR', 'lighting column NO source' ) - call addfld( 'LNO_PROD', (/ 'lev' /), 'I', '/cm3/s', 'lighting insitu NO source' ) - call addfld( 'FLASHENGY', horiz_only, 'I', ' ', 'lighting flash rate' ) ! flash frequency in grid box per minute (PPP) + call addfld( 'LNO_COL_PROD', horiz_only, 'I', 'TG N/YR', 'lightning column NO source' ) + call addfld( 'LNO_PROD', (/ 'lev' /), 'I', '/cm3/s', 'lightning insitu NO source' ) + call addfld( 'FLASHENGY', horiz_only, 'I', 'J', 'lightning flash energy' ) ! flash energy call phys_getopts( history_cesm_forcing_out = history_cesm_forcing ) if ( history_cesm_forcing ) then @@ -172,9 +172,9 @@ subroutine lightning_init( pbuf2d ) endif - call addfld( 'FLASHFRQ', horiz_only, 'I', '1/MIN', 'lighting flash rate' ) ! flash frequency in grid box per minute (PPP) - call addfld( 'CLDHGT', horiz_only, 'I', 'KM', 'cloud top height' ) ! cloud top height - call addfld( 'DCHGZONE', horiz_only, 'I', 'KM', 'depth of discharge zone' ) ! depth of discharge zone + call addfld( 'FLASHFRQ', horiz_only, 'I', '1/MIN', 'lightning flash rate' ) ! flash frequency in grid box per minute (PPP) + call addfld( 'CLDHGT', horiz_only, 'I', 'KM', 'cloud top height' ) ! cloud top height + call addfld( 'DCHGZONE', horiz_only, 'I', 'KM', 'depth of discharge zone' ) ! depth of discharge zone call addfld( 'CGIC', horiz_only, 'I', 'RATIO', 'ratio of cloud-ground/intracloud discharges' ) ! ratio of cloud-ground/intracloud discharges end subroutine lightning_init @@ -353,7 +353,7 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) cgic(i,c) = .02_r8 end if - cld2grnd_flash_freq(i) = cam_in(c)%landfrac(i)*flash_freq_land *cgic(i,c) * factor ! cld-to-grnd flash frq (per min) + cld2grnd_flash_freq(i) = cam_in(c)%landfrac(i)*flash_freq_land*cgic(i,c) ! cld-to-grnd flash frq (per min) if (calc_nox_prod) then !-------------------------------------------------------------------------------- From 723f1cd24eca5a3a00e6dc2b3311425b7883f904 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Tue, 7 Feb 2023 11:20:00 -0700 Subject: [PATCH 11/28] Minor changes to history fld units modified: src/chemistry/mozart/mo_lightning.F90 --- src/chemistry/mozart/mo_lightning.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/chemistry/mozart/mo_lightning.F90 b/src/chemistry/mozart/mo_lightning.F90 index 6c6eff1be9..e7bd1041fa 100644 --- a/src/chemistry/mozart/mo_lightning.F90 +++ b/src/chemistry/mozart/mo_lightning.F90 @@ -157,9 +157,9 @@ subroutine lightning_init( pbuf2d ) end if geo_factor = ngcols_p/(4._r8*pi) - call addfld( 'LNO_COL_PROD', horiz_only, 'I', 'TG N/YR', 'lightning column NO source' ) - call addfld( 'LNO_PROD', (/ 'lev' /), 'I', '/cm3/s', 'lightning insitu NO source' ) - call addfld( 'FLASHENGY', horiz_only, 'I', 'J', 'lightning flash energy' ) ! flash energy + call addfld( 'LNO_COL_PROD', horiz_only, 'I', 'Tg N yr-1', 'lightning column NO source' ) + call addfld( 'LNO_PROD', (/ 'lev' /), 'I', 'molecules/cm3/s', 'lightning insitu NO source' ) + call addfld( 'FLASHENGY', horiz_only, 'I', 'J', 'lightning flash energy' ) ! flash energy call phys_getopts( history_cesm_forcing_out = history_cesm_forcing ) if ( history_cesm_forcing ) then @@ -172,10 +172,10 @@ subroutine lightning_init( pbuf2d ) endif - call addfld( 'FLASHFRQ', horiz_only, 'I', '1/MIN', 'lightning flash rate' ) ! flash frequency in grid box per minute (PPP) - call addfld( 'CLDHGT', horiz_only, 'I', 'KM', 'cloud top height' ) ! cloud top height - call addfld( 'DCHGZONE', horiz_only, 'I', 'KM', 'depth of discharge zone' ) ! depth of discharge zone - call addfld( 'CGIC', horiz_only, 'I', 'RATIO', 'ratio of cloud-ground/intracloud discharges' ) ! ratio of cloud-ground/intracloud discharges + call addfld( 'FLASHFRQ', horiz_only, 'I', 'min-1', 'lightning flash rate' ) ! flash frequency in grid box per minute (PPP) + call addfld( 'CLDHGT', horiz_only, 'I', 'km', 'cloud top height' ) ! cloud top height + call addfld( 'DCHGZONE', horiz_only, 'I', 'km', 'depth of discharge zone' ) ! depth of discharge zone + call addfld( 'CGIC', horiz_only, 'I', '1', 'ratio of cloud-ground/intracloud discharges' ) ! ratio of cloud-ground/intracloud discharges end subroutine lightning_init From 75ba203b93c74650451e485d944ab2917adf19ae Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Tue, 21 Mar 2023 16:35:16 -0600 Subject: [PATCH 12/28] restore factor setting modified: src/chemistry/mozart/mo_lightning.F90 --- src/chemistry/mozart/mo_lightning.F90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/chemistry/mozart/mo_lightning.F90 b/src/chemistry/mozart/mo_lightning.F90 index e7bd1041fa..09f9517f52 100644 --- a/src/chemistry/mozart/mo_lightning.F90 +++ b/src/chemistry/mozart/mo_lightning.F90 @@ -25,7 +25,7 @@ module mo_lightning real(r8),protected, allocatable :: prod_no(:,:,:) - real(r8) :: factor = -huge(1._r8) ! user-controlled scaling factor to achieve arbitrary no prod. + real(r8) :: factor = 0.1_r8 ! user-controlled scaling factor to achieve arbitrary no prod. real(r8) :: geo_factor = -huge(1._r8) ! grid cell area factor real(r8), allocatable :: vdist(:,:) ! vertical distribution of lightning @@ -35,6 +35,7 @@ module mo_lightning integer :: flsh_frq_ndx = -1 integer :: cldtop_ndx = -1, cldbot_ndx = -1 + ! namelist parameter real(r8) :: lght_no_prd_factor = -huge(1._r8) contains @@ -83,7 +84,9 @@ subroutine lightning_readnl(nlfile) write(iulog,*) subname,' lght_no_prd_factor: ',lght_no_prd_factor end if - factor = 0.1_r8*lght_no_prd_factor + if( lght_no_prd_factor /= 1._r8 ) then + factor = factor*lght_no_prd_factor + end if end subroutine lightning_readnl From 2eb1ca088930fed69c42250ce0803e0b60a93b5d Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 23 Mar 2023 13:27:38 -0600 Subject: [PATCH 13/28] add LGHTNG_CLD2GRND diag modified: src/chemistry/mozart/mo_lightning.F90 --- src/chemistry/mozart/mo_lightning.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/chemistry/mozart/mo_lightning.F90 b/src/chemistry/mozart/mo_lightning.F90 index 09f9517f52..8aacae0de3 100644 --- a/src/chemistry/mozart/mo_lightning.F90 +++ b/src/chemistry/mozart/mo_lightning.F90 @@ -179,6 +179,7 @@ subroutine lightning_init( pbuf2d ) call addfld( 'CLDHGT', horiz_only, 'I', 'km', 'cloud top height' ) ! cloud top height call addfld( 'DCHGZONE', horiz_only, 'I', 'km', 'depth of discharge zone' ) ! depth of discharge zone call addfld( 'CGIC', horiz_only, 'I', '1', 'ratio of cloud-ground/intracloud discharges' ) ! ratio of cloud-ground/intracloud discharges + call addfld( 'LGHTNG_CLD2GRND', horiz_only, 'I', 'min-1', 'clound-to-ground lightning flash rate') ! clound to ground flash frequency end subroutine lightning_init @@ -256,6 +257,7 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) real(r8) :: flash_freq_land, flash_freq_ocn real(r8), pointer :: cld2grnd_flash_freq(:) + real(r8) :: cld2grnd_flash_out(pcols,begchunk:endchunk) if (.not.calc_lightning) return @@ -270,6 +272,7 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) dchgzone(:,:) = 0._r8 cgic(:,:) = 0._r8 flash_energy(:,:) = 0._r8 + cld2grnd_flash_out(:,:) = 0._r8 if (calc_nox_prod) then prod_no(:,:,:) = 0._r8 @@ -311,7 +314,6 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) end do zint(:ncol,pver+1,c) = state(c)%zi(:ncol,pver+1) + zsurf(:ncol) - cld2grnd_flash_freq(:) = 0.0_r8 col_loop : do i = 1,ncol @@ -357,6 +359,7 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) end if cld2grnd_flash_freq(i) = cam_in(c)%landfrac(i)*flash_freq_land*cgic(i,c) ! cld-to-grnd flash frq (per min) + cld2grnd_flash_out(i,c) = cld2grnd_flash_freq(i) if (calc_nox_prod) then !-------------------------------------------------------------------------------- @@ -396,6 +399,7 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) call outfld( 'CGIC', cgic(:,c), pcols, lchnk ) call outfld( 'CLDHGT', cldhgt(:,c), pcols, lchnk ) call outfld( 'DCHGZONE', dchgzone(:,c), pcols, lchnk ) + call outfld( 'LGHTNG_CLD2GRND', cld2grnd_flash_out(:,c), pcols, lchnk ) enddo if (.not.calc_nox_prod) return From 5e75733b8d2e4ea29ea456916f866da06db611a8 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 23 Mar 2023 16:18:39 -0600 Subject: [PATCH 14/28] correct calc_nox_prod logic; misc clean up modified: src/chemistry/mozart/mo_lightning.F90 --- bld/build-namelist | 2 +- src/chemistry/mozart/mo_lightning.F90 | 130 ++++++++++++-------------- 2 files changed, 63 insertions(+), 69 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 2ce9e3f0f7..f5289672d6 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3403,7 +3403,7 @@ if ( length($nl->get_value('soil_erod_file'))>0 ) { } } } -if ($phys =~ /^cam/) { +if (chem_has_species($cfg, 'NO')) { # Lightning scaling add_default($nl, 'lght_no_prd_factor'); } diff --git a/src/chemistry/mozart/mo_lightning.F90 b/src/chemistry/mozart/mo_lightning.F90 index 8aacae0de3..ff04f01aaa 100644 --- a/src/chemistry/mozart/mo_lightning.F90 +++ b/src/chemistry/mozart/mo_lightning.F90 @@ -131,7 +131,7 @@ subroutine lightning_init( pbuf2d ) if (.not.calc_lightning) return - calc_nox_prod = flsh_frq_ndx>0 + calc_nox_prod = lght_no_prd_factor>0._r8 if (calc_nox_prod) then @@ -210,7 +210,6 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) real(r8), parameter :: land = 1._r8 real(r8), parameter :: secpyr = 365._r8 * 8.64e4_r8 - integer :: i, c integer :: cldtind ! level index for cloud top integer :: cldbind ! level index for cloud base > 273k integer :: k, kk, zlow_ind, zhigh_ind, itype @@ -229,14 +228,15 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) real(r8) :: flash_energy(pcols,begchunk:endchunk) ! energy of flashes per second real(r8) :: prod_no_col(pcols,begchunk:endchunk) ! global no production rate for diagnostics real(r8) :: wrk, wrk1, wrk2(1) + integer :: icol ! column index integer :: ncol ! columns per chunk - integer :: lchnk ! columns per chunk + integer :: lchnk ! chunk index real(r8),pointer :: cldtop(:) ! cloud top level index real(r8),pointer :: cldbot(:) ! cloud bottom level index real(r8) :: zmid(pcols,pver) ! geopot height above surface at midpoints (m) real(r8) :: zint(pcols,pver+1,begchunk:endchunk) ! geopot height above surface at interfaces (m) real(r8) :: zsurf(pcols) ! geopot height above surface at interfaces (m) - real(r8) :: rlats(pcols,begchunk:endchunk) ! column latitudes in chunks + real(r8) :: rlats(pcols) ! column latitudes in chunks real(r8) :: wght(pcols) real(r8) :: glob_prod_no_col(pcols,begchunk:endchunk) @@ -257,7 +257,6 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) real(r8) :: flash_freq_land, flash_freq_ocn real(r8), pointer :: cld2grnd_flash_freq(:) - real(r8) :: cld2grnd_flash_out(pcols,begchunk:endchunk) if (.not.calc_lightning) return @@ -272,7 +271,6 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) dchgzone(:,:) = 0._r8 cgic(:,:) = 0._r8 flash_energy(:,:) = 0._r8 - cld2grnd_flash_out(:,:) = 0._r8 if (calc_nox_prod) then prod_no(:,:,:) = 0._r8 @@ -298,32 +296,30 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) ! with 1e17 n atoms per j. the total number of n atoms is then distributed ! over the complete column of grid boxes. !-------------------------------------------------------------------------------- - Chunk_loop : do c = begchunk,endchunk - ncol = state(c)%ncol - lchnk = state(c)%lchnk + Chunk_loop : do lchnk = begchunk,endchunk + ncol = state(lchnk)%ncol call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk), flsh_frq_ndx, cld2grnd_flash_freq ) call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk), cldtop_ndx, cldtop ) call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk), cldbot_ndx, cldbot ) - zsurf(:ncol) = state(c)%phis(:ncol)*rga - call get_rlat_all_p(c, ncol, rlats(1,c) ) - call get_wght_all_p(c, ncol, wght) + zsurf(:ncol) = state(lchnk)%phis(:ncol)*rga + call get_wght_all_p(lchnk, pcols, wght) do k = 1,pver - zmid(:ncol,k) = state(c)%zm(:ncol,k) + zsurf(:ncol) - zint(:ncol,k,c) = state(c)%zi(:ncol,k) + zsurf(:ncol) + zmid(:ncol,k) = state(lchnk)%zm(:ncol,k) + zsurf(:ncol) + zint(:ncol,k,lchnk) = state(lchnk)%zi(:ncol,k) + zsurf(:ncol) end do - zint(:ncol,pver+1,c) = state(c)%zi(:ncol,pver+1) + zsurf(:ncol) + zint(:ncol,pver+1,lchnk) = state(lchnk)%zi(:ncol,pver+1) + zsurf(:ncol) cld2grnd_flash_freq(:) = 0.0_r8 - col_loop : do i = 1,ncol + col_loop : do icol = 1,ncol !-------------------------------------------------------------------------------- ! ... find cloud top and bottom level above 273k !-------------------------------------------------------------------------------- - cldtind = nint( cldtop(i) ) - cldbind = nint( cldbot(i) ) + cldtind = nint( cldtop(icol) ) + cldbind = nint( cldbot(icol) ) do - if( cldbind <= cldtind .or. state(c)%t(i,cldbind) < t0 ) then + if( cldbind <= cldtind .or. state(lchnk)%t(icol,cldbind) < t0 ) then exit end if cldbind = cldbind - 1 @@ -332,17 +328,17 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) !-------------------------------------------------------------------------------- ! ... compute cloud top height and depth of charging zone !-------------------------------------------------------------------------------- - cldhgt(i,c) = m2km*max( 0._r8,zint(i,cldtind,c) ) - dchgz = cldhgt(i,c) - m2km*zmid(i,cldbind) - dchgzone(i,c) = dchgz + cldhgt(icol,lchnk) = m2km*max( 0._r8,zint(icol,cldtind,lchnk) ) + dchgz = cldhgt(icol,lchnk) - m2km*zmid(icol,cldbind) + dchgzone(icol,lchnk) = dchgz !-------------------------------------------------------------------------------- ! ... compute flash frequency for given cloud top height ! (flashes storm^-1 min^-1) !-------------------------------------------------------------------------------- - flash_freq_land = 3.44e-5_r8 * cldhgt(i,c)**4.9_r8 - flash_freq_ocn = 6.40e-4_r8 * cldhgt(i,c)**1.7_r8 - flash_freq(i,c) = cam_in(c)%landfrac(i)*flash_freq_land + & - cam_in(c)%ocnfrac(i) *flash_freq_ocn + flash_freq_land = 3.44e-5_r8 * cldhgt(icol,lchnk)**4.9_r8 + flash_freq_ocn = 6.40e-4_r8 * cldhgt(icol,lchnk)**1.7_r8 + flash_freq(icol,lchnk) = cam_in(lchnk)%landfrac(icol)*flash_freq_land + & + cam_in(lchnk)%ocnfrac(icol) *flash_freq_ocn !-------------------------------------------------------------------------------- ! cgic = proportion of cloud-to-ground flashes @@ -351,15 +347,14 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) ! (https://agupubs.onlinelibrary.wiley.com/doi/epdf/10.1029/96JD03504) ! eq 14 !-------------------------------------------------------------------------------- - cgic(i,c) = 1._r8/((((ca*dchgz + cb)*dchgz + cc) *dchgz + cd)*dchgz + ce) + cgic(icol,lchnk) = 1._r8/((((ca*dchgz + cb)*dchgz + cc) *dchgz + cd)*dchgz + ce) if( dchgz < 5.5_r8 ) then - cgic(i,c) = 0._r8 + cgic(icol,lchnk) = 0._r8 else if( dchgz > 14._r8 ) then - cgic(i,c) = .02_r8 + cgic(icol,lchnk) = .02_r8 end if - cld2grnd_flash_freq(i) = cam_in(c)%landfrac(i)*flash_freq_land*cgic(i,c) ! cld-to-grnd flash frq (per min) - cld2grnd_flash_out(i,c) = cld2grnd_flash_freq(i) + cld2grnd_flash_freq(icol) = cam_in(lchnk)%landfrac(icol)*flash_freq_land*cgic(icol,lchnk) ! cld-to-grnd flash frq (per min) if (calc_nox_prod) then !-------------------------------------------------------------------------------- @@ -367,18 +362,18 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) ! and convert to total energy per second ! set ic = cg !-------------------------------------------------------------------------------- - flash_energy(i,c) = 6.7e9_r8 * flash_freq(i,c)/60._r8 + flash_energy(icol,lchnk) = 6.7e9_r8 * flash_freq(icol,lchnk)/60._r8 !-------------------------------------------------------------------------------- ! ... LKE Aug 23, 2005: scale production to account for different grid ! box sizes. This requires a reduction in the overall fudge factor ! (e.g., from 1.2 to 0.5) !-------------------------------------------------------------------------------- - flash_energy(i,c) = flash_energy(i,c) * wght(i) * geo_factor + flash_energy(icol,lchnk) = flash_energy(icol,lchnk) * wght(icol) * geo_factor !-------------------------------------------------------------------------------- ! ... compute number of n atoms produced per second ! and convert to n atoms per second per cm2 and apply fudge factor !-------------------------------------------------------------------------------- - prod_no_col(i,c) = 1.e17_r8*flash_energy(i,c)/(1.e4_r8*rearth*rearth*wght(i)) * factor + prod_no_col(icol,lchnk) = 1.e17_r8*flash_energy(icol,lchnk)/(1.e4_r8*rearth*rearth*wght(icol)) * factor !-------------------------------------------------------------------------------- ! ... compute global no production rate in tgn/yr: @@ -386,20 +381,20 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) ! nb: 1.65979e-24 = 1/avo ! tgn per year: * secpyr !-------------------------------------------------------------------------------- - glob_prod_no_col(i,c) = 1.e17_r8*flash_energy(i,c) & + glob_prod_no_col(icol,lchnk) = 1.e17_r8*flash_energy(icol,lchnk) & * 14.00674_r8 * 1.65979e-24_r8 * 1.e-12_r8 * secpyr * factor end if end if cloud_layer end do Col_loop + + call outfld( 'LGHTNG_CLD2GRND', cld2grnd_flash_freq, pcols, lchnk ) end do Chunk_loop - do c = begchunk,endchunk - lchnk = state(c)%lchnk - call outfld( 'FLASHFRQ', flash_freq(:,c), pcols, lchnk ) - call outfld( 'CGIC', cgic(:,c), pcols, lchnk ) - call outfld( 'CLDHGT', cldhgt(:,c), pcols, lchnk ) - call outfld( 'DCHGZONE', dchgzone(:,c), pcols, lchnk ) - call outfld( 'LGHTNG_CLD2GRND', cld2grnd_flash_out(:,c), pcols, lchnk ) + do lchnk = begchunk,endchunk + call outfld( 'FLASHFRQ', flash_freq(:,lchnk), pcols, lchnk ) + call outfld( 'CGIC', cgic(:,lchnk), pcols, lchnk ) + call outfld( 'CLDHGT', cldhgt(:,lchnk), pcols, lchnk ) + call outfld( 'DCHGZONE', dchgzone(:,lchnk), pcols, lchnk ) enddo if (.not.calc_nox_prod) return @@ -423,29 +418,29 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) !-------------------------------------------------------------------------------- ! ... Distribute production up to cloud top [Pickering et al., 1998 (JGR)] !-------------------------------------------------------------------------------- - do c = begchunk,endchunk - ncol = state(c)%ncol - lchnk = state(c)%lchnk + do lchnk = begchunk,endchunk + call get_rlat_all_p(lchnk, pcols, rlats) + ncol = state(lchnk)%ncol call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk), cldtop_ndx, cldtop ) - do i = 1,ncol - cldtind = nint( cldtop(i) ) - if( prod_no_col(i,c) > 0._r8 ) then - if( cldhgt(i,c) > 0._r8 ) then - if( abs( rlats(i,c) ) > lat25 ) then - itype = 1 ! midlatitude continental - else if( nint( cam_in(c)%landfrac(i) ) == land ) then - itype = 3 ! tropical continental + do icol = 1,ncol + cldtind = nint( cldtop(icol) ) + if( prod_no_col(icol,lchnk) > 0._r8 ) then + if( cldhgt(icol,lchnk) > 0._r8 ) then + if( abs( rlats(icol) ) > lat25 ) then + itype = 1 ! midlatitude continental + else if( nint( cam_in(lchnk)%landfrac(icol) ) == land ) then + itype = 3 ! tropical continental else - itype = 2 ! topical marine + itype = 2 ! topical marine end if frac_sum = 0._r8 do k = cldtind,pver - zlow = zint(i,k+1,c) * m2km ! lower interface height (km) - zlow_scal = zlow * 16._r8/cldhgt(i,c) ! scale to 16 km convection height - zlow_ind = max( 1,INT(zlow_scal)+1 ) ! lowest vdist index to include in layer - zhigh = zint(i,k,c) * m2km ! upper interface height (km) - zhigh_scal = zhigh * 16._r8/cldhgt(i,c) ! height (km) scaled to 16km convection height - zhigh_ind = max( 1,MIN( 16,INT(zhigh_scal)+1 ) ) ! highest vdist index to include in layer + zlow = zint(icol,k+1,lchnk) * m2km ! lower interface height (km) + zlow_scal = zlow * 16._r8/cldhgt(icol,lchnk) ! scale to 16 km convection height + zlow_ind = max( 1,INT(zlow_scal)+1 ) ! lowest vdist index to include in layer + zhigh = zint(icol,k,lchnk) * m2km ! upper interface height (km) + zhigh_scal = zhigh * 16._r8/cldhgt(icol,lchnk) ! height (km) scaled to 16km convection height + zhigh_ind = max( 1,MIN( 16,INT(zhigh_scal)+1 ) ) ! highest vdist index to include in layer do kk = zlow_ind,zhigh_ind wrk = kk wrk1 = kk - 1 @@ -453,11 +448,11 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) - max( zlow_scal,wrk1 ) fraction = max( 0._r8, min( 1._r8,fraction ) ) frac_sum = frac_sum + fraction*vdist(kk,itype) - prod_no(i,k,c) = prod_no(i,k,c) & ! sum the fraction of column NOx in layer k + prod_no(icol,k,lchnk) = prod_no(icol,k,lchnk) & ! sum the fraction of column NOx in layer k + fraction*vdist(kk,itype)*.01_r8 end do - prod_no(i,k,c) = prod_no_col(i,c) * prod_no(i,k,c) & ! multiply fraction by column amount - / (km2cm*(zhigh - zlow)) ! and convert to atom N cm^-3 s^-1 + prod_no(icol,k,lchnk) = prod_no_col(icol,lchnk) * prod_no(icol,k,lchnk) & ! multiply fraction by column amount + / (km2cm*(zhigh - zlow)) ! and convert to atom N cm^-3 s^-1 end do end if end if @@ -468,11 +463,10 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) !-------------------------------------------------------------------------------- ! ... output lightning no production to history file !-------------------------------------------------------------------------------- - do c = begchunk,endchunk - lchnk = state(c)%lchnk - call outfld( 'LNO_PROD', prod_no(:,:,c), pcols, lchnk ) - call outfld( 'LNO_COL_PROD', glob_prod_no_col(:,c), pcols, lchnk ) - call outfld( 'FLASHENGY', flash_energy(:,c), pcols, lchnk ) + do lchnk = begchunk,endchunk + call outfld( 'LNO_PROD', prod_no(:,:,lchnk), pcols, lchnk ) + call outfld( 'LNO_COL_PROD', glob_prod_no_col(:,lchnk), pcols, lchnk ) + call outfld( 'FLASHENGY', flash_energy(:,lchnk), pcols, lchnk ) enddo end subroutine lightning_no_prod From 62edc57358ca8335863c94606390c049ef603d94 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 23 Mar 2023 16:45:56 -0600 Subject: [PATCH 15/28] minor cleanup --- src/chemistry/mozart/mo_lightning.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/chemistry/mozart/mo_lightning.F90 b/src/chemistry/mozart/mo_lightning.F90 index ff04f01aaa..a6f7bc2888 100644 --- a/src/chemistry/mozart/mo_lightning.F90 +++ b/src/chemistry/mozart/mo_lightning.F90 @@ -107,7 +107,6 @@ subroutine lightning_init( pbuf2d ) ! ... initialize the lightning module !---------------------------------------------------------------------- use mo_constants, only : pi - use mo_chem_utls, only : get_spc_ndx use cam_history, only : addfld, add_default, horiz_only use phys_control, only : phys_getopts From f75b772a13310cfee9d1725b472b88e145b1cdf5 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Fri, 24 Mar 2023 09:39:57 -0600 Subject: [PATCH 16/28] revert setting of lght_no_prd_factor modified: bld/build-namelist --- bld/build-namelist | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index f5289672d6..da1fd4221c 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3397,16 +3397,14 @@ if ( length($nl->get_value('soil_erod_file'))>0 ) { else { if ($chem =~ /trop_strat/ or $chem =~ /waccm_ma/ or $chem =~ /waccm_tsmlt/ or $chem =~ /trop_mozart/) { add_default($nl, 'dust_emis_fact', 'ver'=>'chem'); + # set scaling of lightning NOx production + add_default($nl, 'lght_no_prd_factor' ); } else { add_default($nl, 'dust_emis_fact'); } } } -if (chem_has_species($cfg, 'NO')) { - # Lightning scaling - add_default($nl, 'lght_no_prd_factor'); -} # Seasalt emissions tuning factor if ($chem =~ /_mam(\d)/) { From 3812ed55a2f65a6a9092a856eb1d3055d7804074 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 30 Mar 2023 11:28:55 -0600 Subject: [PATCH 17/28] move setting of namelist options from "Write output files" section modified: bld/build-namelist --- bld/build-namelist | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index da1fd4221c..664e58e2b6 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -4033,6 +4033,21 @@ add_default($nl, 'cam_snapshot_before_num'); add_default($nl, 'cam_snapshot_after_num'); check_snapshot_settings(); +if ($opts{'cmeps'}) { + # advertise the nature of ozone data passed to surface models + if ($rad_prog_ozone) { + add_default($nl, 'atm_ozone_frequency', 'val'=>'subdaily'); + } else { + add_default($nl, 'atm_ozone_frequency', 'val'=>'multiday_average'); + } + # for lightning flash freq to CTSM + if ($simple_phys or $aqua_mode) { + add_default($nl, 'atm_provides_lightning', 'val'=>'.false.'); + } else { + add_default($nl, 'atm_provides_lightning', 'val'=>'.true.'); + } +} + #----------------------------------------------------------------------------------------------- # Write output files @@ -4051,20 +4066,6 @@ foreach my $name (@nl_groups) { $nl_group{$name} = ''; } # Dry deposition, MEGAN VOC emis and ozone namelists @comp_groups = qw(drydep_inparm megan_emis_nl fire_emis_nl carma_inparm ndep_inparm ozone_coupling_nl lightning_coupling_nl); -# nature of ozone data passed to surface models -- only if cmeps (nuopc) coupling is used -if ($opts{'cmeps'}) { - if ($rad_prog_ozone) { - add_default($nl, 'atm_ozone_frequency', 'val'=>'subdaily'); - } else { - add_default($nl, 'atm_ozone_frequency', 'val'=>'multiday_average'); - } - # for lightning flash freq to CTSM - if ($simple_phys or $aqua_mode) { - add_default($nl, 'atm_provides_lightning', 'val'=>'.false.'); - } else { - add_default($nl, 'atm_provides_lightning', 'val'=>'.true.'); - } -} $outfile = "$opts{'dir'}/drv_flds_in"; $nl->write($outfile, 'groups'=>\@comp_groups); if ($print>=1) { From 4e7d6851ea27f0d4d0fb03599b50cd319e11be2b Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Fri, 21 Apr 2023 13:51:44 -0600 Subject: [PATCH 18/28] loop over columns rather than use where block; specify intent for arguments modified: src/chemistry/mozart/ocean_emis.F90 --- src/chemistry/mozart/ocean_emis.F90 | 394 +++++++++++++++------------- 1 file changed, 210 insertions(+), 184 deletions(-) diff --git a/src/chemistry/mozart/ocean_emis.F90 b/src/chemistry/mozart/ocean_emis.F90 index 26819fd846..aea95efa31 100644 --- a/src/chemistry/mozart/ocean_emis.F90 +++ b/src/chemistry/mozart/ocean_emis.F90 @@ -3,23 +3,23 @@ ! Ref: Carpenter et al Chem Soc Rev (2012); Johnson, Ocean sci (2010) ! ------------------------------------------------------------------------------------ ! Required inputs for the air-sea flux module: -! - Seawater concentration (nanomoles per liter) and Sea surface salinity +! - Seawater concentration (nanomoles per liter) and Sea surface salinity ! (parts per thousand) read from namelist (netCDF) ! - Concentration in the gas-phase (pptv), air temperature (K), 10m windspeed (m/s), ! surface pressure (atm), sea surface temperature (K): all from other modules ! ------------------------------------------------------------------------------------ ! Key subroutines: -! ocean_emis_readnl(..): Read salinity from namelist (user_nl_cam). +! ocean_emis_readnl(..): Read salinity from namelist (user_nl_cam). ! Salinity not time-dependent. Flux depends very weakly on it -! ocean_emis_init(...): Interpolate salinity, initialize the library for the flux +! ocean_emis_init(...): Interpolate salinity, initialize the library for the flux ! reading time-dependent seawater conc. from user_nl_cam ! ocean_emis_advance(...): process the seawater concentration -! ocean_emis_getflux(...): calculate the air-sea flux (upward or downward), +! ocean_emis_getflux(...): calculate the air-sea flux (upward or downward), ! then add to total surface flux (sflx) ! ------------------------------------------------------------------------------------ ! Last built: 9 March 2018. ! Written by: Siyuan Wang (ACOM/NCAR) siyuan@ucar.edu -! Acknowledgement: Francis Vitt (NCAR). and of course Dr. Peppurr too +! Acknowledgement: Francis Vitt (NCAR). and of course Dr. Peppurr too ! ==================================================================================== module ocean_emis @@ -33,7 +33,7 @@ module ocean_emis use tracer_data, only : trfld,trfile use chem_mods, only : gas_pcnst use cam_logfile, only : iulog - use ioFileMod, only : getfil + use ioFileMod, only : getfil implicit none @@ -57,9 +57,9 @@ module ocean_emis logical :: switch_bubble type(Csw), allocatable :: Csw_nM(:) - integer :: n_Csw_files + integer :: n_Csw_files - real(r8), allocatable :: salinity(:,:) + real(r8), allocatable :: salinity(:,:) ! ================ ! Air-sea exchange @@ -69,32 +69,32 @@ module ocean_emis Integer, Parameter :: HowManySalts = 5 ! Change this number if you wanna add more salts Integer, Parameter :: HowManySaltProperties = 7 ! Don't touch this (unless you wanna add more fields) - Type GasLib + Type GasLib Character(16) :: CmpdName Real(r8), Dimension(HowManyProperties) :: CmpdProperties End Type GasLib - Type SaltLib + Type SaltLib Character(16) :: SaltName - Real(r8), Dimension(HowManySaltProperties) :: SaltProperties + Real(r8), Dimension(HowManySaltProperties) :: SaltProperties End Type SaltLib Type(GasLib), Dimension(HowManyMolecules) :: GasList ! Library for the trace gas properties Type(SaltLib), Dimension(HowManySalts) :: SaltList ! Library for the salt properties - ! =========================== + ! =========================== ! seawater concentration: ! =========================== - character(len=cl) :: csw_specifier(gas_pcnst) = '' + character(len=cl) :: csw_specifier(gas_pcnst) = '' character(len=24) :: csw_time_type = 'CYCLICAL' ! 'CYCLICAL' | 'SERIAL' | 'INTERP_MISSING_MONTHS' integer :: csw_cycle_yr = 0 - logical :: bubble_mediated_transfer = .false. + logical :: bubble_mediated_transfer = .false. character(len=cl) :: ocean_salinity_file = 'NONE' contains -!-------------------------------------------------------------------------------- -!-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- subroutine ocean_emis_readnl(nlfile) use namelist_utils, only : find_group_name @@ -105,7 +105,7 @@ subroutine ocean_emis_readnl(nlfile) integer :: unitn, ierr character(len=*), parameter :: subname = 'ocean_emis_readnl' - ! =================== + ! =================== ! Namelist definition ! =================== namelist /ocean_emis_nl/ ocean_salinity_file @@ -125,7 +125,7 @@ subroutine ocean_emis_readnl(nlfile) end if close(unitn) end if - + ! ============================ ! Broadcast namelist variables ! ============================ @@ -151,7 +151,7 @@ subroutine ocean_emis_init() use pio, only : file_desc_t, pio_inq_dimid, pio_inq_dimlen, pio_inq_varid, pio_get_var use pio, only : PIO_NOWRITE, PIO_NOERR use pio, only : pio_seterrorhandling, PIO_BCAST_ERROR, pio_closefile - use phys_grid, only : get_ncols_p, get_rlon_all_p, get_rlat_all_p + use phys_grid, only : get_ncols_p, get_rlon_all_p, get_rlat_all_p use interpolate_data, only : lininterp_init, lininterp, interp_type, lininterp_finish use mo_constants, only : pi @@ -162,19 +162,19 @@ subroutine ocean_emis_init() real(r8), allocatable :: file_lats(:), file_lons(:) real(r8), allocatable :: wrk2d(:,:) real(r8) :: to_lats(pcols), to_lons(pcols) - type(interp_type) :: lon_wgts, lat_wgts + type(interp_type) :: lon_wgts, lat_wgts real(r8), parameter :: zero=0_r8, twopi=2_r8*pi, degs2rads = pi/180._r8 character(len=*), parameter :: subname = 'ocean_emis_init' - + if (trim(ocean_salinity_file) == 'NONE') return call getfil( ocean_salinity_file, filen, 0 ) call cam_pio_openfile( fid, filen, PIO_NOWRITE) - + call pio_seterrorhandling(fid, PIO_BCAST_ERROR) - + ierr = pio_inq_dimid( fid, 'lon', dimid ) if (ierr /= PIO_NOERR) then call endrun(subname//': pio_inq_dimid lon FAILED') @@ -225,6 +225,7 @@ subroutine ocean_emis_init() endif allocate(salinity(pcols,begchunk:endchunk)) + salinity = 0._r8 do c=begchunk,endchunk @@ -235,17 +236,21 @@ subroutine ocean_emis_init() call lininterp_init(file_lons, file_nlon, to_lons, ncols, 2, lon_wgts, zero, twopi) call lininterp_init(file_lats, file_nlat, to_lats, ncols, 1, lat_wgts) - call lininterp(wrk2d, file_nlon, file_nlat, salinity(1:ncols,c), ncols, lon_wgts, lat_wgts) + call lininterp(wrk2d, file_nlon, file_nlat, salinity(1:ncols,c), ncols, lon_wgts, lat_wgts) call lininterp_finish(lon_wgts) call lininterp_finish(lat_wgts) end do + where(salinity < 0._r8) + salinity = 33.0_r8 + end where + deallocate( file_lons, file_lats ) deallocate( wrk2d ) - call addfld('OCN_SALINITY', horiz_only, 'A', 'parts per thousands', 'ocean salinity' ) + call addfld('OCN_SALINITY', horiz_only, 'A', 'parts per thousands', 'ocean salinity' ) ! ====================================================== ! initializing the libraries for the air-sea flux module @@ -253,17 +258,17 @@ subroutine ocean_emis_init() Call CmpLibInitialization() Call SaltLibInitialization() - ! --------------------------------------------- + ! --------------------------------------------- ! Read seawater concentration: WSY ! --------------------------------------------- call cseawater_ini() call pio_closefile (fid) - + end subroutine ocean_emis_init -!-------------------------------------------------------------------------------- -!-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- subroutine ocean_emis_advance( pbuf2d, state ) ! ------------------------------- ! check serial case for time span @@ -274,7 +279,7 @@ subroutine ocean_emis_advance( pbuf2d, state ) use tracer_data, only : advance_trcdata use physics_buffer, only : physics_buffer_desc - type(physics_state), intent(in) :: state(begchunk:endchunk) + type(physics_state), intent(in) :: state(begchunk:endchunk) type(physics_buffer_desc), pointer :: pbuf2d(:,:) integer :: m @@ -286,12 +291,12 @@ subroutine ocean_emis_advance( pbuf2d, state ) end subroutine ocean_emis_advance -!-------------------------------------------------------------------------------- -!-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- subroutine ocean_emis_getflux(lchnk, ncol, state, u10, sst, ocnfrac, icefrac, sflx) use physics_types, only : physics_state - use ppgrid, only : pver + use ppgrid, only : pver integer, intent(in) :: lchnk, ncol type(physics_state), target, intent(in) :: state ! Physics state variables @@ -301,13 +306,13 @@ subroutine ocean_emis_getflux(lchnk, ncol, state, u10, sst, ocnfrac, icefrac, sf real(r8), intent(in) :: icefrac(:) ! Ice fraction real(r8), intent(inout) :: sflx(:,:) ! Surface emissions (kg/m^2/s) - integer :: m, isec, SpeciesID - real(r8) :: Csw_col(ncol) - real(r8) :: MW_species - real(r8) :: oceanflux_kg_m2_s(ncol) + integer :: i, m, isec, SpeciesID + real(r8) :: Csw_col(ncol) + real(r8) :: MW_species + real(r8) :: oceanflux_kg_m2_s(ncol) if (trim(ocean_salinity_file) == 'NONE') return - + ! ================================================== ! Get seawater concentrations and calculate the flux ! ================================================== @@ -317,28 +322,30 @@ subroutine ocean_emis_getflux(lchnk, ncol, state, u10, sst, ocnfrac, icefrac, sf isec = 1 Csw_col(:ncol) = Csw_nM(m)%scalefactor*Csw_nM(m)%fields(isec)%data(:ncol,1,lchnk) - MW_species = MolecularWeight(SpeciesIndex( Csw_nM(m)%species )) + MW_species = MolecularWeight(SpeciesIndex( Csw_nM(m)%species )) call cnst_get_ind( trim(Csw_nM(m)%species), SpeciesID, abort=.true. ) oceanflux_kg_m2_s = 0.0_r8 - where (ocnfrac(:ncol) >= 0.2_r8 .and. Csw_col(:ncol) >= 0._r8) ! calculate flux only for ocean - oceanflux_kg_m2_s(:ncol) = Flux_kg_m2_s( & - Csw_nM(m)%species, & ! name of species - state%q(:ncol,pver,SpeciesID) * (28.97_r8/MW_species) * 1.0e+12_r8, & ! air concentration (ppt) - Csw_col(:ncol), & ! sea water concentration (nM) - state%t(:ncol,pver), & ! air temperature (K) - u10(:ncol), & ! wind speed at 10m (m/s) <- should use this - state%ps(:ncol) / 101325.0_r8, & ! surface pressure (atm) - sst(:ncol), & ! sea surface temperautre (K) - salinity(:ncol,lchnk), & ! ocean salinity (parts per thousands) - switch_bubble, & ! bubble-mediated transfer: on or off - ncol ) - end where + do i = 1,ncol + if (ocnfrac(i) >= 0.2_r8 .and. Csw_col(i) >= 0._r8) then + ! calculate flux only for ocean + oceanflux_kg_m2_s(i) = Flux_kg_m2_s( & + Csw_nM(m)%species, & ! name of species + state%q(i,pver,SpeciesID) * (28.97_r8/MW_species) * 1.0e+12_r8, & ! air concentration (ppt) + Csw_col(i), & ! sea water concentration (nM) + state%t(i,pver), & ! air temperature (K) + u10(i), & ! wind speed at 10m (m/s) <- should use this + state%ps(i) / 101325.0_r8, & ! surface pressure (atm) + sst(i), & ! sea surface temperautre (K) + salinity(i,lchnk), & ! ocean salinity (parts per thousands) + switch_bubble ) ! bubble-mediated transfer: on or off + end if + end do ! =========================================================================== - ! Add the ocean flux to the other fluxes + ! Add the ocean flux to the other fluxes ! Make sure this ocean module is called after other surface emissions are set ! =========================================================================== sflx(:ncol,SpeciesID) = sflx(:ncol,SpeciesID) + oceanflux_kg_m2_s(:ncol) * ocnfrac(:ncol) @@ -355,10 +362,8 @@ subroutine ocean_emis_getflux(lchnk, ncol, state, u10, sst, ocnfrac, icefrac, sf end subroutine ocean_emis_getflux - -!-------------------------------------------------------------------------------- -!-------------------------------------------------------------------------------- - + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- Subroutine CmpLibInitialization() ! ===================================================================================== ! This is the lookup table for molecular weight, Vb, and Henry's law constant @@ -377,7 +382,7 @@ Subroutine CmpLibInitialization() GasList(2) = GasLib('C2H5OH', (/ 46.07_r8, 2.0_r8, 6.0_r8, 0.0_r8, 1.0_r8, 0.0_r8, 0.0_r8, & 0.0_r8, 0.0_r8, 0.0_r8, 0.0_r8, 0.0_r8, 0.0_r8, 0.0_r8, 190.0_r8, 6500.0_r8 /)) GasList(3) = GasLib('CH2O', (/ 30.03_r8, 1.0_r8, 2.0_r8, 0.0_r8, 1.0_r8, 0.0_r8, 0.0_r8, & - 0.0_r8, 0.0_r8, 0.0_r8, 1.0_r8, 0.0_r8, 0.0_r8, 0.0_r8, 3230.0_r8, 7100.0_r8 /)) + 0.0_r8, 0.0_r8, 0.0_r8, 1.0_r8, 0.0_r8, 0.0_r8, 0.0_r8, 3230.0_r8, 7100.0_r8 /)) GasList(4) = GasLib('CH3CHO', (/ 44.05_r8, 2.0_r8, 4.0_r8, 0.0_r8, 1.0_r8, 0.0_r8, 0.0_r8, & 0.0_r8, 0.0_r8, 0.0_r8, 1.0_r8, 0.0_r8, 0.0_r8, 0.0_r8, 12.9_r8, 5890.0_r8/)) GasList(5) = GasLib('PROPANAL', (/ 58.08_r8, 3.0_r8, 6.0_r8, 0.0_r8, 1.0_r8, 0.0_r8, 0.0_r8, & @@ -409,10 +414,12 @@ Subroutine CmpLibInitialization() ! -------------------------------------------------------------------------------- End Subroutine CmpLibInitialization + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- Subroutine SaltLibInitialization() ! ================================================================================ - ! This is the lookup table for common solutes in seawater and the parameters to - ! calculate the dynamic viscosity of seawater. + ! This is the lookup table for common solutes in seawater and the parameters to + ! calculate the dynamic viscosity of seawater. ! You may add other solutes or change the mass fractions. ! -------------------------------------------------------------------------------- ! Col 1: mass fraction of solute @@ -431,6 +438,8 @@ Subroutine SaltLibInitialization() ! --------------------------------------------- End Subroutine SaltLibInitialization + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- Function SpeciesIndex(SpeciesName) ! ============================================== ! This function is to look for the species index @@ -439,7 +448,7 @@ Function SpeciesIndex(SpeciesName) Character(Len=16) :: SpeciesName SpeciesIndex = -1 ! return -1 if species is not found - + Do i = 1, HowManyMolecules If (trim(SpeciesName) == trim(GasList(i)%CmpdName)) Then SpeciesIndex = i @@ -448,13 +457,15 @@ Function SpeciesIndex(SpeciesName) End Do End Function SpeciesIndex - Function Flux_kg_m2_s(SpeciesName,Cgas_ppt,Cwater_nM,T_air_K,u10_m_s,P_atm,T_water_K,& - Salinity_PartsPerThousand,switch_bubble,ncol) + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + Real(r8) Function Flux_kg_m2_s(SpeciesName,Cgas_ppt,Cwater_nM,T_air_K,u10_m_s,P_atm,T_water_K,& + Salinity_PartsPerThousand,switch_bubble) ! =========================================================================== ! This is the main module function. Input variables: ! --------------------------------------------------------------------------- ! - SpeciesName: name of species - ! - Cgas_ppt: mixing ratio (parts per trillion) of trace gas of interest + ! - Cgas_ppt: mixing ratio (parts per trillion) of trace gas of interest ! in the gas-phase (lowest modeling layer) ! - Cwater_nM: concentration of trace gas of interest in the surface ocean ! - T_air_K: temperature in the lowest modeling layer @@ -463,52 +474,51 @@ Function Flux_kg_m2_s(SpeciesName,Cgas_ppt,Cwater_nM,T_air_K,u10_m_s,P_atm,T_wat ! - T_water_K: sea surface temperature ! - Salinity_PartsPerThousand: surface ocean salinity ! - switch_bubble: bubble-mediated transfer switch - ! All must be 1D arrays with same dimension(ncol, so CESM-compatible) ! =========================================================================== - Integer :: ncol, SpeciesID - Character(16) :: SpeciesName - Real(r8), Dimension(ncol) :: Flux_kg_m2_s - Real(r8), Dimension(ncol) :: Cgas_ppt, Cwater_nM, T_air_K, u10_m_s, P_atm, T_water_K, Salinity_PartsPerThousand - Real(r8), Dimension(ncol) :: H_gas_over_liquid_dimless, kt_m_s - Logical :: switch_bubble + Character(16),intent(in) :: SpeciesName + Real(r8),intent(in) :: Cgas_ppt, Cwater_nM, T_air_K, u10_m_s, P_atm, T_water_K, Salinity_PartsPerThousand + Logical ,intent(in) :: switch_bubble - where(Salinity_PartsPerThousand .lt. 0.0_r8) Salinity_PartsPerThousand = 33.0_r8 + Integer :: SpeciesID + Real(r8) :: H_gas_over_liquid_dimless, kt_m_s - SpeciesID = SpeciesIndex(SpeciesName) - H_gas_over_liquid_dimless = 1.0_r8/(Henry_M_atm(SpeciesID,T_water_K,Salinity_PartsPerThousand,ncol)*& + SpeciesID = SpeciesIndex(SpeciesName) + H_gas_over_liquid_dimless = 1.0_r8/(Henry_M_atm(SpeciesID,T_water_K,Salinity_PartsPerThousand)*& 0.082_r8*T_water_K) If (switch_bubble) then ! -------------------------------------------------------- ! k_water parameterization with bubble-induced enhancement ! -------------------------------------------------------- kt_m_s = (1.0_r8/k_water_m_s_bubble(SpeciesID, T_water_K, Salinity_PartsPerThousand, & - u10_m_s, Cgas_ppt, P_atm, T_air_K, ncol) & - + 1.0_r8/k_air_m_s(SpeciesID, u10_m_s, T_air_K, P_atm, ncol)& + u10_m_s, Cgas_ppt, P_atm, T_air_K) & + + 1.0_r8/k_air_m_s(SpeciesID, u10_m_s, T_air_K, P_atm)& /H_gas_over_liquid_dimless)**(-1.0_r8) else ! ------------------------------------------------ ! Original k_water parameterization, scaled to CO2 ! ------------------------------------------------ - kt_m_s = (1.0_r8/k_water_m_s(SpeciesID, T_water_K, Salinity_PartsPerThousand, u10_m_s, ncol) & - + 1.0_r8/k_air_m_s(SpeciesID, u10_m_s, T_air_K, P_atm, ncol)/H_gas_over_liquid_dimless)**(-1.0_r8) + kt_m_s = (1.0_r8/k_water_m_s(SpeciesID, T_water_K, Salinity_PartsPerThousand, u10_m_s) & + + 1.0_r8/k_air_m_s(SpeciesID, u10_m_s, T_air_K, P_atm)/H_gas_over_liquid_dimless)**(-1.0_r8) endif Flux_kg_m2_s = kt_m_s * (Cwater_nM*1E-9_r8*1000.0_r8 & - Cgas_ppt*1E-12_r8*(101325.0_r8*P_atm)/8.314_r8/T_air_K/H_gas_over_liquid_dimless) & ! g/m2/s * MolecularWeight(SpeciesIndex(SpeciesName)) / 1000.0_r8 ! convert to kg/m2/s End Function Flux_kg_m2_s - - Function k_air_m_s(SpeciesIndex, u10_m_s, T_air_K, P_atm, ncol) + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + Real(r8) Function k_air_m_s(SpeciesIndex, u10_m_s, T_air_K, P_atm) use shr_const_mod, only: vonKarman=>SHR_CONST_KARMAN ! ============================================================================= - ! Air-side transfer velocity. Slightly modified NOAA COARE (Fairall et al 2003; - ! Feffery et al 2010), as recommended by Johnson Ocean Sci. 2010. + ! Air-side transfer velocity. Slightly modified NOAA COARE (Fairall et al 2003; + ! Feffery et al 2010), as recommended by Johnson Ocean Sci. 2010. ! Dynamic viscosity of air: Tsilingiris 2008 ! ============================================================================= - Integer :: ncol, SpeciesIndex - Real(r8), Dimension(ncol) :: k_air_m_s - Real(r8), Dimension(ncol) :: u10_m_s, T_air_K, P_atm, ustar_m_s, DragCoeff - Real(r8), Dimension(ncol) :: DynamicViscosityAir_kg_m_s, DensityAir_kg_m3, DiffusivityInAir, SchmidtNumberInAir + Integer ,intent(in) :: SpeciesIndex + Real(r8),intent(in) :: u10_m_s, T_air_K, P_atm + + Real(r8) :: ustar_m_s, DragCoeff + Real(r8) :: DynamicViscosityAir_kg_m_s, DensityAir_kg_m3, DiffusivityInAir, SchmidtNumberInAir ! WSY: If local friction velocity is available from the model, might as well use that? ustar_m_s = u10_m_s * sqrt(6.1E-4_r8 + 6.3E-5_r8 * u10_m_s) @@ -516,53 +526,53 @@ Function k_air_m_s(SpeciesIndex, u10_m_s, T_air_K, P_atm, ncol) DynamicViscosityAir_kg_m_s = 1.715747771E-5_r8 + 4.722402075E-8_r8 * (T_air_K-273.15_r8) & - 3.663027156E-10_r8 * ((T_air_K-273.15_r8)**2.0_r8) & + 1.873236686E-12_r8 * ((T_air_K-273.15_r8)**3.0_r8) & - - 8.050218737E-14_r8 * ((T_air_K-273.15_r8)**4.0_r8) + - 8.050218737E-14_r8 * ((T_air_K-273.15_r8)**4.0_r8) DensityAir_kg_m3 = 1.293393662_r8 - 5.538444326e-3_r8 * (T_air_K-273.15_r8) & + 3.860201577e-5_r8 * (T_air_K-273.15_r8)**2.0_r8 & - 5.2536065e-7_r8 * (T_air_K-273.15_r8)**3.0_r8 - DiffusivityInAir = DiffusivityInAir_cm2_s(SpeciesIndex, T_air_K, P_atm, ncol) - SchmidtNumberInAir = DynamicViscosityAir_kg_m_s / DensityAir_kg_m3 / (DiffusivityInAir/10000.0_r8) + DiffusivityInAir = DiffusivityInAir_cm2_s(SpeciesIndex, T_air_K, P_atm) + SchmidtNumberInAir = DynamicViscosityAir_kg_m_s / DensityAir_kg_m3 / (DiffusivityInAir/10000.0_r8) k_air_m_s = 1E-3_r8 + ustar_m_s / (13.3_r8*(SchmidtNumberInAir**0.5_r8)+(DragCoeff**(-0.5_r8))-& 5.0_r8+log(SchmidtNumberInAir)/2.0_r8/vonKarman) End Function k_air_m_s - - - - Function k_water_m_s(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, u10_m_s, ncol) + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + Real(r8) Function k_water_m_s(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, u10_m_s) ! ================================================================================ ! Water-side transfer velocity. Ref: Nightingale et al (2000). Salinity considered ! ================================================================================ - Integer :: ncol, SpeciesIndex - Real(r8), Dimension(ncol) :: k_water_m_s - Real(r8), Dimension(ncol) :: T_water_K, Salinity_PartsPerThousand, u10_m_s - Real(r8), Dimension(ncol) :: DiffusivityInWater, SchmidtNumberInWater - Real(r8) :: SchmidtNumberInWater_CO2ref + Integer ,intent(in) :: SpeciesIndex + Real(r8),intent(in) :: T_water_K, Salinity_PartsPerThousand, u10_m_s + + Real(r8) :: DiffusivityInWater, SchmidtNumberInWater + Real(r8) :: SchmidtNumberInWater_CO2ref + SchmidtNumberInWater_CO2ref = 660.0_r8 ! this is the Schmidt number of CO2 at 20 degC in fresh water - DiffusivityInWater = DiffusivityInWater_cm2_s(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, ncol) - SchmidtNumberInWater = DynamicViscosityWater_g_m_s(T_water_K, Salinity_PartsPerThousand, ncol) / 1000.0_r8 & - / DensityWater_kg_m3(T_water_K,Salinity_PartsPerThousand,ncol)/(DiffusivityInWater/10000.0_r8) + DiffusivityInWater = DiffusivityInWater_cm2_s(SpeciesIndex, T_water_K, Salinity_PartsPerThousand) + SchmidtNumberInWater = DynamicViscosityWater_g_m_s(T_water_K, Salinity_PartsPerThousand) / 1000.0_r8 & + / DensityWater_kg_m3(T_water_K,Salinity_PartsPerThousand)/(DiffusivityInWater/10000.0_r8) k_water_m_s = ((0.222_r8*(u10_m_s**2.0_r8)+0.333_r8*u10_m_s)*& ((SchmidtNumberInWater/SchmidtNumberInWater_CO2ref)**(-0.5_r8)))/360000.0_r8 End Function k_water_m_s - - - - Function k_water_m_s_bubble(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, u10_m_s, Cgas_ppt, P_atm, T_air_K, ncol) + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + Real(r8) Function k_water_m_s_bubble(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, u10_m_s, Cgas_ppt, P_atm, T_air_K) ! ============================================================== ! Water-side transfer velocity. Ref: Asher and Wanninkhof (1998). ! ============================================================== - Integer :: ncol, SpeciesIndex - Real(r8), Dimension(ncol) :: k_water_m_s_bubble - Real(r8), Dimension(ncol) :: T_water_K, Salinity_PartsPerThousand, u10_m_s, Cgas_ppt, P_atm, T_air_K - Real(r8), Dimension(ncol) :: DiffusivityInWater, SchmidtNumberInWater - Real(r8), Dimension(ncol) :: FracCoverage_WhiteCaps, OstwaldSolubilityCoefficient - DiffusivityInWater = DiffusivityInWater_cm2_s(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, ncol) - SchmidtNumberInWater = DynamicViscosityWater_g_m_s(T_water_K, Salinity_PartsPerThousand, ncol) / 1000.0_r8 & - / DensityWater_kg_m3(T_water_K,Salinity_PartsPerThousand,ncol)/(DiffusivityInWater/10000.0_r8) - FracCoverage_WhiteCaps = 2.56e-6_r8 * (u10_m_s - 1.77_r8)**3.0_r8 - OstwaldSolubilityCoefficient = Henry_M_atm(SpeciesIndex,T_water_K,Salinity_PartsPerThousand,ncol) ! just Henry's law (M/atm) + Integer, intent(in) :: SpeciesIndex + Real(r8),intent(in) :: T_water_K, Salinity_PartsPerThousand, u10_m_s, Cgas_ppt, P_atm, T_air_K + + Real(r8) :: DiffusivityInWater, SchmidtNumberInWater + Real(r8) :: FracCoverage_WhiteCaps, OstwaldSolubilityCoefficient + + DiffusivityInWater = DiffusivityInWater_cm2_s(SpeciesIndex, T_water_K, Salinity_PartsPerThousand) + SchmidtNumberInWater = DynamicViscosityWater_g_m_s(T_water_K, Salinity_PartsPerThousand) / 1000.0_r8 & + / DensityWater_kg_m3(T_water_K,Salinity_PartsPerThousand)/(DiffusivityInWater/10000.0_r8) + FracCoverage_WhiteCaps = 2.56e-6_r8 * (u10_m_s - 1.77_r8)**3.0_r8 + OstwaldSolubilityCoefficient = Henry_M_atm(SpeciesIndex,T_water_K,Salinity_PartsPerThousand) ! just Henry's law (M/atm) OstwaldSolubilityCoefficient = OstwaldSolubilityCoefficient * (Cgas_ppt*1.0E-12_r8*P_atm) ! mol / L OstwaldSolubilityCoefficient = OstwaldSolubilityCoefficient * 0.082_r8 * T_air_K / P_atm ! L / L k_water_m_s_bubble = ((47.0_r8*u10_m_s + FracCoverage_WhiteCaps*(115200.0_r8 - 47.0_r8* u10_m_s)) & @@ -570,40 +580,46 @@ Function k_water_m_s_bubble(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, + FracCoverage_WhiteCaps * (-37.0_r8/OstwaldSolubilityCoefficient & + 6120.0_r8*(OstwaldSolubilityCoefficient**(-0.37_r8)) *(SchmidtNumberInWater**(-0.18_r8)))) & * 2.8e-6_r8 - End Function k_water_m_s_bubble - - + End Function k_water_m_s_bubble - Function DiffusivityInAir_cm2_s(SpeciesIndex, T_air_K, P_atm, ncol) + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + Real(r8) Function DiffusivityInAir_cm2_s(SpeciesIndex, T_air_K, P_atm) ! ============================ ! Ref: Johnson Ocean Sci. 2010 ! ============================ - Integer :: ncol, SpeciesIndex - Real(r8), Dimension(ncol) :: DiffusivityInAir_cm2_s, T_air_K, P_atm + Integer ,intent(in) :: SpeciesIndex + Real(r8),intent(in) :: T_air_K, P_atm + Real(r8), parameter :: MW_air = 28.97_r8 ! molecular weight for air Real(r8), parameter :: Va = 20.1_r8 ! molar volume for air Real(r8) :: Vb, MW_species + Vb = LiquidMolarVolume_cm3_mol(SpeciesIndex) MW_species = MolecularWeight(SpeciesIndex) DiffusivityInAir_cm2_s = 0.001_r8 * (T_air_K**1.75_r8) & ! oh f* me * (((MW_air + MW_species)/(MW_air*MW_species))**0.5_r8) & / ((P_atm*(Va**(1.0_r8/3.0_r8)+Vb**(1.0_r8/3.0_r8)))**2.0_r8) - End Function DiffusivityInAir_cm2_s - + End Function DiffusivityInAir_cm2_s - Function DiffusivityInWater_cm2_s(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, ncol) + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + Real(r8) Function DiffusivityInWater_cm2_s(SpeciesIndex, T_water_K, Salinity_PartsPerThousand) ! ================================================= ! Ref: Johnson Ocean Sci. 2010. Salinity considered ! ================================================= - Integer :: ncol, SpeciesIndex - Real(r8), Dimension(ncol) :: DiffusivityInWater_cm2_s, DynamicViscosityWater, T_water_K, Salinity_PartsPerThousand + Integer, intent(in) :: SpeciesIndex + Real(r8),intent(in) :: T_water_K, Salinity_PartsPerThousand + Real(r8), parameter :: AssociationFactor = 2.6_r8 ! ... for water - Real(r8) :: Vb, MW_species + Real(r8) :: DynamicViscosityWater, Vb, MW_species + Vb = LiquidMolarVolume_cm3_mol(SpeciesIndex) MW_species = MolecularWeight(SpeciesIndex) - DynamicViscosityWater = DynamicViscosityWater_g_m_s(T_water_K, Salinity_PartsPerThousand, ncol) + + DynamicViscosityWater = DynamicViscosityWater_g_m_s(T_water_K, Salinity_PartsPerThousand) ! ------------------------------------------------- ! Wilke and Chang 1955: this seems to be a bit high ! ------------------------------------------------- @@ -617,47 +633,51 @@ Function DiffusivityInWater_cm2_s(SpeciesIndex, T_water_K, Salinity_PartsPerThou End Function DiffusivityInWater_cm2_s - - Function DynamicViscosityWater_g_m_s(T_water_K, Salinity_PartsPerThousand, ncol) + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + Real(r8) Function DynamicViscosityWater_g_m_s(T_water_K, Salinity_PartsPerThousand) ! ================================================= ! Ref: Johnson Ocean Sci. 2010. Salinity considered ! ================================================= - Integer :: ncol - Real(r8), Dimension(ncol) :: DynamicViscosityWater_g_m_s, T_water_K, Salinity_PartsPerThousand - Real(r8), Dimension(ncol) :: MassFrac_water, DynamicViscosityPureWater_g_m_s, SaltViscosity, sum_w_ln_SaltViscosity - Integer :: j, n + Real(r8),intent(in) :: T_water_K, Salinity_PartsPerThousand + + Real(r8) :: MassFrac_water, DynamicViscosityPureWater_g_m_s, SaltViscosity, sum_w_ln_SaltViscosity + Integer :: n + sum_w_ln_SaltViscosity = 0.0_r8 MassFrac_water = 1.0_r8 - Salinity_PartsPerThousand / 1000.0_r8 DynamicViscosityPureWater_g_m_s = ((T_water_K-273.15_r8)+246.0_r8) & - / (0.05594_r8*(T_water_K-273.15_r8)**2.0_r8+5.2842_r8*(T_water_K-273.15_r8)+137.37_r8) - Do j = 1, ncol - If (Salinity_PartsPerThousand(j) == 0.0_r8) Then ! pure water - DynamicViscosityWater_g_m_s(j) = DynamicViscosityPureWater_g_m_s(j) + / (0.05594_r8*(T_water_K-273.15_r8)**2.0_r8+5.2842_r8*(T_water_K-273.15_r8)+137.37_r8) + + If (Salinity_PartsPerThousand == 0.0_r8) Then ! pure water + DynamicViscosityWater_g_m_s = DynamicViscosityPureWater_g_m_s Else ! salty water Do n = 1, HowManySalts - SaltViscosity(j) = exp((SaltList(n)%SaltProperties(2) * & - (Salinity_PartsPerThousand(j)/1000.0_r8)**SaltList(n)%SaltProperties(3) & + SaltViscosity = exp((SaltList(n)%SaltProperties(2) * & + (Salinity_PartsPerThousand/1000.0_r8)**SaltList(n)%SaltProperties(3) & + SaltList(n)%SaltProperties(4)) & - / (SaltList(n)%SaltProperties(5)*(T_water_K(j)-273.15_r8) + 1.0_r8)) & - / (SaltList(n)%SaltProperties(6) * (Salinity_PartsPerThousand(j) / & + / (SaltList(n)%SaltProperties(5)*(T_water_K-273.15_r8) + 1.0_r8)) & + / (SaltList(n)%SaltProperties(6) * (Salinity_PartsPerThousand / & 1000.0_r8)**SaltList(n)%SaltProperties(7) + 1.0_r8) - sum_w_ln_SaltViscosity(j) = sum_w_ln_SaltViscosity(j) + (Salinity_PartsPerThousand(j)/1000.0_r8) & - * SaltList(n)%SaltProperties(1) * log(SaltViscosity(j)) + sum_w_ln_SaltViscosity = sum_w_ln_SaltViscosity + (Salinity_PartsPerThousand/1000.0_r8) & + * SaltList(n)%SaltProperties(1) * log(SaltViscosity) End Do - DynamicViscosityWater_g_m_s(j) = exp(MassFrac_water(j) & - * log(DynamicViscosityPureWater_g_m_s(j)) + sum_w_ln_SaltViscosity(j)) + DynamicViscosityWater_g_m_s = exp(MassFrac_water & + * log(DynamicViscosityPureWater_g_m_s) + sum_w_ln_SaltViscosity) Endif - End Do - End Function DynamicViscosityWater_g_m_s + End Function DynamicViscosityWater_g_m_s - Function DensityWater_kg_m3(T_water_K, Salinity_PartsPerThousand, ncol) + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + Real(r8) Function DensityWater_kg_m3(T_water_K, Salinity_PartsPerThousand) ! ==================================================== ! Ref: Millero and Poisson (1981). Salinity considered ! ==================================================== - Integer :: ncol - Real(r8), Dimension(ncol) :: DensityWater_kg_m3, T_water_K, Salinity_PartsPerThousand - Real(r8), Dimension(ncol) :: DensityPureWater_kg_m3, FactorA, FactorB, FactorC + Real(r8), intent(in) :: T_water_K, Salinity_PartsPerThousand + + Real(r8) :: DensityPureWater_kg_m3, FactorA, FactorB, FactorC + DensityPureWater_kg_m3 = 999.842594_r8 + 0.06793952_r8*(T_water_K-273.15_r8) & - 0.00909529_r8*((T_water_K-273.15_r8)**2.0_r8) & + 0.0001001685_r8*((T_water_K-273.15_r8)**3.0_r8) & @@ -669,41 +689,46 @@ Function DensityWater_kg_m3(T_water_K, Salinity_PartsPerThousand, ncol) FactorC = 0.00048314_r8 DensityWater_kg_m3 = DensityPureWater_kg_m3 + FactorA*Salinity_PartsPerThousand & + FactorB*(Salinity_PartsPerThousand**(2.0_r8/3.0_r8)) + FactorC*Salinity_PartsPerThousand - End Function DensityWater_kg_m3 + End Function DensityWater_kg_m3 - Function Henry_M_atm(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, ncol) + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- + Real(r8) Function Henry_M_atm(SpeciesIndex, T_water_K, Salinity_PartsPerThousand) ! ========================================================================================= ! Ref: Sander compilation 2015. Salt-in or salt-out estimated based on Setschenow constants ! ========================================================================================= - Integer :: ncol, j - Integer :: SpeciesIndex - Real(r8), Dimension(ncol) :: Henry_M_atm, T_water_K, Salinity_PartsPerThousand - Real(r8), Dimension(ncol) :: Heff_M_atm_PureWater, Setschenow, Heff_M_atm_SaltyWater + Integer, intent(in) :: SpeciesIndex + Real(r8), intent(in) :: T_water_K, Salinity_PartsPerThousand + + Real(r8) :: Heff_M_atm_PureWater, Setschenow, Heff_M_atm_SaltyWater + Heff_M_atm_PureWater = GasList(SpeciesIndex)%CmpdProperties(15) * & exp(GasList(SpeciesIndex)%CmpdProperties(16) * (1.0_r8/T_water_K - 1.0_r8/298.0_r8)) - Do j = 1, ncol - If (Salinity_PartsPerThousand(j)==0.0_r8) Then - Henry_M_atm(j) = Heff_M_atm_PureWater(j) - Else - Setschenow(j) = log(LiquidMolarVolume_cm3_mol(SpeciesIndex)) * & - (7.33532E-4_r8 + 3.39615E-5_r8 * log(Heff_M_atm_PureWater(j)) & - - 2.40888E-6_r8 * ((log(Heff_M_atm_PureWater(j)))**2.0_r8) & - + 1.57114E-7_r8 * ((log(Heff_M_atm_PureWater(j)))**3.0_r8)) - Heff_M_atm_SaltyWater(j) = Heff_M_atm_PureWater(j) * 10.0_r8**(Setschenow(j)*Salinity_PartsPerThousand(j)) - Henry_M_atm(j) = Heff_M_atm_SaltyWater(j) - Endif - End Do - End Function Henry_M_atm + If (Salinity_PartsPerThousand==0.0_r8) Then + Henry_M_atm = Heff_M_atm_PureWater + Else + Setschenow = log(LiquidMolarVolume_cm3_mol(SpeciesIndex)) * & + (7.33532E-4_r8 + 3.39615E-5_r8 * log(Heff_M_atm_PureWater) & + - 2.40888E-6_r8 * ((log(Heff_M_atm_PureWater))**2.0_r8) & + + 1.57114E-7_r8 * ((log(Heff_M_atm_PureWater))**3.0_r8)) + Heff_M_atm_SaltyWater = Heff_M_atm_PureWater * 10.0_r8**(Setschenow*Salinity_PartsPerThousand) + Henry_M_atm = Heff_M_atm_SaltyWater + Endif + + End Function Henry_M_atm + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- Function MolecularWeight(SpeciesIndex) Real(r8) :: MolecularWeight Integer :: SpeciesIndex MolecularWeight = GasList(SpeciesIndex)%CmpdProperties(1) End Function MolecularWeight - + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- Function LiquidMolarVolume_cm3_mol(SpeciesIndex) ! =========================================================================== ! If no measurements available, i.e. GasList(SpeciesIndex)%CmpdProperties(14) @@ -712,7 +737,7 @@ Function LiquidMolarVolume_cm3_mol(SpeciesIndex) Real(r8) :: LiquidMolarVolume_cm3_mol Integer :: SpeciesIndex - If (GasList(SpeciesIndex)%CmpdProperties(14)/=0.0_r8) Then + If (GasList(SpeciesIndex)%CmpdProperties(14)/=0.0_r8) Then LiquidMolarVolume_cm3_mol = GasList(SpeciesIndex)%CmpdProperties(14) Else LiquidMolarVolume_cm3_mol = 7.0_r8*GasList(SpeciesIndex)%CmpdProperties(2) ! C @@ -731,18 +756,20 @@ Function LiquidMolarVolume_cm3_mol(SpeciesIndex) End Function LiquidMolarVolume_cm3_mol + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- subroutine cseawater_ini() - use mo_chem_utls, only : get_spc_ndx - use tracer_data, only : trcdata_init - use cam_pio_utils, only : cam_pio_openfile + use mo_chem_utls, only : get_spc_ndx + use tracer_data, only : trcdata_init + use cam_pio_utils, only : cam_pio_openfile use pio, only : pio_inquire, pio_nowrite, pio_closefile, pio_inq_varndims use pio, only : pio_inq_varname, file_desc_t, pio_get_att, PIO_NOERR, PIO_GLOBAL - use pio, only : pio_seterrorhandling, PIO_BCAST_ERROR - use string_utils, only : GLC + use pio, only : pio_seterrorhandling, PIO_BCAST_ERROR + use string_utils, only : GLC integer :: i, j, l, m, n, nn, astat, vid, ierr, nvars, isec - integer :: indx(gas_pcnst) + integer :: indx(gas_pcnst) type(file_desc_t) :: ncid character(len=16) :: csw_species(gas_pcnst) character(len=256) :: csw_filenam(gas_pcnst) @@ -766,7 +793,7 @@ subroutine cseawater_ini() character(len=*), parameter :: subname = 'cseawater_ini' - ! ======================================================== + ! ======================================================== ! Read sea water concentration specifier from the namelist ! ======================================================== @@ -827,7 +854,7 @@ subroutine cseawater_ini() ! ------------------------------------------- ! Setup the seawater concentration type array ! ------------------------------------------- - do m=1,n_Csw_files + do m=1,n_Csw_files Csw_nM(m)%spc_ndx = csw_indexes(indx(m)) Csw_nM(m)%units = 'nM' Csw_nM(m)%species = csw_species(indx(m)) @@ -898,9 +925,9 @@ subroutine cseawater_ini() deallocate(vndims) ! Global attribute 'input_method' overrides the srf_emis_type namelist setting on - ! a file-by-file basis. If the emis file does not contain the 'input_method' + ! a file-by-file basis. If the emis file does not contain the 'input_method' ! attribute then the srf_emis_type namelist setting is used. - ierr = pio_get_att(ncid, PIO_GLOBAL, 'input_method', file_interp_type) + ierr = pio_get_att(ncid, PIO_GLOBAL, 'input_method', file_interp_type) if ( ierr == PIO_NOERR) then l = GLC(file_interp_type) csw_time_type(1:l) = file_interp_type(1:l) @@ -932,5 +959,4 @@ subroutine cseawater_ini() end subroutine cseawater_ini - end module ocean_emis From f236f1d62517f725332db5eb88a6a612d7ff01bd Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Mon, 24 Apr 2023 09:59:16 -0600 Subject: [PATCH 19/28] use ESCOMP/CMEPS tag modified: Externals.cfg --- Externals.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index e6ad07a800..dc66b3c485 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -21,9 +21,9 @@ externals = Externals.cfg required = True [cmeps] -branch = cmeps0.14.18_lightning_coupling +tag = cmeps0.14.24 protocol = git -repo_url = https://github.com/fvitt/CMEPS.git +repo_url = https://github.com/ESCOMP/CMEPS.git local_path = components/cmeps required = True From af5d2b61c8716343b6dcf96ce3f86adfe6510214 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Mon, 24 Apr 2023 10:28:47 -0600 Subject: [PATCH 20/28] Jesse's change requests modified: src/chemistry/mozart/mo_lightning.F90 modified: src/control/camsrfexch.F90 --- src/chemistry/mozart/mo_lightning.F90 | 2 +- src/control/camsrfexch.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/chemistry/mozart/mo_lightning.F90 b/src/chemistry/mozart/mo_lightning.F90 index a6f7bc2888..4ef18fbaf6 100644 --- a/src/chemistry/mozart/mo_lightning.F90 +++ b/src/chemistry/mozart/mo_lightning.F90 @@ -155,7 +155,7 @@ subroutine lightning_init( pbuf2d ) allocate( prod_no(pcols,pver,begchunk:endchunk),stat=astat ) if( astat /= 0 ) then write(iulog,*) prefix, 'failed to allocate prod_no; error = ',astat - call endrun + call endrun(prefix//'failed to allocate prod_no') end if geo_factor = ngcols_p/(4._r8*pi) diff --git a/src/control/camsrfexch.F90 b/src/control/camsrfexch.F90 index fd68bb8fd9..de1ea4ce6e 100644 --- a/src/control/camsrfexch.F90 +++ b/src/control/camsrfexch.F90 @@ -303,7 +303,7 @@ subroutine atm2hub_alloc( cam_out ) cam_out(c)%co2prog(:) = 0._r8 cam_out(c)%co2diag(:) = 0._r8 cam_out(c)%ozone(:) = 0._r8 - cam_out(c)%lightning_flash_freq(:) = -huge(1._r8) + cam_out(c)%lightning_flash_freq(:) = 0._r8 cam_out(c)%psl(:) = 0._r8 cam_out(c)%bcphidry(:) = 0._r8 cam_out(c)%bcphodry(:) = 0._r8 From 1349457cbc6be779a52be57b33228554d298aa54 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Tue, 25 Apr 2023 08:47:09 -0600 Subject: [PATCH 21/28] add comment on filling in missing values; start ChangeLog modified: doc/ChangeLog modified: src/chemistry/mozart/ocean_emis.F90 --- doc/ChangeLog | 76 ++++++++++++++++++++++++++++- src/chemistry/mozart/ocean_emis.F90 | 1 + 2 files changed, 75 insertions(+), 2 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 36ce62b27e..0a63c062dc 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,77 @@ =============================================================== +Tag name: cam6_3_108 +Originator(s): fvitt +Date: 25 Apr 2023 +One-line Summary: Ocean emissions fix for coupled runs +Github PR URL: https://github.com/ESCOMP/CAM/pull/795 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Fix issue with ocean emissions in B compsets where SSTs are zero over land. #794 + In configurations where SSTs are zeros over land (B compsets) divide by zero + errors have occurred. The where block used mask the calculations of fluxes was + not preforming as intended to avoid the divide by zero errors. We replace the + where block with a loop over columns and explicitly check columns for ocean + fraction. We preform the flux calculations only in columns not over land. + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M src/chemistry/mozart/ocean_emis.F90 + - preform calculations on single columns + - replace where block with loop over columns -- calc fluxes only in columns over ocean + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel/aux_cam: + +izumi/nag/aux_cam: + +izumi/gnu/aux_cam: + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + Tag name: cam6_3_107 Originator(s): eaton Date: Tue Apr 18 10:27:45 AM EDT 2023 @@ -12,9 +84,9 @@ The Invert_Matrix subroutine in module zonal_mean_mod has been reimplemented using the LAPACK subroutine DGESV. Resolves: -. Replace "Invert_Matrix" subroutine in "zonal_mean_mod.F90" with LAPACK version #736 +. Replace "Invert_Matrix" subroutine in "zonal_mean_mod.F90" with LAPACK version #736 (https://github.com/ESCOMP/CAM/issues/736) -. Bug in zonal mean "Invert_Matrix" subroutine #745 +. Bug in zonal mean "Invert_Matrix" subroutine #745 (https://github.com/ESCOMP/CAM/issues/745) Describe any changes made to build system: none diff --git a/src/chemistry/mozart/ocean_emis.F90 b/src/chemistry/mozart/ocean_emis.F90 index aea95efa31..289cafeb77 100644 --- a/src/chemistry/mozart/ocean_emis.F90 +++ b/src/chemistry/mozart/ocean_emis.F90 @@ -243,6 +243,7 @@ subroutine ocean_emis_init() end do + ! fill in missing values with climatology for modern-day where(salinity < 0._r8) salinity = 33.0_r8 end where From 55f8e282c3c20474f50a8244d87d3bb90d7f5a4c Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Tue, 25 Apr 2023 10:29:07 -0600 Subject: [PATCH 22/28] update ChangeLog --- doc/ChangeLog | 46 +++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 41 insertions(+), 5 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 0a63c062dc..8feb19c343 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -3,18 +3,23 @@ Tag name: cam6_3_108 Originator(s): fvitt Date: 25 Apr 2023 -One-line Summary: Ocean emissions fix for coupled runs -Github PR URL: https://github.com/ESCOMP/CAM/pull/795 +One-line Summary: Ocean emissions bug fix; enable passing lightning flash rates to surface models +Github PR URLs: + + https://github.com/ESCOMP/CAM/pull/795 + https://github.com/ESCOMP/CAM/pull/747 Purpose of changes (include the issue number and title text for each relevant GitHub issue): Fix issue with ocean emissions in B compsets where SSTs are zero over land. #794 In configurations where SSTs are zeros over land (B compsets) divide by zero - errors have occurred. The where block used mask the calculations of fluxes was - not preforming as intended to avoid the divide by zero errors. We replace the - where block with a loop over columns and explicitly check columns for ocean + errors have occurred. The where block used to mask the calculations of fluxes + was not preforming as intended to avoid the divide by zero errors. We replace + the where block with a loop over columns and explicitly check columns for ocean fraction. We preform the flux calculations only in columns not over land. + Enable passing cloud-to-ground lighning flash rates to surface models. #567 + Describe any changes made to build system: Describe any changes made to the namelist: @@ -30,10 +35,41 @@ List all files eliminated: List all files added and what they do: List all existing files that have been modified, and describe the changes: + +M Externals.cfg + - update CMEPS for lightning flash freqencies field + +M bld/build-namelist + - namelist switch in drv_flds_in for lightning flashes + +M bld/namelist_files/namelist_definition.xml + - atm_provides lightning switch + +M src/chemistry/mozart/mo_chemini.F90 +M src/chemistry/mozart/chemistry.F90 + - moved reading lightning namelist options to more general location runtime_opts.F90 + +M src/chemistry/mozart/mo_lightning.F90 + - add namelist reader + - provide cloud-to-ground flash rates + - enable use in configurations without chemistry + - calculate NOx production rates only if needed by chemistry + M src/chemistry/mozart/ocean_emis.F90 - preform calculations on single columns - replace where block with loop over columns -- calc fluxes only in columns over ocean +M src/control/runtime_opts.F90 + - invoke lightning namelist reader + +M src/control/camsrfexch.F90 +M src/cpl/nuopc/atm_import_export.F90 + - add field for export of lightning flash rates + +M src/physics/cam/physpkg.F90 +M src/physics/cam_dev/physpkg.F90 + - call lightning register and init routines + If there were any failures reported from running test_driver.sh on any test platform, and checkin with these failures has been OK'd by the gatekeeper, then copy the lines from the td.*.status files for the failed tests to the From a124a450c85b0d0d358d02e92c45238c0757f319 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 26 Apr 2023 06:03:39 -0600 Subject: [PATCH 23/28] ChangeLog update --- doc/ChangeLog | 69 ++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 65 insertions(+), 4 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 8feb19c343..b536bc7f66 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -14,9 +14,10 @@ Purpose of changes (include the issue number and title text for each relevant Gi Fix issue with ocean emissions in B compsets where SSTs are zero over land. #794 In configurations where SSTs are zeros over land (B compsets) divide by zero errors have occurred. The where block used to mask the calculations of fluxes - was not preforming as intended to avoid the divide by zero errors. We replace - the where block with a loop over columns and explicitly check columns for ocean - fraction. We preform the flux calculations only in columns not over land. + was not preforming as intended to avoid the divide by zero errors. The where + block is replaced with a loop over columns and explicitly check columns for + ocean fraction. The flux calculations are preformed only in columns not over + land. Enable passing cloud-to-ground lighning flash rates to surface models. #567 @@ -75,7 +76,67 @@ platform, and checkin with these failures has been OK'd by the gatekeeper, then copy the lines from the td.*.status files for the failed tests to the appropriate machine below. All failed tests must be justified. -cheyenne/intel/aux_cam: +cheyenne/intel/aux_cam: all bit-for-bit + + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: FAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.cheyenne_intel.cam-co2rmp_usecase (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: NLFAIL) details: + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: NLFAIL) details: + SMS_D_Ld5_Vnuopc.f19_f19_mg17.PC4.cheyenne_intel.cam-cam4_port5d (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + - differences are due to new atmImp_Sa_lightning coupler field -- otherwise all bit-for-bit + - NLCOMP failures are due to new lightning_coupling_nl namelist group in drv_flds_in izumi/nag/aux_cam: From 1bcba618af25a360722d7cb15b757dab2cedd82c Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 27 Apr 2023 03:01:03 -0600 Subject: [PATCH 24/28] set lght_no_prd_factor namelist opt if chem has NO --- bld/build-namelist | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 8226116c77..c63c36cbbc 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3475,14 +3475,16 @@ if ( length($nl->get_value('soil_erod_file'))>0 ) { else { if ($chem =~ /trop_strat/ or $chem =~ /waccm_ma/ or $chem =~ /waccm_tsmlt/ or $chem =~ /trop_mozart/) { add_default($nl, 'dust_emis_fact', 'ver'=>'chem'); - # set scaling of lightning NOx production - add_default($nl, 'lght_no_prd_factor' ); } else { add_default($nl, 'dust_emis_fact'); } } } +if (chem_has_species($cfg, 'NO')) { + # set scaling of lightning NOx production + add_default($nl, 'lght_no_prd_factor' ); +} # Seasalt emissions tuning factor if ($chem =~ /_mam(\d)/) { From b80391594e27cd9f1a9d4e15880e05a318aa0493 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 27 Apr 2023 08:27:36 -0600 Subject: [PATCH 25/28] update ChangeLog --- doc/ChangeLog | 124 ++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 89 insertions(+), 35 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index b536bc7f66..988e60a117 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -2,7 +2,7 @@ Tag name: cam6_3_108 Originator(s): fvitt -Date: 25 Apr 2023 +Date: 27 Apr 2023 One-line Summary: Ocean emissions bug fix; enable passing lightning flash rates to surface models Github PR URLs: @@ -19,7 +19,7 @@ Purpose of changes (include the issue number and title text for each relevant Gi ocean fraction. The flux calculations are preformed only in columns not over land. - Enable passing cloud-to-ground lighning flash rates to surface models. #567 + Enable passing cloud-to-ground lightning flash rates to surface models. #567 Describe any changes made to build system: @@ -42,6 +42,7 @@ M Externals.cfg M bld/build-namelist - namelist switch in drv_flds_in for lightning flashes + - set lght_no_prd_factor if chemistry includes NO M bld/namelist_files/namelist_definition.xml - atm_provides lightning switch @@ -77,11 +78,13 @@ then copy the lines from the td.*.status files for the failed tests to the appropriate machine below. All failed tests must be justified. cheyenne/intel/aux_cam: all bit-for-bit + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: + - pre-existing failure ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: NLFAIL) details: ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: NLFAIL) details: ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) details: - ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: FAIL) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: NLFAIL) details: ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator (Overall: NLFAIL) details: ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: ERC_D_Ln9_Vnuopc.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: @@ -89,10 +92,20 @@ cheyenne/intel/aux_cam: all bit-for-bit ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.cheyenne_intel.cam-co2rmp_usecase (Overall: NLFAIL) details: ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: NLFAIL) details: + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: NLFAIL) details: + SMS_D_Ld5_Vnuopc.f19_f19_mg17.PC4.cheyenne_intel.cam-cam4_port5d (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + - NLCOMP failures are due to new lightning_coupling_nl namelist group in drv_flds_in + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: - ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: NLFAIL) details: ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: @@ -101,35 +114,25 @@ cheyenne/intel/aux_cam: all bit-for-bit ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: - ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) details: ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: - ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined (Overall: NLFAIL) details: - SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: NLFAIL) details: - SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: NLFAIL) details: - SMS_D_Ld5_Vnuopc.f19_f19_mg17.PC4.cheyenne_intel.cam-cam4_port5d (Overall: NLFAIL) details: SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: - SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: - SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: - SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: - SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: - SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: @@ -138,33 +141,84 @@ cheyenne/intel/aux_cam: all bit-for-bit - differences are due to new atmImp_Sa_lightning coupler field -- otherwise all bit-for-bit - NLCOMP failures are due to new lightning_coupling_nl namelist group in drv_flds_in -izumi/nag/aux_cam: +izumi/nag/aux_cam: all bit-for-bit -izumi/gnu/aux_cam: - -CAM tag used for the baseline comparison tests if different than previous -tag: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure -Summarize any changes to answers, i.e., -- what code configurations: -- what platforms/compilers: -- nature of change (roundoff; larger than roundoff but same climate; new - climate): + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: NLFAIL) details: + ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + ERS_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + SMS_D_Ld2_Vnuopc.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: NLFAIL) details: + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: NLFAIL) details: + SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: NLFAIL) details: + SMS_D_Ln9_P1x1_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: NLFAIL) details: + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: NLFAIL) details: + SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + - NLCOMP failures are due to new lightning_coupling_nl namelist group in drv_flds_in -If bitwise differences were observed, how did you show they were no worse -than roundoff? +izumi/gnu/aux_cam: all bit-for-bit -If this tag changes climate describe the run(s) done to evaluate the new -climate in enough detail that it(they) could be reproduced, i.e., -- source tag (all code used must be in the repository): -- platform/compilers: -- configure commandline: -- build-namelist command (or complete namelist): -- MSS location of output: + SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - differences are due to new atmImp_Sa_lightning coupler field -- otherwise all bit-for-bit + - NLCOMP failures are due to new lightning_coupling_nl namelist group in drv_flds_in -MSS location of control simulations used to validate new climate: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC3.izumi_gnu.cam-outfrq3s_usecase (Overall: NLFAIL) details: + ERI_D_Ln18_Vnuopc.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + PEM_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: NLFAIL) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: NLFAIL) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: NLFAIL) details: + SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: NLFAIL) details: + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: NLFAIL) details: + - NLCOMP failures are due to new lightning_coupling_nl namelist group in drv_flds_in -URL for AMWG diagnostics output used to validate new climate: +Summarize any changes to answers: bit-for-bit unchanged =============================================================== =============================================================== From 7bb9d578a879061b6ef8af3625bff24cc70b6c69 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 27 Apr 2023 09:16:57 -0600 Subject: [PATCH 26/28] ChangeLog updates --- doc/ChangeLog | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 988e60a117..70a4abf2fb 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -25,11 +25,15 @@ Describe any changes made to build system: Describe any changes made to the namelist: + atm_provides_lightning indicator drv_flds_in: + If TRUE atmosphere model will provide prognosed lightning flash frequency. + Default: FALSE + List any changes to the defaults for the boundary datasets: Describe any substantial timing or memory changes: -Code reviewed by: +Code reviewed by: cacraigucar nusbaume jedwards4b jtruesdal brian-eaton List all files eliminated: @@ -41,7 +45,7 @@ M Externals.cfg - update CMEPS for lightning flash freqencies field M bld/build-namelist - - namelist switch in drv_flds_in for lightning flashes + - added namelist switch in drv_flds_in for lightning flashes - set lght_no_prd_factor if chemistry includes NO M bld/namelist_files/namelist_definition.xml From a7f83e70234116ee9d265dcb7cdfaefd03e44422 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 27 Apr 2023 09:20:07 -0600 Subject: [PATCH 27/28] ChangeLog updates --- doc/ChangeLog | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 70a4abf2fb..bfbc39f27b 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -21,23 +21,23 @@ Purpose of changes (include the issue number and title text for each relevant Gi Enable passing cloud-to-ground lightning flash rates to surface models. #567 -Describe any changes made to build system: +Describe any changes made to build system: N/A Describe any changes made to the namelist: - atm_provides_lightning indicator drv_flds_in: + atm_provides_lightning indicator added to drv_flds_in: If TRUE atmosphere model will provide prognosed lightning flash frequency. Default: FALSE -List any changes to the defaults for the boundary datasets: +List any changes to the defaults for the boundary datasets: N/A -Describe any substantial timing or memory changes: +Describe any substantial timing or memory changes: N/A Code reviewed by: cacraigucar nusbaume jedwards4b jtruesdal brian-eaton -List all files eliminated: +List all files eliminated: N/A -List all files added and what they do: +List all files added and what they do: N/A List all existing files that have been modified, and describe the changes: From 0be2736b916f2bdbd6d116a19d34319be9252dfe Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 27 Apr 2023 09:22:57 -0600 Subject: [PATCH 28/28] ChangeLog updates --- doc/ChangeLog | 1 - 1 file changed, 1 deletion(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index bfbc39f27b..054da12e4b 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -27,7 +27,6 @@ Describe any changes made to the namelist: atm_provides_lightning indicator added to drv_flds_in: If TRUE atmosphere model will provide prognosed lightning flash frequency. - Default: FALSE List any changes to the defaults for the boundary datasets: N/A