From c410f0ae0998488c1a1146c4f3c9fe3bca0aa061 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 21 Apr 2022 12:30:40 -0600 Subject: [PATCH 001/140] initial commit of ebudget code --- Externals.cfg | 8 +- src/physics/cam/check_energy.F90 | 154 +++++++++++++++++++++++++++++- src/physics/cam/physics_types.F90 | 80 +++++++++++++++- src/physics/cam/physpkg.F90 | 27 +++--- 4 files changed, 247 insertions(+), 22 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 11dbbda0d3..c74ae9e561 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -57,9 +57,9 @@ local_path = libraries/parallelio required = True [cime] -tag = cime6.0.12 +tag = cime6.0.12_addmpasgrids protocol = git -repo_url = https://github.com/ESMCI/cime +repo_url = https://github.com/jtruesdal/cime local_path = cime required = True @@ -72,9 +72,9 @@ externals = Externals_CISM.cfg required = True [clm] -tag = ctsm5.1.dev067 +tag = ctsm5.1.dev069_addmpasgrids protocol = git -repo_url = https://github.com/ESCOMP/CTSM +repo_url = https://github.com/jtruesdal/ctsm local_path = components/clm externals = Externals_CLM.cfg required = True diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 3d0232b356..6550a99277 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -43,8 +43,10 @@ module check_energy public :: check_energy_get_integrals ! get energy integrals computed in check_energy_gmean public :: check_energy_init ! initialization of module public :: check_energy_timestep_init ! timestep initialization of energy integrals and cumulative boundary fluxes + public :: check_energy_budget_init ! initialization of energy budget integrals public :: check_energy_chng ! check changes in integrals against cumulative boundary fluxes public :: check_energy_gmean ! global means of physics input and output total energy + public :: check_energy_budget ! global budgets of physics energies public :: check_energy_fix ! add global mean energy difference as a heating public :: check_tracers_init ! initialize tracer integrals and cumulative boundary fluxes public :: check_tracers_chng ! check changes in integrals against cumulative boundary fluxes @@ -207,6 +209,16 @@ subroutine check_energy_init() call add_default ('DTCORE', 1, ' ') end if +! register history budget variables + call addfld('BP_phy_params', horiz_only, 'A', 'W/m2', 'dE/dt CAM physics parameterizations (phAP-phBP)') + call addfld('BD_phy_params', horiz_only, 'A', 'W/m2', 'dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)') + call addfld('BP_pwork', horiz_only, 'A', 'W/m2', 'dE/dt dry mass adjustment (phAM-phAP)') + call addfld('BD_pwork', horiz_only, 'A', 'W/m2', 'dE/dt dry mass adjustment using dycore E (dyAM-dyAP)') + call addfld('BP_efix', horiz_only, 'A', 'W/m2', 'dE/dt energy fixer (phBP-phBF)') + call addfld('BD_efix', horiz_only, 'A', 'W/m2', 'dE/dt energy fixer using dycore E (dyBP-dyBF)') + call addfld('BP_phys_tot', horiz_only, 'A', 'W/m2', 'dE/dt physics total (phAM-phBF)') + call addfld('BD_phys_tot', horiz_only, 'A', 'W/m2', 'dE/dt physics total using dycore E (dyAM-dyBF)') + end subroutine check_energy_init !=============================================================================== @@ -298,6 +310,32 @@ subroutine check_energy_timestep_init(state, tend, pbuf, col_type) end subroutine check_energy_timestep_init +!=============================================================================== + subroutine check_energy_budget_init(state) +!----------------------------------------------------------------------- +! Compute initial values of energy and water integrals, +! zero cumulative tendencies +!----------------------------------------------------------------------- + use cam_history, only: addfld, add_default, horiz_only +!------------------------------Arguments-------------------------------- + + type(physics_state), intent(inout) :: state +!---------------------------Local storage------------------------------- + integer ncol ! number of atmospheric columns +!----------------------------------------------------------------------- + + ncol = state%ncol +! zero cummulative boundary fluxes + state%te_AP(:ncol,:) = 0._r8 + state%te_BP(:ncol,:) = 0._r8 + state%te_BF(:ncol,:) = 0._r8 + state%te_AM(:ncol,:) = 0._r8 + state%teAPcnt(:) = 0 + state%teBPcnt(:) = 0 + state%teBFcnt(:) = 0 + state%teAMcnt(:) = 0 + end subroutine check_energy_budget_init + !=============================================================================== subroutine check_energy_chng(state, tend, name, nstep, ztodt, & @@ -345,6 +383,12 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & real(r8) :: scaling(state%psetcols,pver) ! scaling for conversion of temperature increment real(r8) :: temp(state%ncol,pver) ! temperature + real(r8) :: se(pcols) ! Dry Static energy (J/m2) + real(r8) :: ke(pcols) ! kinetic energy (J/m2) + real(r8) :: wv(pcols) ! column integrated vapor (kg/m2) + real(r8) :: liq(pcols) ! column integrated liquid (kg/m2) + real(r8) :: ice(pcols) ! column integrated ice (kg/m2) + integer lchnk ! chunk identifier integer ncol ! number of atmospheric columns integer i,k ! column, level indices @@ -371,8 +415,7 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & state%pdel(1:ncol,1:pver), cp_or_cv(1:ncol,1:pver), & state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), state%T(1:ncol,1:pver), & vc_physics, ps = state%ps(1:ncol), phis = state%phis(1:ncol), & - te = te, H2O = tw) - + te = te, H2O = tw, se=se,ke=ke,wv=wv,liq=liq,ice=ice) ! compute expected values and tendencies do i = 1, ncol ! change in static energy and total water @@ -455,7 +498,8 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), temp(1:ncol,1:pver), & vc_dycore, ps = state%ps(1:ncol), phis = state%phis(1:ncol), & z = state%z_ini(1:ncol,:), & - te = state%te_cur(1:ncol,dyn_te_idx), H2O = state%tw_cur(1:ncol,dyn_te_idx)) + te = state%te_cur(1:ncol,dyn_te_idx), H2O = state%tw_cur(1:ncol,dyn_te_idx), & + se=se, ke=ke, wv=wv, liq=liq, ice=ice) else state%te_cur(1:ncol,dyn_te_idx) = te(1:ncol) state%tw_cur(1:ncol,dyn_te_idx) = tw(1:ncol) @@ -529,6 +573,95 @@ subroutine check_energy_gmean(state, pbuf2d, dtime, nstep) end subroutine check_energy_gmean + subroutine check_energy_budget(state, pbuf2d, dtime, nstep) + + use cam_history, only: outfld + use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_chunk + use dyn_tests_utils, only: vc_dycore, vc_height + use physics_types, only: phys_te_idx, dyn_te_idx +!----------------------------------------------------------------------- +! Compute global mean total energy of physics input and output states +! computed consistently with dynamical core vertical coordinate +! (under hydrostatic assumption) +!----------------------------------------------------------------------- +!------------------------------Arguments-------------------------------- + + type(physics_state), intent(in ), dimension(begchunk:endchunk) :: state + type(physics_buffer_desc), pointer :: pbuf2d(:,:) + + real(r8), intent(in) :: dtime ! physics time step + integer , intent(in) :: nstep ! current timestep number + +!---------------------------Local storage------------------------------- + integer :: ncol ! number of active columns + integer :: lchnk ! chunk index + + real(r8) :: te(pcols,begchunk:endchunk,8) + ! total energy of input/output states (copy) + real(r8) :: te_glob(8) ! global means of total energy + real(r8) :: phparam,dyparam,phpwork,dypwork,phefix,dyefix,phphys,dyphys +!----------------------------------------------------------------------- + + ! Copy total energy out of input and output states + do lchnk = begchunk, endchunk + ncol = state(lchnk)%ncol + if (state(lchnk)%teAPcnt(phys_te_idx)==0.or.state(lchnk)%teBPcnt(phys_te_idx)==0) then + te(:ncol,lchnk,1:2)=0._r8 + else + te(:ncol,lchnk,1) = (state(lchnk)%te_AP(:ncol,dyn_te_idx)-state(lchnk)%te_BP(:ncol,dyn_te_idx))/state(lchnk)%teAPcnt(dyn_te_idx)/dtime + te(:ncol,lchnk,2) = (state(lchnk)%te_AP(:ncol,phys_te_idx)-state(lchnk)%te_BP(:ncol,phys_te_idx))/state(lchnk)%teAPcnt(phys_te_idx)/dtime + end if + if (state(lchnk)%teAMcnt(phys_te_idx)==0.or.state(lchnk)%teAPcnt(phys_te_idx)==0) then + te(:ncol,lchnk,3:4)=0._r8 + else + te(:ncol,lchnk,3) = (state(lchnk)%te_AM(:ncol,dyn_te_idx)-state(lchnk)%te_AP(:ncol,dyn_te_idx))/state(lchnk)%teAMcnt(dyn_te_idx)/dtime + te(:ncol,lchnk,4) = (state(lchnk)%te_AM(:ncol,phys_te_idx)-state(lchnk)%te_AP(:ncol,phys_te_idx))/state(lchnk)%teAMcnt(phys_te_idx)/dtime + end if + if (state(lchnk)%teBPcnt(phys_te_idx)==0.or.state(lchnk)%teBFcnt(phys_te_idx)==0) then + te(:ncol,lchnk,5:6)=0._r8 + else + te(:ncol,lchnk,5) = (state(lchnk)%te_BP(:ncol,dyn_te_idx)-state(lchnk)%te_BF(:ncol,dyn_te_idx))/state(lchnk)%teBPcnt(dyn_te_idx)/dtime + te(:ncol,lchnk,6) = (state(lchnk)%te_BP(:ncol,phys_te_idx)-state(lchnk)%te_BF(:ncol,phys_te_idx))/state(lchnk)%teBPcnt(phys_te_idx)/dtime + end if + if (state(lchnk)%teAMcnt(phys_te_idx)==0.or.state(lchnk)%teBFcnt(phys_te_idx)==0) then + te(:ncol,lchnk,7:8)=0._r8 + else + te(:ncol,lchnk,7) = (state(lchnk)%te_AM(:ncol,dyn_te_idx)-state(lchnk)%te_BF(:ncol,dyn_te_idx))/state(lchnk)%teBFcnt(dyn_te_idx)/dtime + te(:ncol,lchnk,8) = (state(lchnk)%te_AM(:ncol,phys_te_idx)-state(lchnk)%te_BF(:ncol,phys_te_idx))/state(lchnk)%teBFcnt(phys_te_idx)/dtime + end if + + call outfld('BP_phy_params', te(:ncol,lchnk,1), pcols, lchnk) + call outfld('BD_phy_params', te(:ncol,lchnk,2), pcols, lchnk) + call outfld('BP_pwork', te(:ncol,lchnk,3), pcols, lchnk) + call outfld('BD_pwork', te(:ncol,lchnk,4), pcols, lchnk) + call outfld('BP_efix', te(:ncol,lchnk,5), pcols, lchnk) + call outfld('BD_efix', te(:ncol,lchnk,6), pcols, lchnk) + call outfld('BP_phys_tot', te(:ncol,lchnk,7), pcols, lchnk) + call outfld('BD_phys_tot', te(:ncol,lchnk,8), pcols, lchnk) + + end do + + ! Compute global means of input and output energies and of + ! surface pressure for heating rate (assume uniform ptop) + call gmean(te, te_glob, 8) + + if (begchunk .le. endchunk) then + dyparam = te_glob(1) + phparam = te_glob(2) + dypwork = te_glob(3) + phpwork = te_glob(4) + dyefix = te_glob(5) + phefix = te_glob(6) + dyphys = te_glob(7) + phphys = te_glob(8) + if (masterproc) then + write(iulog,'(1x,a,1x,4(1x,e25.17))') "nstep, phys param,pwork,efix,phys", phparam, phpwork, phefix, phphys + write(iulog,'(1x,a,1x,4(1x,e25.17))') "nstep, dyn param,pwork,efix,phys", dyparam, dypwork, dyefix, dyphys + end if + end if ! (begchunk .le. endchunk) + + end subroutine check_energy_budget + !=============================================================================== subroutine check_energy_fix(state, ptend, nstep, eshflx) @@ -779,15 +912,18 @@ end subroutine check_tracers_chng !####################################################################### - subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) + subroutine calc_te_and_aam_budgets(state, outfld_name_suffix, te_budget, te_budget_cnt, vc) use physconst, only: gravit,cpair,pi,rearth,omega,get_hydrostatic_energy use cam_history, only: hist_fld_active, outfld use dyn_tests_utils, only: vc_physics, vc_height use cam_abortutils, only: endrun + use physics_types, only: phys_te_idx, dyn_te_idx !------------------------------Arguments-------------------------------- type(physics_state), intent(inout) :: state character(len=*), intent(in) :: outfld_name_suffix ! suffix for "outfld" + real(r8),optional, intent(inout) :: te_budget(pcols,2) ! se + ke + integer, optional, intent(inout) :: te_budget_cnt(2) ! te budget counts for physics and dynamics energies integer, optional, intent(in) :: vc ! vertical coordinate !---------------------------Local storage------------------------------- @@ -809,6 +945,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) integer :: ncol ! number of atmospheric columns integer :: i,k ! column, level indices integer :: vc_loc ! local vertical coordinate variable + integer :: index_loc ! use physics or dynamics array position for te_budget integer :: ixtt ! test tracer index character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 !----------------------------------------------------------------------- @@ -827,8 +964,10 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) ncol = state%ncol if (present(vc)) then + index_loc=dyn_te_idx vc_loc = vc else + index_loc=phys_te_idx vc_loc = vc_physics end if @@ -859,6 +998,13 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) vc_loc, ps = state%ps(1:ncol), phis = state%phis(1:ncol), & z = state%z_ini(1:ncol,:), se = se, ke = ke, wv = wv, liq = liq, ice = ice) + if (present(te_budget)) then +!jt te_budget(1:ncol,index_loc)=te_budget(1:ncol,index_loc)+(se(1:ncol)+ke(1:ncol))*state%area_scale(1:ncol,index_loc) +!jt te_budget_cnt(index_loc)=te_budget_cnt(index_loc) + 1 +!jt te_budget(1:ncol,index_loc)=(se(1:ncol)+ke(1:ncol))*state%area_scale(1:ncol,index_loc) + te_budget(1:ncol,index_loc)=(se(1:ncol)+ke(1:ncol)) + te_budget_cnt(index_loc)= 1 + end if call cnst_get_ind('TT_LW' , ixtt , abort=.false.) tt = 0._r8 diff --git a/src/physics/cam/physics_types.F90 b/src/physics/cam/physics_types.F90 index 6c8218d122..b05f4fab60 100644 --- a/src/physics/cam/physics_types.F90 +++ b/src/physics/cam/physics_types.F90 @@ -8,7 +8,8 @@ module physics_types use constituents, only: pcnst, qmin, cnst_name use geopotential, only: geopotential_dse, geopotential_t use physconst, only: zvir, gravit, cpair, rair, cpairv, rairv - use phys_grid, only: get_ncols_p, get_rlon_all_p, get_rlat_all_p, get_gcol_all_p + use phys_grid, only: get_ncols_p, get_rlon_all_p, get_rlat_all_p, get_gcol_all_p, & + get_area_all_p use cam_logfile, only: iulog use cam_abortutils, only: endrun use phys_control, only: waccmx_is @@ -103,17 +104,28 @@ module physics_types te_ini, &! vertically integrated total (kinetic + static) energy of initial state te_cur, &! vertically integrated total (kinetic + static) energy of current state tw_ini, &! vertically integrated total water of initial state + te_AP, &! vertically integrated total water of initial state + te_AM, &! vertically integrated total water of initial state + te_BF, &! vertically integrated total water of initial state + te_BP, &! vertically integrated total water of initial state + area_scale, &! vertically integrated total water of initial state tw_cur ! vertically integrated total water of new state real(r8), dimension(:,:),allocatable :: & temp_ini, &! Temperature of initial state (used for energy computations) z_ini ! Height of initial state (used for energy computations) + real(r8), dimension(:,:,:),allocatable :: & + te_budgets ! te budget array integer :: count ! count of values with significant energy or water imbalances integer, dimension(:),allocatable :: & latmapback, &! map from column to unique lat for that column lonmapback, &! map from column to unique lon for that column cid ! unique column id integer :: ulatcnt, &! number of unique lats in chunk - uloncnt ! number of unique lons in chunk + uloncnt, &! ! number of unique lons in chunk + teAPcnt(2), &! vertically integrated total water of state after physics + teBPcnt(2), &! vertically integrated total water of state before physics + teBFcnt(2), &! vertically integrated total water of state before fixer + teAMcnt(2) ! vertically integrated total water of state after dry mass adjustment end type physics_state @@ -538,6 +550,16 @@ subroutine physics_state_check(state, name) varname="state%te_ini", msg=msg) call shr_assert_in_domain(state%te_cur(:ncol,:), is_nan=.false., & varname="state%te_cur", msg=msg) + call shr_assert_in_domain(state%te_AP(:ncol,:), is_nan=.false., & + varname="state%te_AP", msg=msg) + call shr_assert_in_domain(state%te_BP(:ncol,:), is_nan=.false., & + varname="state%te_BP", msg=msg) + call shr_assert_in_domain(state%te_BF(:ncol,:), is_nan=.false., & + varname="state%te_BF", msg=msg) + call shr_assert_in_domain(state%te_AM(:ncol,:), is_nan=.false., & + varname="state%te_AM", msg=msg) + call shr_assert_in_domain(state%area_scale(:ncol,:), is_nan=.false., & + varname="state%area_scale", msg=msg) call shr_assert_in_domain(state%tw_ini(:ncol,:), is_nan=.false., & varname="state%tw_ini", msg=msg) call shr_assert_in_domain(state%tw_cur(:ncol,:), is_nan=.false., & @@ -616,6 +638,16 @@ subroutine physics_state_check(state, name) varname="state%te_ini", msg=msg) call shr_assert_in_domain(state%te_cur(:ncol,:), lt=posinf_r8, gt=neginf_r8, & varname="state%te_cur", msg=msg) + call shr_assert_in_domain(state%te_AP(:ncol,:), lt=posinf_r8, gt=neginf_r8, & + varname="state%te_AP", msg=msg) + call shr_assert_in_domain(state%te_BP(:ncol,:), lt=posinf_r8, gt=neginf_r8, & + varname="state%te_BP", msg=msg) + call shr_assert_in_domain(state%te_BF(:ncol,:), lt=posinf_r8, gt=neginf_r8, & + varname="state%te_BF", msg=msg) + call shr_assert_in_domain(state%te_AM(:ncol,:), lt=posinf_r8, gt=neginf_r8, & + varname="state%te_AM", msg=msg) + call shr_assert_in_domain(state%area_scale(:ncol,:), lt=posinf_r8, gt=neginf_r8, & + varname="state%area_scale", msg=msg) call shr_assert_in_domain(state%tw_ini(:ncol,:), lt=posinf_r8, gt=neginf_r8, & varname="state%tw_ini", msg=msg) call shr_assert_in_domain(state%tw_cur(:ncol,:), lt=posinf_r8, gt=neginf_r8, & @@ -1052,6 +1084,7 @@ subroutine physics_state_set_grid(lchnk, phys_state) !----------------------------------------------------------------------- ! Set the grid components of the physics_state object !----------------------------------------------------------------------- + use physconst, only: pi integer, intent(in) :: lchnk type(physics_state), intent(inout) :: phys_state @@ -1060,6 +1093,7 @@ subroutine physics_state_set_grid(lchnk, phys_state) integer :: i, ncol real(r8) :: rlon(pcols) real(r8) :: rlat(pcols) + real(r8) :: area(pcols) !----------------------------------------------------------------------- ! get_ncols_p requires a state which does not have sub-columns @@ -1076,11 +1110,13 @@ subroutine physics_state_set_grid(lchnk, phys_state) call get_rlon_all_p(lchnk, ncol, rlon) call get_rlat_all_p(lchnk, ncol, rlat) + call get_area_all_p(lchnk, ncol, area) phys_state%ncol = ncol phys_state%lchnk = lchnk do i=1,ncol phys_state%lat(i) = rlat(i) phys_state%lon(i) = rlon(i) + phys_state%area_scale(i,:) = area(i)/4.0_r8*pi end do call init_geo_unique(phys_state,ncol) @@ -1311,6 +1347,11 @@ subroutine physics_state_copy(state_in, state_out) end do state_out%te_ini(:ncol,:) = state_in%te_ini(:ncol,:) state_out%te_cur(:ncol,:) = state_in%te_cur(:ncol,:) + state_out%te_AP(:ncol,:) = state_in%te_AP(:ncol,:) + state_out%te_BP(:ncol,:) = state_in%te_BP(:ncol,:) + state_out%te_BF(:ncol,:) = state_in%te_BF(:ncol,:) + state_out%te_AM(:ncol,:) = state_in%te_AM(:ncol,:) + state_out%area_scale(:ncol,:) = state_in%area_scale(:ncol,:) state_out%tw_ini(:ncol,:) = state_in%tw_ini(:ncol,:) state_out%tw_cur(:ncol,:) = state_in%tw_cur(:ncol,:) @@ -1595,6 +1636,21 @@ subroutine physics_state_alloc(state,lchnk,psetcols) allocate(state%te_cur(psetcols,2), stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%te_cur') + allocate(state%te_AP(psetcols,2), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%te_AP') + + allocate(state%te_BP(psetcols,2), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%te_BP') + + allocate(state%te_BF(psetcols,2), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%te_BF') + + allocate(state%te_AM(psetcols,2), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%te_AM') + + allocate(state%area_scale(psetcols,2), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%area_scale') + allocate(state%tw_ini(psetcols,2), stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%tw_ini') @@ -1648,6 +1704,11 @@ subroutine physics_state_alloc(state,lchnk,psetcols) state%te_ini(:,:) = inf state%te_cur(:,:) = inf + state%te_AP(:,:) = inf + state%te_BP(:,:) = inf + state%te_BF(:,:) = inf + state%te_AM(:,:) = inf + state%area_scale(:,:) = inf state%tw_ini(:,:) = inf state%tw_cur(:,:) = inf state%temp_ini(:,:) = inf @@ -1754,6 +1815,21 @@ subroutine physics_state_dealloc(state) deallocate(state%te_cur, stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%te_cur') + deallocate(state%te_AP, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%te_AP') + + deallocate(state%te_BP, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%te_BP') + + deallocate(state%te_BF, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%te_BF') + + deallocate(state%te_AM, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%te_AM') + + deallocate(state%area_scale, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%area_scale') + deallocate(state%tw_ini, stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%tw_ini') diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 0db55d6e64..a414bc2d65 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -763,6 +763,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use nudging, only: Nudge_Model, nudging_init use cam_snapshot, only: cam_snapshot_init use cam_history, only: addfld, register_vector_field, add_default + use check_energy, only: check_energy_budget_init use phys_control, only: phys_getopts ! Input/output arguments @@ -788,6 +789,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) do lchnk = begchunk, endchunk call physics_state_set_grid(lchnk, phys_state(lchnk)) + call check_energy_budget_init(phys_state(lchnk)) end do !------------------------------------------------------------------------------------------- @@ -1044,7 +1046,7 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) !----------------------------------------------------------------------- use time_manager, only: get_nstep use cam_diagnostics,only: diag_allocate, diag_physvar_ic - use check_energy, only: check_energy_gmean + use check_energy, only: check_energy_gmean, check_energy_budget use phys_control, only: phys_getopts use spcam_drivers, only: tphysbc_spcam use spmd_utils, only: mpicom @@ -1097,6 +1099,7 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) ! Compute total energy of input state and previous output state call t_startf ('chk_en_gmean') call check_energy_gmean(phys_state, pbuf2d, ztodt, nstep) + call check_energy_budget(phys_state, pbuf2d ,ztodt,nstep) call t_stopf ('chk_en_gmean') call t_stopf ('physpkg_st1') @@ -1801,8 +1804,8 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat) end if - call calc_te_and_aam_budgets(state, 'phAP') - call calc_te_and_aam_budgets(state, 'dyAP',vc=vc_dycore) + call calc_te_and_aam_budgets(state, 'phAP', state%te_AP, state%teAPcnt) + call calc_te_and_aam_budgets(state, 'dyAP', state%te_AP, state%teAPcnt, vc=vc_dycore) !--------------------------------------------------------------------------------- ! Enforce charge neutrality after O+ change from ionos_tend @@ -1880,8 +1883,8 @@ subroutine tphysac (ztodt, cam_in, & call physics_dme_adjust(state, tend, qini, ztodt) - call calc_te_and_aam_budgets(state, 'phAM') - call calc_te_and_aam_budgets(state, 'dyAM',vc=vc_dycore) + call calc_te_and_aam_budgets(state, 'phAM', state%te_AM, state%teAMcnt) + call calc_te_and_aam_budgets(state, 'dyAM', state%te_AM, state%teAMcnt, vc=vc_dycore) ! Restore pre-"physics_dme_adjust" tracers state%q(:ncol,:pver,:pcnst) = tmp_trac(:ncol,:pver,:pcnst) state%pdel(:ncol,:pver) = tmp_pdel(:ncol,:pver) @@ -1902,8 +1905,8 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat) end if - call calc_te_and_aam_budgets(state, 'phAM') - call calc_te_and_aam_budgets(state, 'dyAM',vc=vc_dycore) + call calc_te_and_aam_budgets(state, 'phAM', state%te_AM, state%teAMcnt) + call calc_te_and_aam_budgets(state, 'dyAM', state%te_AM, state%teAMcnt, vc=vc_dycore) endif !!! REMOVE THIS CALL, SINCE ONLY Q IS BEING ADJUSTED. WON'T BALANCE ENERGY. TE IS SAVED BEFORE THIS @@ -1939,7 +1942,7 @@ subroutine tphysac (ztodt, cam_in, & end subroutine tphysac subroutine tphysbc (ztodt, state, & - tend, pbuf, & + tend, pbuf, & cam_out, cam_in ) !----------------------------------------------------------------------- ! @@ -2193,16 +2196,16 @@ subroutine tphysbc (ztodt, state, & !=================================================== call t_startf('energy_fixer') - call calc_te_and_aam_budgets(state, 'phBF') - call calc_te_and_aam_budgets(state, 'dyBF',vc=vc_dycore) + call calc_te_and_aam_budgets(state, 'phBF', state%te_BF, state%teBFcnt) + call calc_te_and_aam_budgets(state, 'dyBF', state%te_BF, state%teBFcnt, vc=vc_dycore) if (.not.dycore_is('EUL')) then call check_energy_fix(state, ptend, nstep, flx_heat) call physics_update(state, ptend, ztodt, tend) call check_energy_chng(state, tend, "chkengyfix", nstep, ztodt, zero, zero, zero, flx_heat) call outfld( 'EFIX', flx_heat , pcols, lchnk ) end if - call calc_te_and_aam_budgets(state, 'phBP') - call calc_te_and_aam_budgets(state, 'dyBP',vc=vc_dycore) + call calc_te_and_aam_budgets(state, 'phBP', state%te_BP, state%teBPcnt) + call calc_te_and_aam_budgets(state, 'dyBP', state%te_BP, state%teBPcnt, vc=vc_dycore) ! Save state for convective tendency calculations. call diag_conv_tend_ini(state, pbuf) From 6aeaacb30f3e443d09677eaf3b07a8fc10e990a6 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 21 Apr 2022 13:10:26 -0600 Subject: [PATCH 002/140] add cam6_3_044 mods to dyn_grid and cam_grid_support to support writes to GLL grid --- src/dynamics/se/dyn_grid.F90 | 30 ++++++++++++------------------ src/utils/cam_grid_support.F90 | 6 ++++-- 2 files changed, 16 insertions(+), 20 deletions(-) diff --git a/src/dynamics/se/dyn_grid.F90 b/src/dynamics/se/dyn_grid.F90 index 785175f77c..d68d4cfe0a 100644 --- a/src/dynamics/se/dyn_grid.F90 +++ b/src/dynamics/se/dyn_grid.F90 @@ -546,16 +546,9 @@ subroutine physgrid_copy_attributes_d(gridname, grid_attribute_names) grid_attribute_names(2) = 'ne' else gridname = 'GLL' - allocate(grid_attribute_names(3)) - ! For standard CAM-SE, we need to copy the area attribute. - ! For physgrid, the physics grid will create area (GLL has area_d) - if (trim(ini_grid_hdim_name) == 'ncol_d') then - grid_attribute_names(1) = 'area_d' - else - grid_attribute_names(1) = 'area' - end if - grid_attribute_names(2) = 'np' - grid_attribute_names(3) = 'ne' + allocate(grid_attribute_names(2)) + grid_attribute_names(1) = 'np' + grid_attribute_names(2) = 'ne' end if end subroutine physgrid_copy_attributes_d @@ -816,9 +809,9 @@ subroutine define_cam_grids() ncolname = 'ncol' areaname = 'area' end if - lat_coord => horiz_coord_create(trim(latname), trim(ncolname), ngcols_d, & + lat_coord => horiz_coord_create('lat_d', 'ncol_d', ngcols_d, & 'latitude', 'degrees_north', 1, size(pelat_deg), pelat_deg, map=pemap) - lon_coord => horiz_coord_create(trim(lonname), trim(ncolname), ngcols_d, & + lon_coord => horiz_coord_create('lon_d', 'ncol_d', ngcols_d, & 'longitude', 'degrees_east', 1, size(pelon_deg), pelon_deg, map=pemap) ! Map for GLL grid @@ -837,15 +830,14 @@ subroutine define_cam_grids() ! The native SE GLL grid call cam_grid_register('GLL', dyn_decomp, lat_coord, lon_coord, & grid_map, block_indexed=.false., unstruct=.true.) - call cam_grid_attribute_register('GLL', trim(areaname), 'gll grid areas', & - trim(ncolname), pearea, map=pemap) + call cam_grid_attribute_register('GLL', 'area_d', 'gll grid areas', & + 'ncol_d', pearea, map=pemap) call cam_grid_attribute_register('GLL', 'np', '', np) call cam_grid_attribute_register('GLL', 'ne', '', ne) - ! With CSLAM if the initial file uses the horizontal dimension 'ncol' rather than - ! 'ncol_d' then we need a grid object with the names ncol,lat,lon to read it. - ! Create that grid object here if it's needed. - if (fv_nphys > 0 .and. trim(ini_grid_hdim_name) == 'ncol') then + ! If dim name is 'ncol', create INI grid + ! We will read from INI grid, but use GLL grid for all output + if (trim(ini_grid_hdim_name) == 'ncol') then lat_coord => horiz_coord_create('lat', 'ncol', ngcols_d, & 'latitude', 'degrees_north', 1, size(pelat_deg), pelat_deg, map=pemap) @@ -854,6 +846,8 @@ subroutine define_cam_grids() call cam_grid_register('INI', ini_decomp, lat_coord, lon_coord, & grid_map, block_indexed=.false., unstruct=.true.) + call cam_grid_attribute_register('INI', 'area', 'ini grid areas', & + 'ncol', pearea, map=pemap) ini_grid_name = 'INI' else diff --git a/src/utils/cam_grid_support.F90 b/src/utils/cam_grid_support.F90 index 79d6484975..30ffe78576 100644 --- a/src/utils/cam_grid_support.F90 +++ b/src/utils/cam_grid_support.F90 @@ -2203,7 +2203,7 @@ end subroutine write_cam_grid_attr_0d_char subroutine write_cam_grid_attr_1d_int(attr, File) use pio, only: file_desc_t, pio_put_att, pio_noerr use pio, only: pio_inq_dimid, pio_int - use cam_pio_utils, only: cam_pio_def_var + use cam_pio_utils, only: cam_pio_def_var, cam_pio_closefile ! Dummy arguments class(cam_grid_attribute_1d_int_t), intent(inout) :: attr @@ -2224,6 +2224,7 @@ subroutine write_cam_grid_attr_1d_int(attr, File) ! NB: It should have been defined as part of a coordinate write(errormsg, *) 'write_cam_grid_attr_1d_int: dimension, ', & trim(attr%dimname), ', does not exist' + call cam_pio_closefile(File) call endrun(errormsg) end if ! Time to define the variable @@ -2247,7 +2248,7 @@ end subroutine write_cam_grid_attr_1d_int subroutine write_cam_grid_attr_1d_r8(attr, File) use pio, only: file_desc_t, pio_put_att, pio_noerr, pio_double, & pio_inq_dimid - use cam_pio_utils, only: cam_pio_def_var + use cam_pio_utils, only: cam_pio_def_var, cam_pio_closefile ! Dummy arguments class(cam_grid_attribute_1d_r8_t), intent(inout) :: attr @@ -2268,6 +2269,7 @@ subroutine write_cam_grid_attr_1d_r8(attr, File) ! NB: It should have been defined as part of a coordinate write(errormsg, *) 'write_cam_grid_attr_1d_r8: dimension, ', & trim(attr%dimname), ', does not exist' + call cam_pio_closefile(File) call endrun(errormsg) end if ! Time to define the variable From 60acd6c9db5bc0ccb24d86d4750ade4702b26db7 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 21 Apr 2022 14:30:08 -0600 Subject: [PATCH 003/140] fix bug in budgeting logic when dynamic energy variables are not output to history --- src/physics/cam/check_energy.F90 | 53 ++++++++++++++++++++++---------- 1 file changed, 36 insertions(+), 17 deletions(-) diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 6550a99277..ec0c2df33f 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -605,39 +605,58 @@ subroutine check_energy_budget(state, pbuf2d, dtime, nstep) ! Copy total energy out of input and output states do lchnk = begchunk, endchunk ncol = state(lchnk)%ncol - if (state(lchnk)%teAPcnt(phys_te_idx)==0.or.state(lchnk)%teBPcnt(phys_te_idx)==0) then - te(:ncol,lchnk,1:2)=0._r8 + if (state(lchnk)%teAPcnt(dyn_te_idx)==0.or.state(lchnk)%teBPcnt(dyn_te_idx)==0) then + te(:ncol,lchnk,1)=0._r8 else te(:ncol,lchnk,1) = (state(lchnk)%te_AP(:ncol,dyn_te_idx)-state(lchnk)%te_BP(:ncol,dyn_te_idx))/state(lchnk)%teAPcnt(dyn_te_idx)/dtime + end if + if (state(lchnk)%teAPcnt(phys_te_idx)==0.or.state(lchnk)%teBPcnt(phys_te_idx)==0) then + te(:ncol,lchnk,2)=0._r8 + else te(:ncol,lchnk,2) = (state(lchnk)%te_AP(:ncol,phys_te_idx)-state(lchnk)%te_BP(:ncol,phys_te_idx))/state(lchnk)%teAPcnt(phys_te_idx)/dtime end if - if (state(lchnk)%teAMcnt(phys_te_idx)==0.or.state(lchnk)%teAPcnt(phys_te_idx)==0) then - te(:ncol,lchnk,3:4)=0._r8 + + if (state(lchnk)%teAMcnt(dyn_te_idx)==0.or.state(lchnk)%teAPcnt(dyn_te_idx)==0) then + te(:ncol,lchnk,3)=0._r8 else te(:ncol,lchnk,3) = (state(lchnk)%te_AM(:ncol,dyn_te_idx)-state(lchnk)%te_AP(:ncol,dyn_te_idx))/state(lchnk)%teAMcnt(dyn_te_idx)/dtime + end if + if (state(lchnk)%teAMcnt(phys_te_idx)==0.or.state(lchnk)%teAPcnt(phys_te_idx)==0) then + te(:ncol,lchnk,4)=0._r8 + else te(:ncol,lchnk,4) = (state(lchnk)%te_AM(:ncol,phys_te_idx)-state(lchnk)%te_AP(:ncol,phys_te_idx))/state(lchnk)%teAMcnt(phys_te_idx)/dtime end if - if (state(lchnk)%teBPcnt(phys_te_idx)==0.or.state(lchnk)%teBFcnt(phys_te_idx)==0) then - te(:ncol,lchnk,5:6)=0._r8 + + if (state(lchnk)%teBPcnt(dyn_te_idx)==0.or.state(lchnk)%teBFcnt(dyn_te_idx)==0) then + te(:ncol,lchnk,5)=0._r8 else te(:ncol,lchnk,5) = (state(lchnk)%te_BP(:ncol,dyn_te_idx)-state(lchnk)%te_BF(:ncol,dyn_te_idx))/state(lchnk)%teBPcnt(dyn_te_idx)/dtime + end if + if (state(lchnk)%teBPcnt(phys_te_idx)==0.or.state(lchnk)%teBFcnt(phys_te_idx)==0) then + te(:ncol,lchnk,6)=0._r8 + else te(:ncol,lchnk,6) = (state(lchnk)%te_BP(:ncol,phys_te_idx)-state(lchnk)%te_BF(:ncol,phys_te_idx))/state(lchnk)%teBPcnt(phys_te_idx)/dtime end if - if (state(lchnk)%teAMcnt(phys_te_idx)==0.or.state(lchnk)%teBFcnt(phys_te_idx)==0) then - te(:ncol,lchnk,7:8)=0._r8 + + if (state(lchnk)%teAMcnt(dyn_te_idx)==0.or.state(lchnk)%teBFcnt(dyn_te_idx)==0) then + te(:ncol,lchnk,7)=0._r8 else te(:ncol,lchnk,7) = (state(lchnk)%te_AM(:ncol,dyn_te_idx)-state(lchnk)%te_BF(:ncol,dyn_te_idx))/state(lchnk)%teBFcnt(dyn_te_idx)/dtime + end if + if (state(lchnk)%teAMcnt(phys_te_idx)==0.or.state(lchnk)%teBFcnt(phys_te_idx)==0) then + te(:ncol,lchnk,8)=0._r8 + else te(:ncol,lchnk,8) = (state(lchnk)%te_AM(:ncol,phys_te_idx)-state(lchnk)%te_BF(:ncol,phys_te_idx))/state(lchnk)%teBFcnt(phys_te_idx)/dtime end if - call outfld('BP_phy_params', te(:ncol,lchnk,1), pcols, lchnk) - call outfld('BD_phy_params', te(:ncol,lchnk,2), pcols, lchnk) - call outfld('BP_pwork', te(:ncol,lchnk,3), pcols, lchnk) - call outfld('BD_pwork', te(:ncol,lchnk,4), pcols, lchnk) - call outfld('BP_efix', te(:ncol,lchnk,5), pcols, lchnk) - call outfld('BD_efix', te(:ncol,lchnk,6), pcols, lchnk) - call outfld('BP_phys_tot', te(:ncol,lchnk,7), pcols, lchnk) - call outfld('BD_phys_tot', te(:ncol,lchnk,8), pcols, lchnk) + call outfld('BD_phy_params', te(:ncol,lchnk,1), pcols, lchnk) + call outfld('BP_phy_params', te(:ncol,lchnk,2), pcols, lchnk) + call outfld('BD_pwork', te(:ncol,lchnk,3), pcols, lchnk) + call outfld('BP_pwork', te(:ncol,lchnk,4), pcols, lchnk) + call outfld('BD_efix', te(:ncol,lchnk,5), pcols, lchnk) + call outfld('BP_efix', te(:ncol,lchnk,6), pcols, lchnk) + call outfld('BD_phys_tot', te(:ncol,lchnk,7), pcols, lchnk) + call outfld('BP_phys_tot', te(:ncol,lchnk,8), pcols, lchnk) end do @@ -970,7 +989,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix, te_budget, te_budg index_loc=phys_te_idx vc_loc = vc_physics end if - + write(6,*)'calc_te index_loc,outfld_name_suffix,present(vc)=',index_loc,outfld_name_suffix,present(vc) if (state%psetcols == pcols) then if (vc_loc == vc_height) then ! From e456289c60270a2c6c57782366a9d0cebfe1844d Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Sun, 24 Apr 2022 19:40:15 -0600 Subject: [PATCH 004/140] updates to the inline energy diagnostics including a new budgets module that handles the meta data involved in working with budgets similar to the way constituents are handled --- src/physics/cam/budgets.F90 | 411 ++++++++++++++++++++++++++++++ src/physics/cam/check_energy.F90 | 195 ++++++-------- src/physics/cam/physics_types.F90 | 99 ++----- src/physics/cam/physpkg.F90 | 73 ++++-- 4 files changed, 580 insertions(+), 198 deletions(-) create mode 100644 src/physics/cam/budgets.F90 diff --git a/src/physics/cam/budgets.F90 b/src/physics/cam/budgets.F90 new file mode 100644 index 0000000000..5e1e7adbdc --- /dev/null +++ b/src/physics/cam/budgets.F90 @@ -0,0 +1,411 @@ + +module budgets + +! Metadata manager for the budgets. + +use shr_kind_mod, only: r8 => shr_kind_r8 +use shr_const_mod, only: shr_const_rgas +use spmd_utils, only: masterproc +use cam_abortutils, only: endrun +use cam_logfile, only: iulog + +implicit none +private +save + +! Public interfaces +public :: & + budget_stage_add, &! add a budget to the list of budgets + budget_diff_add, &! add a budget to the list of budgets + budget_num_avail, &! returns the number of available slots in the budget array + budget_get_ind, &! get the index of a budget + budget_chk_dim, &! check that number of budgets added equals dimensions (budget_array_max) + budget_name_byind, &! return name of a budget + budget_longname_byind, &! return longnamee of a budget + budget_type_byind, &! return stage or difference type of a budget + budget_info_byind, &! return stage or difference type of a budget + budget_outfld ! Returns true if default CAM output was specified in the budget_stage_add calls. + +! Public data + +integer, parameter, public :: budget_array_max = 30 ! number of budget diffs + +integer, public :: budget_cnt(budget_array_max) ! outfld this stage +integer, public :: budget_num = 0 ! +logical, public, protected :: budget_out(budget_array_max) ! outfld this stage +character(len=16), public, protected :: budget_name(budget_array_max) ! budget names +character(len=128),public, protected :: budget_longname(budget_array_max) ! long name of budgets +integer, public, protected :: budget_s1_ind(budget_array_max) +integer, public, protected :: budget_s2_ind(budget_array_max) +character(len=16), public, protected :: budget_s1name(budget_array_max) +character(len=16), public, protected :: budget_s2name(budget_array_max) + +! +! Constants for each budget + +!character*3, public, protected :: budget_type(budget_array_max)! stage or difference +character*3, public :: budget_type(budget_array_max)! stage or difference + +!++bee - temporary... These names should be declared in the module that makes the addfld and outfld calls. +! Lists of budget names and diagnostics +character(len=16), public :: physbudget (budget_array_max) ! budgets after physics (FV core only) +character(len=16), public :: dynbudget (budget_array_max) ! budgets before physics (FV core only) + +!============================================================================================== +CONTAINS +!============================================================================================== + +subroutine budget_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_logical + + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: sub = 'budget_readnl' + + !----------------------------------------------------------------------------- + +!!$ if (masterproc) then +!!$ unitn = getunit() +!!$ open( unitn, file=trim(nlfile), status='old' ) +!!$ call find_group_name(unitn, 'budgets_nl', status=ierr) +!!$ if (ierr == 0) then +!!$ read(unitn, budgets_nl, iostat=ierr) +!!$ if (ierr /= 0) then +!!$ call endrun(sub//': FATAL: reading namelist') +!!$ end if +!!$ end if +!!$ close(unitn) +!!$ call freeunit(unitn) +!!$ end if + +!!$ if (masterproc) then +!!$ write(iulog,*)'Summary of budget module options:' +!!$ end if + +end subroutine budget_readnl + + +subroutine budget_stage_add (name, ind, longname, cam_outfld) + + ! Register a budget. + + character(len=*), intent(in) :: & + name ! budget name used as variable name in history file output (8 char max) + integer, intent(out) :: ind ! global budget index (in q array) + + character(len=*), intent(in), optional :: & + longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) + logical, intent(in), optional :: & + cam_outfld ! true => default CAM output of budget in kg/kg + + character(len=*), parameter :: sub='budget_stage_add' + character(len=128) :: errmsg + !----------------------------------------------------------------------- + + ! set budget index and check validity + budget_num = budget_num+1 + ind = budget_num + if (budget_num > budget_array_max) then + write(errmsg, *) sub//': FATAL: budget stage index greater than budget stage max=', budget_array_max + call endrun(errmsg) + end if + + ! set budget name and constants + budget_name(ind) = name + if (present(longname)) then + budget_longname(ind) = longname + else + budget_longname(ind) = name + end if + + ! set outfld type + ! (false: the module declaring the budget is responsible for outfld calls) + if (present(cam_outfld)) then + budget_out(ind) = cam_outfld + else + budget_out(ind) = .false. + end if + budget_type(ind)='stg' +end subroutine budget_stage_add + +!============================================================================== +subroutine budget_diff_add (name, istage1, istage2, longname, cam_outfld) + + ! Register a budget. + + character(len=*), intent(in) :: & + name ! budget name used as variable name in history file output (8 char max) + + integer, intent(in) :: istage1,istage2 ! global budget stage index (in te_budgets array) + + character(len=*), intent(in), optional :: & + longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) + + logical, intent(in), optional :: & + cam_outfld ! true => default CAM output of budget in kg/kg + + character(len=*), parameter :: sub='budget_diff_add' + character(len=128) :: errmsg + integer :: ind + !----------------------------------------------------------------------- + + ! set budget index and check validity + budget_num = budget_num+1 + ind = budget_num + if (budget_num > budget_array_max) then + write(errmsg, *) sub//': FATAL: budget diff index greater than budget_array_max=', budget_array_max + call endrun(errmsg) + end if + + ! set budget name and constants + budget_name(ind) = name + if (present(longname)) then + budget_longname(ind) = longname + else + budget_longname(ind) = name + end if + + budget_s1_ind(ind) = istage1 + budget_s2_ind(ind) = istage2 + budget_s1name(ind) = budget_name_byind(istage1) + budget_s2name(ind) = budget_name_byind(istage2) + + ! set outfld type + ! (false: the module declaring the budget is responsible for outfld calls) + if (present(cam_outfld)) then + budget_out(ind) = cam_outfld + else + budget_out(ind) = .false. + end if + budget_type(ind)='dif' + end subroutine budget_diff_add +!============================================================================== + +function budget_num_avail() + + ! return number of available slots in the budget array + + integer budget_num_avail + + budget_num_avail = budget_array_max - budget_num + +end function budget_num_avail + +!============================================================================================== + +character*3 function budget_type_byind(ind) + + ! Return the type of a budget stage or difference + + !-----------------------------Arguments--------------------------------- + integer, intent(in) :: ind ! global budget index (in te array) + + !---------------------------Local workspace----------------------------- + character(len=*), parameter :: sub='budget_type_byind' + character(len=128) :: errmsg + !----------------------------------------------------------------------- + if (ind > 0 .and. ind <= budget_array_max) then + budget_type_byind = budget_type(ind) + else + ! index out of range + write(errmsg,*) sub//': FATAL: bad value for budget index=', ind + call endrun(errmsg) + end if + +end function budget_type_byind + +!============================================================================================== + +subroutine budget_info_byind(ind, name, longname, stage1, istage1, stage2, istage2) + + ! Return the mixing ratio name of a budget + + !-----------------------------Arguments--------------------------------- + integer, intent(in) :: ind ! global budget index (in te array) + character(len=*), intent(out), optional :: & + name, &! budget name + longname, &! budget long_name + stage1, &! stage1 name value for difference budget + stage2 ! stage2 name value for difference budget + integer, intent(out), optional :: & + istage1, &! stage1 index for difference budget + istage2 ! stage2 index for difference budget + + !---------------------------Local workspace----------------------------- + character(len=*), parameter :: sub='budget_name_byind' + character(len=128) :: errmsg + !----------------------------------------------------------------------- + if (ind > 0 .and. ind <= budget_array_max) then + if (present(name)) name=budget_name(ind) + if (present(longname)) longname=budget_longname(ind) + if (present(stage1)) stage1=budget_s1name(ind) + if (present(stage2)) stage2=budget_s2name(ind) + if (present(istage1)) istage1=budget_s1_ind(ind) + if (present(istage2)) istage2=budget_s2_ind(ind) + else + ! index out of range + write(errmsg,*) sub//': FATAL: bad value for budget index=', ind + call endrun(errmsg) + end if + + + end subroutine budget_info_byind + +!============================================================================================== + +character*16 function budget_name_byind(ind) + + ! Return the mixing ratio name of a budget + + !-----------------------------Arguments--------------------------------- + integer, intent(in) :: ind ! global budget index (in te array) + !---------------------------Local workspace----------------------------- + character(len=*), parameter :: sub='budget_name_byind' + character(len=128) :: errmsg + !----------------------------------------------------------------------- + + if (ind > 0 .and. ind <= budget_array_max) then + budget_name_byind = budget_name(ind) + else + ! index out of range + write(errmsg,*) sub//': FATAL: bad value for budget index=', ind + call endrun(errmsg) + end if + +end function budget_name_byind + +!============================================================================================== + +character*128 function budget_longname_byind(ind) + + ! Return the mixing ratio name of a budget + + !-----------------------------Arguments--------------------------------- + integer, intent(in) :: ind ! global budget index (in te array) + + !---------------------------Local workspace----------------------------- + character(len=*), parameter :: sub='budget_name_byind' + character(len=128) :: errmsg + !----------------------------------------------------------------------- + + if (ind > 0 .and. ind <= budget_array_max) then + budget_longname_byind = budget_longname(ind) + else + ! index out of range + write(errmsg,*) sub//': FATAL: bad value for budget index=', ind + call endrun(errmsg) + end if + +end function budget_longname_byind + +!============================================================================== + +subroutine budget_get_ind (name, ind, abort) + + ! Get the index of a budget. Optional abort argument allows returning + ! control to caller when budget name is not found. Default behavior is + ! to call endrun when name is not found. + + !-----------------------------Arguments--------------------------------- + character(len=*), intent(in) :: name ! budget name + integer, intent(out) :: ind ! global budget index (in q array) + logical, optional, intent(in) :: abort ! optional flag controlling abort + + !---------------------------Local workspace----------------------------- + integer :: m ! budget index + logical :: abort_on_error + character(len=*), parameter :: sub='budget_get_ind' + !----------------------------------------------------------------------- + + ! Find budget name in list + do m = 1, budget_array_max + if (name == budget_name(m)) then + ind = m + return + end if + end do + + ! Unrecognized name + abort_on_error = .true. + if (present(abort)) abort_on_error = abort + + if (abort_on_error) then + write(iulog, *) sub//': FATAL: name:', name, ' not found in list:', budget_name(:) + call endrun(sub//': FATAL: name not found') + end if + + ! error return + ind = -1 + +end subroutine budget_get_ind + +!============================================================================== + + +subroutine budget_chk_dim + + ! Check that the number of registered budgets is budget_array_max + ! Write budget list to log file. + + integer :: i, m + character(len=*), parameter :: sub='budget_chk_dim' + character(len=128) :: errmsg + !----------------------------------------------------------------------- + + ! if (budget_num /= budget_array_max) then + ! write(errmsg, *) sub//': FATAL: number of added budgets (',budget_num, & + ! ') not equal to budget_array_max (', budget_array_max, ')' + ! call endrun (errmsg) + ! endif + + if (masterproc) then + write(iulog,*) 'Budget stages list:' + do i = 1, budget_num + write(iulog,'(2x,i4,2x,a8,2x,a128)') i, budget_name(i), budget_longname(i) + end do + write(iulog,*) 'Budgets list:' + do i = 1, budget_num + write(iulog,'(2x,i4,2x,a8,2x,a128)') i, budget_name(i), budget_longname(i) + end do + end if + + ! ! Set names of physics and dynamics budget + ! do m=1,budget_array_max + ! physbudget (m) = trim(budget_name(m))//'AP' + ! dynbudget (m) = trim(budget_name(m))//'BP' + ! end do + +end subroutine budget_chk_dim + +function budget_outfld(m) + + ! Query whether default CAM outfld calls should be made. + + !----------------------------------------------------------------------- + integer, intent(in) :: m ! budget index + + logical :: budget_outfld ! true => use default CAM outfld calls + + character(len=*), parameter :: sub='budget_outfld' + character(len=128) :: errmsg + !----------------------------------------------------------------------- + + if (m > 0 .and. m <= budget_array_max) then + budget_outfld = budget_out(m) + else + ! index out of range + write(errmsg,*) sub//': FATAL: bad value for budget diff index=', m + call endrun(errmsg) + end if + + end function budget_outfld + +!============================================================================== + +end module budgets diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index ec0c2df33f..0c7138730c 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -43,9 +43,9 @@ module check_energy public :: check_energy_get_integrals ! get energy integrals computed in check_energy_gmean public :: check_energy_init ! initialization of module public :: check_energy_timestep_init ! timestep initialization of energy integrals and cumulative boundary fluxes - public :: check_energy_budget_init ! initialization of energy budget integrals public :: check_energy_chng ! check changes in integrals against cumulative boundary fluxes public :: check_energy_gmean ! global means of physics input and output total energy + public :: check_energy_budget_init ! initialization of energy budget integrals public :: check_energy_budget ! global budgets of physics energies public :: check_energy_fix ! add global mean energy difference as a heating public :: check_tracers_init ! initialize tracer integrals and cumulative boundary fluxes @@ -183,12 +183,15 @@ subroutine check_energy_init() !----------------------------------------------------------------------- use cam_history, only: addfld, add_default, horiz_only use phys_control, only: phys_getopts + use budgets, only: budget_num, budget_outfld, budget_info_byind implicit none logical :: history_budget, history_waccm integer :: history_budget_histfile_num ! output history file number for budget fields - + integer :: m ! budget array index into te_budgets + character(len=16):: budget_name ! budget names + character(len=128):: budget_longname ! long name of budgets !----------------------------------------------------------------------- call phys_getopts( history_budget_out = history_budget, & @@ -210,18 +213,24 @@ subroutine check_energy_init() end if ! register history budget variables - call addfld('BP_phy_params', horiz_only, 'A', 'W/m2', 'dE/dt CAM physics parameterizations (phAP-phBP)') - call addfld('BD_phy_params', horiz_only, 'A', 'W/m2', 'dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)') - call addfld('BP_pwork', horiz_only, 'A', 'W/m2', 'dE/dt dry mass adjustment (phAM-phAP)') - call addfld('BD_pwork', horiz_only, 'A', 'W/m2', 'dE/dt dry mass adjustment using dycore E (dyAM-dyAP)') - call addfld('BP_efix', horiz_only, 'A', 'W/m2', 'dE/dt energy fixer (phBP-phBF)') - call addfld('BD_efix', horiz_only, 'A', 'W/m2', 'dE/dt energy fixer using dycore E (dyBP-dyBF)') - call addfld('BP_phys_tot', horiz_only, 'A', 'W/m2', 'dE/dt physics total (phAM-phBF)') - call addfld('BD_phys_tot', horiz_only, 'A', 'W/m2', 'dE/dt physics total using dycore E (dyAM-dyBF)') + do m=1,budget_num + if (budget_outfld(m)) then + call budget_info_byind(m,name=budget_name,longname=budget_longname) + call addfld(trim(budget_name), horiz_only, 'A', 'W/m2', trim(budget_longname)) + end if + end do +!!$ call addfld('BP_phy_params', horiz_only, 'A', 'W/m2', 'dE/dt CAM physics parameterizations (phAP-phBP)') +!!$ call addfld('BD_phy_params', horiz_only, 'A', 'W/m2', 'dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)') +!!$ call addfld('BP_pwork', horiz_only, 'A', 'W/m2', 'dE/dt dry mass adjustment (phAM-phAP)') +!!$ call addfld('BD_pwork', horiz_only, 'A', 'W/m2', 'dE/dt dry mass adjustment using dycore E (dyAM-dyAP)') +!!$ call addfld('BP_efix', horiz_only, 'A', 'W/m2', 'dE/dt energy fixer (phBP-phBF)') +!!$ call addfld('BD_efix', horiz_only, 'A', 'W/m2', 'dE/dt energy fixer using dycore E (dyBP-dyBF)') +!!$ call addfld('BP_phys_tot', horiz_only, 'A', 'W/m2', 'dE/dt physics total (phAM-phBF)') +!!$ call addfld('BD_phys_tot', horiz_only, 'A', 'W/m2', 'dE/dt physics total using dycore E (dyAM-dyBF)') end subroutine check_energy_init -!=============================================================================== +!================================================================================================ subroutine check_energy_timestep_init(state, tend, pbuf, col_type) use physconst, only: get_hydrostatic_energy @@ -311,6 +320,7 @@ subroutine check_energy_timestep_init(state, tend, pbuf, col_type) end subroutine check_energy_timestep_init !=============================================================================== + subroutine check_energy_budget_init(state) !----------------------------------------------------------------------- ! Compute initial values of energy and water integrals, @@ -326,14 +336,7 @@ subroutine check_energy_budget_init(state) ncol = state%ncol ! zero cummulative boundary fluxes - state%te_AP(:ncol,:) = 0._r8 - state%te_BP(:ncol,:) = 0._r8 - state%te_BF(:ncol,:) = 0._r8 - state%te_AM(:ncol,:) = 0._r8 - state%teAPcnt(:) = 0 - state%teBPcnt(:) = 0 - state%teBFcnt(:) = 0 - state%teAMcnt(:) = 0 + state%te_budgets(:,:,:) = 0._r8 end subroutine check_energy_budget_init !=============================================================================== @@ -573,12 +576,14 @@ subroutine check_energy_gmean(state, pbuf2d, dtime, nstep) end subroutine check_energy_gmean - subroutine check_energy_budget(state, pbuf2d, dtime, nstep) + subroutine check_energy_budget(state, dtime, nstep) use cam_history, only: outfld use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_chunk use dyn_tests_utils, only: vc_dycore, vc_height use physics_types, only: phys_te_idx, dyn_te_idx + use budgets, only: budget_cnt,budget_num, budget_get_ind, budget_info_byind, & + budget_type_byind, budget_outfld !----------------------------------------------------------------------- ! Compute global mean total energy of physics input and output states ! computed consistently with dynamical core vertical coordinate @@ -587,7 +592,6 @@ subroutine check_energy_budget(state, pbuf2d, dtime, nstep) !------------------------------Arguments-------------------------------- type(physics_state), intent(in ), dimension(begchunk:endchunk) :: state - type(physics_buffer_desc), pointer :: pbuf2d(:,:) real(r8), intent(in) :: dtime ! physics time step integer , intent(in) :: nstep ! current timestep number @@ -596,89 +600,60 @@ subroutine check_energy_budget(state, pbuf2d, dtime, nstep) integer :: ncol ! number of active columns integer :: lchnk ! chunk index - real(r8) :: te(pcols,begchunk:endchunk,8) + real(r8) :: te(pcols,begchunk:endchunk,budget_num) ! total energy of input/output states (copy) - real(r8) :: te_glob(8) ! global means of total energy + real(r8) :: te_glob(budget_num) ! global means of total energy real(r8) :: phparam,dyparam,phpwork,dypwork,phefix,dyefix,phphys,dyphys + integer :: i,ind,is1,is2 + character*16 :: budget_name ! parameterization name for fluxes !----------------------------------------------------------------------- - - ! Copy total energy out of input and output states + ! calculate energy budget differences do lchnk = begchunk, endchunk ncol = state(lchnk)%ncol - if (state(lchnk)%teAPcnt(dyn_te_idx)==0.or.state(lchnk)%teBPcnt(dyn_te_idx)==0) then - te(:ncol,lchnk,1)=0._r8 - else - te(:ncol,lchnk,1) = (state(lchnk)%te_AP(:ncol,dyn_te_idx)-state(lchnk)%te_BP(:ncol,dyn_te_idx))/state(lchnk)%teAPcnt(dyn_te_idx)/dtime - end if - if (state(lchnk)%teAPcnt(phys_te_idx)==0.or.state(lchnk)%teBPcnt(phys_te_idx)==0) then - te(:ncol,lchnk,2)=0._r8 - else - te(:ncol,lchnk,2) = (state(lchnk)%te_AP(:ncol,phys_te_idx)-state(lchnk)%te_BP(:ncol,phys_te_idx))/state(lchnk)%teAPcnt(phys_te_idx)/dtime - end if - - if (state(lchnk)%teAMcnt(dyn_te_idx)==0.or.state(lchnk)%teAPcnt(dyn_te_idx)==0) then - te(:ncol,lchnk,3)=0._r8 - else - te(:ncol,lchnk,3) = (state(lchnk)%te_AM(:ncol,dyn_te_idx)-state(lchnk)%te_AP(:ncol,dyn_te_idx))/state(lchnk)%teAMcnt(dyn_te_idx)/dtime - end if - if (state(lchnk)%teAMcnt(phys_te_idx)==0.or.state(lchnk)%teAPcnt(phys_te_idx)==0) then - te(:ncol,lchnk,4)=0._r8 - else - te(:ncol,lchnk,4) = (state(lchnk)%te_AM(:ncol,phys_te_idx)-state(lchnk)%te_AP(:ncol,phys_te_idx))/state(lchnk)%teAMcnt(phys_te_idx)/dtime - end if - - if (state(lchnk)%teBPcnt(dyn_te_idx)==0.or.state(lchnk)%teBFcnt(dyn_te_idx)==0) then - te(:ncol,lchnk,5)=0._r8 - else - te(:ncol,lchnk,5) = (state(lchnk)%te_BP(:ncol,dyn_te_idx)-state(lchnk)%te_BF(:ncol,dyn_te_idx))/state(lchnk)%teBPcnt(dyn_te_idx)/dtime - end if - if (state(lchnk)%teBPcnt(phys_te_idx)==0.or.state(lchnk)%teBFcnt(phys_te_idx)==0) then - te(:ncol,lchnk,6)=0._r8 - else - te(:ncol,lchnk,6) = (state(lchnk)%te_BP(:ncol,phys_te_idx)-state(lchnk)%te_BF(:ncol,phys_te_idx))/state(lchnk)%teBPcnt(phys_te_idx)/dtime - end if - - if (state(lchnk)%teAMcnt(dyn_te_idx)==0.or.state(lchnk)%teBFcnt(dyn_te_idx)==0) then - te(:ncol,lchnk,7)=0._r8 - else - te(:ncol,lchnk,7) = (state(lchnk)%te_AM(:ncol,dyn_te_idx)-state(lchnk)%te_BF(:ncol,dyn_te_idx))/state(lchnk)%teBFcnt(dyn_te_idx)/dtime - end if - if (state(lchnk)%teAMcnt(phys_te_idx)==0.or.state(lchnk)%teBFcnt(phys_te_idx)==0) then - te(:ncol,lchnk,8)=0._r8 - else - te(:ncol,lchnk,8) = (state(lchnk)%te_AM(:ncol,phys_te_idx)-state(lchnk)%te_BF(:ncol,phys_te_idx))/state(lchnk)%teBFcnt(phys_te_idx)/dtime - end if - - call outfld('BD_phy_params', te(:ncol,lchnk,1), pcols, lchnk) - call outfld('BP_phy_params', te(:ncol,lchnk,2), pcols, lchnk) - call outfld('BD_pwork', te(:ncol,lchnk,3), pcols, lchnk) - call outfld('BP_pwork', te(:ncol,lchnk,4), pcols, lchnk) - call outfld('BD_efix', te(:ncol,lchnk,5), pcols, lchnk) - call outfld('BP_efix', te(:ncol,lchnk,6), pcols, lchnk) - call outfld('BD_phys_tot', te(:ncol,lchnk,7), pcols, lchnk) - call outfld('BP_phys_tot', te(:ncol,lchnk,8), pcols, lchnk) - + do i=1,budget_num + if (budget_type_byind(i)=='dif') then + call budget_info_byind(i,name=budget_name, istage1=is1, istage2=is2) + if (budget_cnt(is1)==0.or.budget_cnt(is2)==0) then + te(:,lchnk,i)=0._r8 + else + te(:,lchnk,i) = (state(lchnk)%te_budgets(:,1,is1)-state(lchnk)%te_budgets(:,1,is2))/budget_cnt(is1)/dtime + end if + else + call budget_info_byind(i,name=budget_name) + te(:,lchnk,i)=0._r8 + end if + if (budget_outfld(i)) call outfld(trim(budget_name), te(:ncol,lchnk,i), pcols, lchnk) + end do end do - - ! Compute global means of input and output energies and of + write(iulog,*)'done with te loop, next looking at te array values for 1,2,9,10,15,16' + + ! Compute global means of input and output energies and of ! surface pressure for heating rate (assume uniform ptop) - call gmean(te, te_glob, 8) + call gmean(te, te_glob, budget_num) if (begchunk .le. endchunk) then - dyparam = te_glob(1) - phparam = te_glob(2) - dypwork = te_glob(3) - phpwork = te_glob(4) - dyefix = te_glob(5) - phefix = te_glob(6) - dyphys = te_glob(7) - phphys = te_glob(8) + call budget_get_ind('BD_phy_params',ind, .true.) + dyparam = te_glob(ind) + call budget_get_ind('BP_phy_params',ind, .true.) + phparam = te_glob(ind) + call budget_get_ind('BD_pwork',ind, .true.) + dypwork = te_glob(ind) + call budget_get_ind('BP_pwork',ind, .true.) + phpwork = te_glob(ind) + call budget_get_ind('BD_efix',ind, .true.) + dyefix = te_glob(ind) + call budget_get_ind('BP_efix',ind, .true.) + phefix = te_glob(ind) + call budget_get_ind('BD_phys_tot',ind, .true.) + dyphys = te_glob(ind) + call budget_get_ind('BP_phys_tot',ind, .true.) + phphys = te_glob(ind) if (masterproc) then write(iulog,'(1x,a,1x,4(1x,e25.17))') "nstep, phys param,pwork,efix,phys", phparam, phpwork, phefix, phphys write(iulog,'(1x,a,1x,4(1x,e25.17))') "nstep, dyn param,pwork,efix,phys", dyparam, dypwork, dyefix, dyphys end if end if ! (begchunk .le. endchunk) - + end subroutine check_energy_budget !=============================================================================== @@ -931,18 +906,16 @@ end subroutine check_tracers_chng !####################################################################### - subroutine calc_te_and_aam_budgets(state, outfld_name_suffix, te_budget, te_budget_cnt, vc) + subroutine calc_te_and_aam_budgets(state, outfld_name_suffix, vc) use physconst, only: gravit,cpair,pi,rearth,omega,get_hydrostatic_energy use cam_history, only: hist_fld_active, outfld use dyn_tests_utils, only: vc_physics, vc_height use cam_abortutils, only: endrun - use physics_types, only: phys_te_idx, dyn_te_idx + use budgets, only: budget_cnt, budget_get_ind !------------------------------Arguments-------------------------------- type(physics_state), intent(inout) :: state character(len=*), intent(in) :: outfld_name_suffix ! suffix for "outfld" - real(r8),optional, intent(inout) :: te_budget(pcols,2) ! se + ke - integer, optional, intent(inout) :: te_budget_cnt(2) ! te budget counts for physics and dynamics energies integer, optional, intent(in) :: vc ! vertical coordinate !---------------------------Local storage------------------------------- @@ -964,7 +937,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix, te_budget, te_budg integer :: ncol ! number of atmospheric columns integer :: i,k ! column, level indices integer :: vc_loc ! local vertical coordinate variable - integer :: index_loc ! use physics or dynamics array position for te_budget + integer :: ind ! budget array index integer :: ixtt ! test tracer index character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 !----------------------------------------------------------------------- @@ -976,20 +949,20 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix, te_budget, te_budg name_out5 = 'WI_' //trim(outfld_name_suffix) name_out6 = 'TT_' //trim(outfld_name_suffix) - if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2).or.hist_fld_active(name_out3).or.& - hist_fld_active(name_out4).or.hist_fld_active(name_out5).or.hist_fld_active(name_out6)) then +!jt if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2).or.hist_fld_active(name_out3).or.& +!jt hist_fld_active(name_out4).or.hist_fld_active(name_out5).or.hist_fld_active(name_out6)) then lchnk = state%lchnk ncol = state%ncol + call budget_get_ind(trim(outfld_name_suffix),ind) + if (present(vc)) then - index_loc=dyn_te_idx vc_loc = vc else - index_loc=phys_te_idx vc_loc = vc_physics end if - write(6,*)'calc_te index_loc,outfld_name_suffix,present(vc)=',index_loc,outfld_name_suffix,present(vc) + if (state%psetcols == pcols) then if (vc_loc == vc_height) then ! @@ -1017,13 +990,6 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix, te_budget, te_budg vc_loc, ps = state%ps(1:ncol), phis = state%phis(1:ncol), & z = state%z_ini(1:ncol,:), se = se, ke = ke, wv = wv, liq = liq, ice = ice) - if (present(te_budget)) then -!jt te_budget(1:ncol,index_loc)=te_budget(1:ncol,index_loc)+(se(1:ncol)+ke(1:ncol))*state%area_scale(1:ncol,index_loc) -!jt te_budget_cnt(index_loc)=te_budget_cnt(index_loc) + 1 -!jt te_budget(1:ncol,index_loc)=(se(1:ncol)+ke(1:ncol))*state%area_scale(1:ncol,index_loc) - te_budget(1:ncol,index_loc)=(se(1:ncol)+ke(1:ncol)) - te_budget_cnt(index_loc)= 1 - end if call cnst_get_ind('TT_LW' , ixtt , abort=.false.) tt = 0._r8 @@ -1048,6 +1014,15 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix, te_budget, te_budg end if end if + state%te_budgets(1:ncol,1,ind)=(se(1:ncol)+ke(1:ncol)) + state%te_budgets(1:ncol,2,ind)=se(1:ncol) + state%te_budgets(1:ncol,3,ind)=ke(1:ncol) + state%te_budgets(1:ncol,4,ind)=wv(1:ncol) + state%te_budgets(1:ncol,5,ind)=liq(1:ncol) + state%te_budgets(1:ncol,6,ind)=ice(1:ncol) + state%te_budgets(1:ncol,7,ind)=tt(1:ncol) + budget_cnt(ind) = 1 + ! Output energy diagnostics call outfld(name_out1 ,se , pcols ,lchnk ) @@ -1056,7 +1031,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix, te_budget, te_budg call outfld(name_out4 ,liq , pcols ,lchnk ) call outfld(name_out5 ,ice , pcols ,lchnk ) call outfld(name_out6 ,tt , pcols ,lchnk ) - end if +!!jt end if ! ! Axial angular momentum diagnostics ! @@ -1073,7 +1048,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix, te_budget, te_budg name_out1 = 'MR_' //trim(outfld_name_suffix) name_out2 = 'MO_' //trim(outfld_name_suffix) - if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2)) then +!!jt if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2)) then lchnk = state%lchnk ncol = state%ncol @@ -1094,7 +1069,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix, te_budget, te_budg end do call outfld(name_out1 ,mr, pcols,lchnk ) call outfld(name_out2 ,mo, pcols,lchnk ) - end if +!!jt end if end subroutine calc_te_and_aam_budgets diff --git a/src/physics/cam/physics_types.F90 b/src/physics/cam/physics_types.F90 index b05f4fab60..8c2240d41d 100644 --- a/src/physics/cam/physics_types.F90 +++ b/src/physics/cam/physics_types.F90 @@ -14,6 +14,7 @@ module physics_types use cam_abortutils, only: endrun use phys_control, only: waccmx_is use shr_const_mod, only: shr_const_rwv + use budgets, only: budget_array_max,budget_name implicit none private ! Make default type private to the module @@ -104,11 +105,6 @@ module physics_types te_ini, &! vertically integrated total (kinetic + static) energy of initial state te_cur, &! vertically integrated total (kinetic + static) energy of current state tw_ini, &! vertically integrated total water of initial state - te_AP, &! vertically integrated total water of initial state - te_AM, &! vertically integrated total water of initial state - te_BF, &! vertically integrated total water of initial state - te_BP, &! vertically integrated total water of initial state - area_scale, &! vertically integrated total water of initial state tw_cur ! vertically integrated total water of new state real(r8), dimension(:,:),allocatable :: & temp_ini, &! Temperature of initial state (used for energy computations) @@ -121,11 +117,7 @@ module physics_types lonmapback, &! map from column to unique lon for that column cid ! unique column id integer :: ulatcnt, &! number of unique lats in chunk - uloncnt, &! ! number of unique lons in chunk - teAPcnt(2), &! vertically integrated total water of state after physics - teBPcnt(2), &! vertically integrated total water of state before physics - teBFcnt(2), &! vertically integrated total water of state before fixer - teAMcnt(2) ! vertically integrated total water of state after dry mass adjustment + uloncnt ! number of unique lons in chunk end type physics_state @@ -148,7 +140,6 @@ module physics_types integer :: psetcols=0 ! max number of columns set- if subcols = pcols*psubcols, else = pcols character*24 :: name ! name of parameterization which produced tendencies. - logical :: & ls = .false., &! true if dsdt is returned lu = .false., &! true if dudt is returned @@ -447,7 +438,6 @@ subroutine physics_update(state, ptend, dt, tend) end if if (state_debug_checks) call physics_state_check(state, ptend%name) - deallocate(cpairv_loc, rairv_loc) ! Deallocate ptend @@ -550,16 +540,6 @@ subroutine physics_state_check(state, name) varname="state%te_ini", msg=msg) call shr_assert_in_domain(state%te_cur(:ncol,:), is_nan=.false., & varname="state%te_cur", msg=msg) - call shr_assert_in_domain(state%te_AP(:ncol,:), is_nan=.false., & - varname="state%te_AP", msg=msg) - call shr_assert_in_domain(state%te_BP(:ncol,:), is_nan=.false., & - varname="state%te_BP", msg=msg) - call shr_assert_in_domain(state%te_BF(:ncol,:), is_nan=.false., & - varname="state%te_BF", msg=msg) - call shr_assert_in_domain(state%te_AM(:ncol,:), is_nan=.false., & - varname="state%te_AM", msg=msg) - call shr_assert_in_domain(state%area_scale(:ncol,:), is_nan=.false., & - varname="state%area_scale", msg=msg) call shr_assert_in_domain(state%tw_ini(:ncol,:), is_nan=.false., & varname="state%tw_ini", msg=msg) call shr_assert_in_domain(state%tw_cur(:ncol,:), is_nan=.false., & @@ -617,6 +597,12 @@ subroutine physics_state_check(state, name) call shr_assert_in_domain(state%q(:ncol,:,:), is_nan=.false., & varname="state%q", msg=msg) + ! Budget variables + do m = 1,budget_array_max + call shr_assert_in_domain(state%te_budgets(:ncol,:,m), is_nan=.false., & + varname="state%te_budgets ("//trim(budget_name(m))//")", msg=msg) + end do + ! Now run other checks (i.e. values are finite and within a range that ! is physically meaningful). @@ -638,16 +624,6 @@ subroutine physics_state_check(state, name) varname="state%te_ini", msg=msg) call shr_assert_in_domain(state%te_cur(:ncol,:), lt=posinf_r8, gt=neginf_r8, & varname="state%te_cur", msg=msg) - call shr_assert_in_domain(state%te_AP(:ncol,:), lt=posinf_r8, gt=neginf_r8, & - varname="state%te_AP", msg=msg) - call shr_assert_in_domain(state%te_BP(:ncol,:), lt=posinf_r8, gt=neginf_r8, & - varname="state%te_BP", msg=msg) - call shr_assert_in_domain(state%te_BF(:ncol,:), lt=posinf_r8, gt=neginf_r8, & - varname="state%te_BF", msg=msg) - call shr_assert_in_domain(state%te_AM(:ncol,:), lt=posinf_r8, gt=neginf_r8, & - varname="state%te_AM", msg=msg) - call shr_assert_in_domain(state%area_scale(:ncol,:), lt=posinf_r8, gt=neginf_r8, & - varname="state%area_scale", msg=msg) call shr_assert_in_domain(state%tw_ini(:ncol,:), lt=posinf_r8, gt=neginf_r8, & varname="state%tw_ini", msg=msg) call shr_assert_in_domain(state%tw_cur(:ncol,:), lt=posinf_r8, gt=neginf_r8, & @@ -707,6 +683,11 @@ subroutine physics_state_check(state, name) varname="state%q ("//trim(cnst_name(m))//")", msg=msg) end do + ! Budget variables + do m = 1,budget_array_max + call shr_assert_in_domain(state%te_budgets(:ncol,:,m), lt=posinf_r8, gt=neginf_r8, & + varname="state%te_budgets ("//trim(budget_name(m))//")", msg=msg) + end do end subroutine physics_state_check !=============================================================================== @@ -1116,7 +1097,7 @@ subroutine physics_state_set_grid(lchnk, phys_state) do i=1,ncol phys_state%lat(i) = rlat(i) phys_state%lon(i) = rlon(i) - phys_state%area_scale(i,:) = area(i)/4.0_r8*pi +!!jt phys_state%area_scale(i,:) = area(i)/4.0_r8*pi end do call init_geo_unique(phys_state,ncol) @@ -1347,11 +1328,6 @@ subroutine physics_state_copy(state_in, state_out) end do state_out%te_ini(:ncol,:) = state_in%te_ini(:ncol,:) state_out%te_cur(:ncol,:) = state_in%te_cur(:ncol,:) - state_out%te_AP(:ncol,:) = state_in%te_AP(:ncol,:) - state_out%te_BP(:ncol,:) = state_in%te_BP(:ncol,:) - state_out%te_BF(:ncol,:) = state_in%te_BF(:ncol,:) - state_out%te_AM(:ncol,:) = state_in%te_AM(:ncol,:) - state_out%area_scale(:ncol,:) = state_in%area_scale(:ncol,:) state_out%tw_ini(:ncol,:) = state_in%tw_ini(:ncol,:) state_out%tw_cur(:ncol,:) = state_in%tw_cur(:ncol,:) @@ -1408,6 +1384,14 @@ subroutine physics_state_copy(state_in, state_out) end do end do + do m = 1, budget_array_max + do k = 1, 7 + do i = 1, ncol + state_out%te_budgets(i,k,m) = state_in%te_budgets(i,k,m) + end do + end do + end do + end subroutine physics_state_copy !=============================================================================== @@ -1615,6 +1599,9 @@ subroutine physics_state_alloc(state,lchnk,psetcols) allocate(state%q(psetcols,pver,pcnst), stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%q') + allocate(state%te_budgets(psetcols,7,budget_array_max), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%te_budgets') + allocate(state%pint(psetcols,pver+1), stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%pint') @@ -1636,21 +1623,6 @@ subroutine physics_state_alloc(state,lchnk,psetcols) allocate(state%te_cur(psetcols,2), stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%te_cur') - allocate(state%te_AP(psetcols,2), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%te_AP') - - allocate(state%te_BP(psetcols,2), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%te_BP') - - allocate(state%te_BF(psetcols,2), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%te_BF') - - allocate(state%te_AM(psetcols,2), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%te_AM') - - allocate(state%area_scale(psetcols,2), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%area_scale') - allocate(state%tw_ini(psetcols,2), stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%tw_ini') @@ -1695,6 +1667,7 @@ subroutine physics_state_alloc(state,lchnk,psetcols) state%exner(:,:) = inf state%zm(:,:) = inf state%q(:,:,:) = inf + state%te_budgets(:,:,:) = inf state%pint(:,:) = inf state%pintdry(:,:) = inf @@ -1704,11 +1677,6 @@ subroutine physics_state_alloc(state,lchnk,psetcols) state%te_ini(:,:) = inf state%te_cur(:,:) = inf - state%te_AP(:,:) = inf - state%te_BP(:,:) = inf - state%te_BF(:,:) = inf - state%te_AM(:,:) = inf - state%area_scale(:,:) = inf state%tw_ini(:,:) = inf state%tw_cur(:,:) = inf state%temp_ini(:,:) = inf @@ -1815,21 +1783,6 @@ subroutine physics_state_dealloc(state) deallocate(state%te_cur, stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%te_cur') - deallocate(state%te_AP, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%te_AP') - - deallocate(state%te_BP, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%te_BP') - - deallocate(state%te_BF, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%te_BF') - - deallocate(state%te_AM, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%te_AM') - - deallocate(state%area_scale, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%area_scale') - deallocate(state%tw_ini, stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%tw_ini') diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index a414bc2d65..4a2eab5a33 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -89,6 +89,16 @@ module physpkg integer :: ducore_idx = 0 ! ducore index in physics buffer integer :: dvcore_idx = 0 ! dvcore index in physics buffer +! Budget indexes + integer :: iphap = 0 ! budget index in budget meta data structure + integer :: idyap = 0 ! budget index in budget meta data structure + integer :: iphbp = 0 ! budget index in budget meta data structure + integer :: idybp = 0 ! budget index in budget meta data structure + integer :: iphbf = 0 ! budget index in budget meta data structure + integer :: idybf = 0 ! budget index in budget meta data structure + integer :: ipham = 0 ! budget index in budget meta data structure + integer :: idyam = 0 ! budget index in budget meta data structure + !======================================================================= contains !======================================================================= @@ -96,7 +106,7 @@ module physpkg subroutine phys_register !----------------------------------------------------------------------- ! - ! Purpose: Register constituents and physics buffer fields. + ! Purpose: Register budgets, constituents and physics buffer fields. ! ! Author: CSM Contact: M. Vertenstein, Aug. 1997 ! B.A. Boville, Oct 2001 @@ -152,6 +162,7 @@ subroutine phys_register use dyn_comp, only: dyn_register use spcam_drivers, only: spcam_register use offline_driver, only: offline_driver_reg + use budgets, only: budget_stage_add, budget_diff_add !---------------------------Local variables----------------------------- ! @@ -181,6 +192,26 @@ subroutine phys_register ! Register the subcol scheme call subcol_register() + ! Register stages for budgets. + call budget_stage_add('phAP',iphap,'vertically integrated phys energy after physics',.true.) + call budget_stage_add('dyAP',idyap,'vertically integrated dyn energy after physics',.true.) + call budget_stage_add('phBP',iphbp,'vertically integrated phys energy before physics',.true.) + call budget_stage_add('dyBP',idybp,'vertically integrated dyn energy before physics',.true.) + call budget_stage_add('phBF',iphbf,'vertically integrated phys energy before fixer',.true.) + call budget_stage_add('dyBF',idybf,'vertically integrated dyn energy before fixer',.true.) + call budget_stage_add('phAM',ipham,'vertically integrated phys energy after dry mass adj',.true.) + call budget_stage_add('dyAM',idyam,'vertically integrated dyn energy after dry mass adj',.true.) + + ! Register budgets. + call budget_diff_add('BP_phy_params', iphAP,iphBP,'dE/dt CAM physics parameterizations (phAP-phBP)',.true.) + call budget_diff_add('BD_phy_params', idyAP,idyBP,'dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)',.true.) + call budget_diff_add('BP_pwork',iphAM,iphAP,'dE/dt dry mass adjustment (phAM-phAP)',.true.) + call budget_diff_add('BD_pwork', idyAM,idyAP,'dE/dt dry mass adjustment using dycore E (dyAM-dyAP)',.true.) + call budget_diff_add('BP_efix', iphBP,iphBF,'dE/dt energy fixer (phBP-phBF)',.true.) + call budget_diff_add('BD_efix', idyBP,idyBF, 'dE/dt energy fixer using dycore E (dyBP-dyBF)',.true.) + call budget_diff_add('BP_phys_tot', iphAM,iphBF, 'dE/dt physics total (phAM-phBF)',.true.) + call budget_diff_add('BD_phys_tot', idyAM,idyBF,'dE/dt physics total using dycore E (dyAM-dyBF)',.true.) + ! Register water vapor. ! ***** N.B. ***** This must be the first call to cnst_add so that ! water vapor is constituent 1. @@ -762,9 +793,10 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use cam_abortutils, only: endrun use nudging, only: Nudge_Model, nudging_init use cam_snapshot, only: cam_snapshot_init - use cam_history, only: addfld, register_vector_field, add_default - use check_energy, only: check_energy_budget_init + use cam_history, only: addfld, register_vector_field, add_default, horiz_only use phys_control, only: phys_getopts + use budgets, only: budget_num, budget_info_byind, budget_outfld + use check_energy, only: check_energy_budget_init ! Input/output arguments type(physics_state), pointer :: phys_state(:) @@ -776,12 +808,14 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! local variables integer :: lchnk - integer :: ierr + integer :: i,ierr logical :: history_budget ! output tendencies and state variables for ! temperature, water vapor, cloud ! ice, cloud liquid, U, V integer :: history_budget_histfile_num ! output history file number for budget fields + character*16 :: budget_name ! parameterization name for fluxes + character*128 :: budget_longname ! parameterization name for fluxes !----------------------------------------------------------------------- @@ -1031,6 +1065,12 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ducore_idx = pbuf_get_index('DUCORE') dvcore_idx = pbuf_get_index('DVCORE') +!!$ ! addfld calls for budget stages and diffs +!!$ do i=1,budget_num +!!$ call budget_info_byind(i, name=budget_name, longname=budget_longname) +!!$ write(iulog,*)'addfld i,budget_name=',i,budget_name,budget_num +!!$ if (budget_outfld(i)) call addfld(trim(budget_name), horiz_only, 'A', 'W/m2', trim(budget_longname)) +!!$ end do end subroutine phys_init ! @@ -1099,7 +1139,7 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) ! Compute total energy of input state and previous output state call t_startf ('chk_en_gmean') call check_energy_gmean(phys_state, pbuf2d, ztodt, nstep) - call check_energy_budget(phys_state, pbuf2d ,ztodt,nstep) + call check_energy_budget(phys_state, ztodt, nstep) call t_stopf ('chk_en_gmean') call t_stopf ('physpkg_st1') @@ -1804,8 +1844,8 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat) end if - call calc_te_and_aam_budgets(state, 'phAP', state%te_AP, state%teAPcnt) - call calc_te_and_aam_budgets(state, 'dyAP', state%te_AP, state%teAPcnt, vc=vc_dycore) + call calc_te_and_aam_budgets(state, 'phAP') + call calc_te_and_aam_budgets(state, 'dyAP', vc=vc_dycore) !--------------------------------------------------------------------------------- ! Enforce charge neutrality after O+ change from ionos_tend @@ -1883,8 +1923,8 @@ subroutine tphysac (ztodt, cam_in, & call physics_dme_adjust(state, tend, qini, ztodt) - call calc_te_and_aam_budgets(state, 'phAM', state%te_AM, state%teAMcnt) - call calc_te_and_aam_budgets(state, 'dyAM', state%te_AM, state%teAMcnt, vc=vc_dycore) + call calc_te_and_aam_budgets(state, 'phAM') + call calc_te_and_aam_budgets(state, 'dyAM', vc=vc_dycore) ! Restore pre-"physics_dme_adjust" tracers state%q(:ncol,:pver,:pcnst) = tmp_trac(:ncol,:pver,:pcnst) state%pdel(:ncol,:pver) = tmp_pdel(:ncol,:pver) @@ -1905,8 +1945,9 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat) end if - call calc_te_and_aam_budgets(state, 'phAM', state%te_AM, state%teAMcnt) - call calc_te_and_aam_budgets(state, 'dyAM', state%te_AM, state%teAMcnt, vc=vc_dycore) + call calc_te_and_aam_budgets(state, 'phAM') + call calc_te_and_aam_budgets(state, 'dyAM', vc=vc_dycore) + endif !!! REMOVE THIS CALL, SINCE ONLY Q IS BEING ADJUSTED. WON'T BALANCE ENERGY. TE IS SAVED BEFORE THIS @@ -2196,16 +2237,18 @@ subroutine tphysbc (ztodt, state, & !=================================================== call t_startf('energy_fixer') - call calc_te_and_aam_budgets(state, 'phBF', state%te_BF, state%teBFcnt) - call calc_te_and_aam_budgets(state, 'dyBF', state%te_BF, state%teBFcnt, vc=vc_dycore) + call calc_te_and_aam_budgets(state, 'phBF' ) + call calc_te_and_aam_budgets(state, 'dyBF', vc=vc_dycore) + if (.not.dycore_is('EUL')) then call check_energy_fix(state, ptend, nstep, flx_heat) call physics_update(state, ptend, ztodt, tend) call check_energy_chng(state, tend, "chkengyfix", nstep, ztodt, zero, zero, zero, flx_heat) call outfld( 'EFIX', flx_heat , pcols, lchnk ) end if - call calc_te_and_aam_budgets(state, 'phBP', state%te_BP, state%teBPcnt) - call calc_te_and_aam_budgets(state, 'dyBP', state%te_BP, state%teBPcnt, vc=vc_dycore) + + call calc_te_and_aam_budgets(state, 'phBP') + call calc_te_and_aam_budgets(state, 'dyBP', vc=vc_dycore) ! Save state for convective tendency calculations. call diag_conv_tend_ini(state, pbuf) From 01a24ad10016b58adc61204d1fff0a23c65d7208 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 29 Apr 2022 17:35:39 -0600 Subject: [PATCH 005/140] bugfix missing set_dry_to_wet call --- src/physics/cam_dev/physpkg.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index 016c2636b3..71b70208ae 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -2272,6 +2272,7 @@ subroutine tphysac (ztodt, cam_in, & ! FV: convert dry-type mixing ratios to moist here because physics_dme_adjust ! assumes moist. This is done in p_d_coupling for other dynamics. Bundy, Feb 2004. moist_mixing_ratio_dycore = dycore_is('LR').or. dycore_is('FV3') + if (moist_mixing_ratio_dycore) call set_dry_to_wet(state) ! Physics had dry, dynamics wants moist ! Scale dry mass and energy (does nothing if dycore is EUL or SLD) tmp_q (:ncol,:pver) = state%q(:ncol,:pver,ixq) From 6ade69c1ac224ed26e88f2596d3d6a5b3741521c Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Mon, 15 Aug 2022 03:36:26 -0600 Subject: [PATCH 006/140] dev with debug - working --- bld/build-namelist | 1 - bld/namelist_files/namelist_defaults_cam.xml | 1 - bld/namelist_files/namelist_definition.xml | 13 - src/control/budgets.F90 | 695 ++++++++++++++++++ src/control/cam_comp.F90 | 8 + src/control/cam_control_mod.F90 | 1 + src/dynamics/se/dp_coupling.F90 | 81 +-- src/dynamics/se/dycore/dimensions_mod.F90 | 4 - src/dynamics/se/dycore/element_mod.F90 | 10 +- src/dynamics/se/dycore/fvm_mapping.F90 | 2 +- src/dynamics/se/dycore/global_norms_mod.F90 | 21 +- src/dynamics/se/dycore/prim_advance_mod.F90 | 706 +++++++++---------- src/dynamics/se/dycore/prim_driver_mod.F90 | 43 +- src/dynamics/se/dycore/viscosity_mod.F90 | 119 ++-- src/dynamics/se/dyn_comp.F90 | 246 ++++++- src/dynamics/se/restart_dynamics.F90 | 15 +- src/dynamics/se/stepon.F90 | 2 + src/physics/cam/budgets.F90 | 411 ----------- src/physics/cam/cam_diagnostics.F90 | 71 +- src/physics/cam/check_energy.F90 | 135 ++-- src/physics/cam/constituents.F90 | 2 - src/physics/cam/physics_types.F90 | 32 +- src/physics/cam/physpkg.F90 | 173 +++-- src/physics/cam_dev/physpkg.F90 | 108 ++- 24 files changed, 1709 insertions(+), 1191 deletions(-) create mode 100644 src/control/budgets.F90 delete mode 100644 src/physics/cam/budgets.F90 diff --git a/bld/build-namelist b/bld/build-namelist index 8a9532897e..608d09000f 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3679,7 +3679,6 @@ if ($dyn =~ /se/) { my @vars = qw( se_ftype se_horz_num_threads - se_hypervis_dynamic_ref_state se_lcp_moist se_large_Courant_incr se_hypervis_subcycle diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index b27457fedb..af07767888 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2768,7 +2768,6 @@ 2 - .false. .true. .true. diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 4be93e1341..583bb2ed5c 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -7372,19 +7372,6 @@ If < 0, se_sponge_del4_lev is automatically set based on model top location. Default: Set by build-namelist. - -Hyperscosity for T and dp is applied to (T-Tref) and (dp-dp_ref) where -Xref are reference states where the effect of topography has been removed -(Simmons and Jiabin, 1991, QJRMS, Section 2a). -If TRUE dp_ref is dynamic smoothed reference state derived by Patrick Callaghan -(Lauritzen et al., 2018, JAMES, Appendix A.2) and temperature reference state -based on Simmons and Jiabin (1991) but using smoothed dp_ref. -If FALSE Tref is static reference state (Simmons and Jiabin) and dp_ref state -derived from hydrostatic balance. -Default: FALSE - - If TRUE the continous equations the dynamical core is based on will conserve a diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 new file mode 100644 index 0000000000..1552138f7a --- /dev/null +++ b/src/control/budgets.F90 @@ -0,0 +1,695 @@ + +module budgets + +! Metadata manager for the budgets. + +use shr_kind_mod, only: r8 => shr_kind_r8 +use shr_const_mod, only: shr_const_rgas +use spmd_utils, only: masterproc +use cam_abortutils, only: endrun +use cam_logfile, only: iulog + +implicit none +private +save + +interface budget_add + module procedure budget_stage_add + module procedure budget_diff_add +end interface budget_add + +interface budget_info + module procedure budget_info_byind + module procedure budget_info_byname +end interface budget_info + +! Public interfaces +public :: & + budget_init, &! initialize budget variables + budget_add, &! add a budget to the list of budgets + budget_num_avail, &! returns the number of available slots in the budget array + budget_chk_dim, &! check that number of budgets added equals dimensions (budget_array_max) + budget_name_byind, &! return name of a budget + budget_ind_byname, &! return budget index given name + budget_longname_byind, &! return longnamee of a budget + budget_type_byind, &! return stage or difference type of a budget + budget_info, &! return budget info by ind + budget_cnt_adjust, &! advance or reset budget count + budget_count, &! return budget count + budget_outfld ! Returns true if default CAM output was specified in the budget_stage_add calls. + +! Public data + +integer, parameter, public :: budget_array_max = 60 ! number of budget diffs + +integer, public :: budget_cnt(budget_array_max) ! budget counts for normalization +integer, public :: budget_subcycle(budget_array_max) ! budget_subcycle counts +integer, public :: budget_num_dyn = 0 ! +integer, public :: budget_num_phy = 0 ! +integer, public :: budget_num = 0 ! +integer, public :: budget_state_ind(budget_array_max) ! +logical, public, protected :: budget_out(budget_array_max) ! outfld this stage +character(len=64), public, protected :: budget_name(budget_array_max) ! budget names +character(len=128),public, protected :: budget_longname(budget_array_max) ! long name of budgets +integer, public, protected :: budget_stg1index(budget_array_max) +integer, public, protected :: budget_stg2index(budget_array_max) +character(len=64), public, protected :: budget_stg1name(budget_array_max) +character(len=32), public, protected :: budget_stg2name(budget_array_max) +integer, public, protected :: budget_stg1stateidx(budget_array_max) +integer, public, protected :: budget_stg2stateidx(budget_array_max) + +! +! Constants for each budget + +!character*3, public, protected :: budget_type(budget_array_max)! stage or difference +character*3, public :: budget_optype(budget_array_max)! stage or difference or sum +character*3, public :: budget_pkgtype(budget_array_max)! phy or dyn + +!============================================================================================== +CONTAINS +!============================================================================================== + +subroutine budget_readnl(nlfile) + + use namelist_utils, only: find_group_name + use units, only: getunit, freeunit + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_logical + + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: sub = 'budget_readnl' + + !----------------------------------------------------------------------------- + +!!$ if (masterproc) then +!!$ unitn = getunit() +!!$ open( unitn, file=trim(nlfile), status='old' ) +!!$ call find_group_name(unitn, 'budgets_nl', status=ierr) +!!$ if (ierr == 0) then +!!$ read(unitn, budgets_nl, iostat=ierr) +!!$ if (ierr /= 0) then +!!$ call endrun(sub//': FATAL: reading namelist') +!!$ end if +!!$ end if +!!$ close(unitn) +!!$ call freeunit(unitn) +!!$ end if + +!!$ if (masterproc) then +!!$ write(iulog,*)'Summary of budget module options:' +!!$ end if + +end subroutine budget_readnl + + +subroutine budget_stage_add (name, pkgtype, longname, outfld) + + ! Register a budget. + + character(len=*), intent(in) :: & + name ! budget name used as variable name in history file output (8 char max) + character(len=*), intent(in) :: & + pkgtype ! budget type either phy or dyn + + character(len=*), intent(in), optional :: & + longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) + logical, intent(in), optional :: & + outfld ! true => default CAM output of budget in kg/kg + integer :: state_idx ! dyn/phy state budget index (in q array) + character(len=*), parameter :: sub='budget_stage_add' + character(len=128) :: errmsg + !----------------------------------------------------------------------- + + ! set budget index and check validity + if (pkgtype=='phy') then + budget_num_phy = budget_num_phy+1 + state_idx = budget_num_phy + else if (pkgtype=='dyn') then + budget_num_dyn = budget_num_dyn+1 + state_idx = budget_num_dyn + else + call endrun('unknown budget pkgtype') + end if + budget_num = budget_num+1 + + if (budget_num > budget_array_max) then + write(errmsg, *) sub//': FATAL: budget stage index greater than budget stage max=', budget_array_max + call endrun(errmsg) + end if + + ! set budget name and constants + budget_name(budget_num) = name + if (present(longname)) then + budget_longname(budget_num) = longname + else + budget_longname(budget_num) = name + end if + + ! set outfld type + ! (false: the module declaring the budget is responsible for outfld calls) + if (present(outfld)) then + budget_out(budget_num) = outfld + else + budget_out(budget_num) = .false. + end if + budget_optype(budget_num)='stg' + budget_pkgtype(budget_num)=pkgtype + budget_state_ind(budget_num)=state_idx + write(iulog,*)'inside budget_stage_add/name/type/op/state_idx/phyidx/dynidx/tot',trim(name),pkgtype,budget_optype(budget_num),budget_state_ind(budget_num),budget_num_phy,budget_num_dyn,budget_num +end subroutine budget_stage_add + +!!$!============================================================================== +!!$subroutine budget_diff_add (name, istage1, istage2, pkgtype, optype, longname, outfld, state_ind) +!!$ +!!$ ! Register a budget. +!!$ +!!$ character(len=*), intent(in) :: & +!!$ name ! budget name used as variable name in history file output (8 char max) +!!$ +!!$ integer, intent(in) :: istage1,istage2 ! global budget stage index (in te_budgets array) +!!$ +!!$ character(len=*), intent(in) :: & +!!$ pkgtype ! budget type either phy or dyn +!!$ +!!$ character(len=*), intent(in) :: & +!!$ optype ! dif (difference) or sum or stg (stage) +!!$ +!!$ character(len=*), intent(in), optional :: & +!!$ longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) +!!$ +!!$ logical, intent(in), optional :: & +!!$ outfld ! true => default CAM output of budget in kg/kg +!!$ +!!$ integer, intent(out), optional :: & +!!$ state_ind ! pass back dynamics/physics index for this budget +!!$ +!!$ character(len=*), parameter :: sub='budget_diff_add' +!!$ character(len=128) :: errmsg +!!$ integer :: state_idx +!!$ !----------------------------------------------------------------------- +!!$ ! set budget index and check validity +!!$ if (pkgtype=='phy') then +!!$ budget_num_phy=budget_num_phy+1 +!!$ state_idx = budget_num_phy +!!$!jt write(iulog,*)'adding physics budget idx',name,' ',budget_num_phy +!!$ else if (pkgtype=='dyn') then +!!$ budget_num_dyn=budget_num_dyn+1 +!!$ state_idx = budget_num_dyn +!!$!jt write(iulog,*)'adding dynamics budget idx',name,' ',budget_num_dyn +!!$ else +!!$ call endrun('bad budget pkgtype') +!!$ end if +!!$ budget_num= budget_num+1 +!!$ budget_pkgtype(budget_num)=pkgtype +!!$ if (budget_num > budget_array_max) then +!!$ write(errmsg, *) sub//': FATAL: budget diff index:',budget_num,' greater than budget_array_max=', budget_array_max +!!$ call endrun(errmsg) +!!$ end if +!!$ +!!$ ! set budget name and constants +!!$ budget_name(budget_num) = name +!!$ if (present(longname)) then +!!$ budget_longname(budget_num) = longname +!!$ else +!!$ budget_longname(budget_num) = name +!!$ end if +!!$ +!!$ budget_stg1index(budget_num) = istage1 +!!$ budget_stg2index(budget_num) = istage2 +!!$ budget_stg1name(budget_num) = budget_name_byind(istage1) +!!$ budget_stg2name(budget_num) = budget_name_byind(istage2) +!!$ +!!$ ! set outfld type +!!$ ! (false: the module declaring the budget is responsible for outfld calls) +!!$ if (present(outfld)) then +!!$ budget_out(budget_num) = outfld +!!$ else +!!$ budget_out(budget_num) = .false. +!!$ end if +!!$ +!!$ budget_optype(budget_num)=optype +!!$ +!!$ budget_state_ind(budget_num)=state_idx +!!$ if (present(state_ind)) state_ind=state_idx +!!$ +!!$!jt write(iulog,*)'inside budget_diff_add/name/type/op/is1/is2/phyidx/dynidx/tot',trim(name),pkgtype,budget_optype(budget_num),istage1,istage2,budget_num_phy,budget_num_dyn,budget_num +!!$ end subroutine budget_diff_add +!!$!============================================================================== +subroutine budget_diff_add (name, stg1name, stg2name, pkgtype, optype, longname, outfld) + + ! Register a budget. + + character(len=*), intent(in) :: & + name,stg1name,stg2name ! budget name used as variable name in history file output (8 char max) + + character(len=*), intent(in) :: & + pkgtype ! budget type either phy or dyn + + character(len=*), intent(in) :: & + optype ! dif (difference) or sum or stg (stage) + + character(len=*), intent(in), optional :: & + longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) + + logical, intent(in), optional :: & + outfld ! true => default CAM output of budget in kg/kg + + character(len=*), parameter :: sub='budget_diff_add' + character(len=128) :: errmsg + integer :: state_idx + !----------------------------------------------------------------------- + ! set budget index and check validity + if (pkgtype=='phy') then + budget_num_phy=budget_num_phy+1 + state_idx = budget_num_phy +!jt write(iulog,*)'adding physics budget idx',name,' ',budget_num_phy + else if (pkgtype=='dyn') then + budget_num_dyn=budget_num_dyn+1 + state_idx = budget_num_dyn +!jt write(iulog,*)'adding dynamics budget idx',name,' ',budget_num_dyn + else + call endrun('bad budget pkgtype') + end if + budget_num= budget_num+1 + budget_pkgtype(budget_num)=pkgtype + if (budget_num > budget_array_max) then + write(errmsg, *) sub//': FATAL: budget diff index:',budget_num,' greater than budget_array_max=', budget_array_max + call endrun(errmsg) + end if + + ! set budget name and constants + budget_name(budget_num) = name + if (present(longname)) then + budget_longname(budget_num) = longname + else + budget_longname(budget_num) = name + end if + + budget_stg1name(budget_num) = stg1name + budget_stg2name(budget_num) = stg2name + budget_stg1index(budget_num) = budget_ind_byname(trim(stg1name)) + budget_stg2index(budget_num) = budget_ind_byname(trim(stg2name)) + budget_stg1stateidx(budget_num) = budget_state_ind(budget_stg1index(budget_num)) + budget_stg2stateidx(budget_num) = budget_state_ind(budget_stg2index(budget_num)) + + ! set outfld type + ! (false: the module declaring the budget is responsible for outfld calls) + if (present(outfld)) then + budget_out(budget_num) = outfld + else + budget_out(budget_num) = .false. + end if + + budget_optype(budget_num)=optype + budget_state_ind(budget_num)=state_idx + + write(iulog,*)'inside budget_diff_add/name/type/op/is1/is2/is1b/is2b/phyidx/dynidx/tot',trim(name),pkgtype,budget_optype(budget_num),budget_stg1stateidx(budget_num),budget_stg2stateidx(budget_num),budget_stg1index(budget_num),budget_stg2index(budget_num),budget_num_phy,budget_num_dyn,budget_num + end subroutine budget_diff_add +!============================================================================== + +function budget_num_avail() + + ! return number of available slots in the budget array + + integer budget_num_avail + + budget_num_avail = budget_array_max - budget_num + +end function budget_num_avail + +!============================================================================================== + +character*3 function budget_type_byind(ind) + + ! Return the type of a budget stage or difference + + !-----------------------------Arguments--------------------------------- + integer, intent(in) :: ind ! global budget index (in te array) + + !---------------------------Local workspace----------------------------- + character(len=*), parameter :: sub='budget_type_byind' + character(len=128) :: errmsg + !----------------------------------------------------------------------- + if (ind > 0 .and. ind <= budget_array_max) then + budget_type_byind = budget_optype(ind) + else + ! index out of range + write(errmsg,*) sub//': FATAL: bad value for budget index=', ind + call endrun(errmsg) + end if + +end function budget_type_byind + +!============================================================================================== + +subroutine budget_info_byname(name, budget_ind, longname, stg1name, stg1stateidx, stg1index, stg2name, stg2stateidx, stg2index, optype, pkgtype,state_ind) + + ! Return the mixing ratio name of a budget + + !-----------------------------Arguments--------------------------------- + character(len=*), intent(in) :: name + character(len=*), intent(out), optional :: & + longname, &! budget long_name + stg1name, &! stage1 name value for difference budget + stg2name ! stage2 name value for difference budget + integer, intent(out), optional :: & + budget_ind, &! budget array index + state_ind, &! state budget array index + stg1stateidx, &! stage1 index for difference budget + stg2stateidx, &! stage2 index for difference budget + stg1index, &! stage1 budget index + stg2index ! stage2 budget index + character(len=3), intent(out), optional :: & + optype, &! budget type difference or stage + pkgtype ! physics or dynamics budget + + !---------------------------Local workspace----------------------------- + character(len=*), parameter :: sub='budget_info_byname' + character(len=128) :: errmsg + integer :: b_ind + !----------------------------------------------------------------------- +!jt write(6,*)'calling budget_get_ind with name',trim(name) + b_ind=budget_ind_byname(trim(name)) + if (b_ind > 0 .and. b_ind <= budget_array_max) then + if (present(budget_ind)) budget_ind=b_ind + if (present(longname)) longname=budget_longname(b_ind) + if (present(optype)) optype=budget_optype(b_ind) + if (present(pkgtype)) pkgtype=budget_pkgtype(b_ind) + if (present(state_ind)) state_ind=budget_state_ind(b_ind) + if (budget_optype(b_ind)=='dif' .or. budget_optype(b_ind)=='sum') then + if (present(stg1name))stg1name=budget_stg1name(b_ind) + if (present(stg2name))stg2name=budget_stg2name(b_ind) + if (present(stg1stateidx)) stg1stateidx=budget_stg1stateidx(b_ind) + if (present(stg2stateidx)) stg2stateidx=budget_stg2stateidx(b_ind) + if (present(stg1index)) stg1index=budget_stg1index(b_ind) + if (present(stg2index)) stg2index=budget_stg2index(b_ind) + else + if (present(stg1name).or.present(stg2name).or.present(stg1stateidx).or.present(stg2stateidx) & + .or.present(stg1index).or.present(stg2index)) & + call endrun(sub//': stage1/2 info not applicable for a budget that is not a difference or sum') + end if + else + ! index out of range + write(errmsg,*) sub//': FATAL: bad value name:',name,' budget index=', b_ind + call endrun(errmsg) + end if + end subroutine budget_info_byname + + subroutine budget_info_byind(budget_ind, name, longname, stg1name, stg1stateidx, stg1index, stg2name, stg2stateidx, stg2index, optype, pkgtype,state_ind) + + ! Return the mixing ratio name of a budget + + !-----------------------------Arguments--------------------------------- + integer, intent(in) :: budget_ind + character(len=*), intent(out), optional :: & + name, &! budget long_name + longname, &! budget long_name + stg1name, &! stage1 name value for difference budget + stg2name ! stage2 name value for difference budget + integer, intent(out), optional :: & + state_ind, &! state budget array index + stg1stateidx,&! stage1 index for difference budget + stg2stateidx,&! stage2 index for difference budget + stg1index, &! stage1 budget index + stg2index ! stage2 budget index + character(len=3), intent(out), optional :: & + optype, &! budget type difference or stage + pkgtype ! physics or dynamics budget + + !---------------------------Local workspace----------------------------- + character(len=*), parameter :: sub='budget_info_byind' + character(len=128) :: errmsg + !----------------------------------------------------------------------- + write(iulog,*)'budget_info_byind b_ind,name,pkg,opt,state_ind,s1n,s1s,s1b,s2n,s2s,s2b=',budget_ind,trim(budget_name(budget_ind)),budget_pkgtype(budget_ind),budget_optype(budget_ind),budget_state_ind(budget_ind),trim(budget_stg1name(budget_ind)),trim(budget_stg2name(budget_ind)) + if (budget_ind > 0 .and. budget_ind <= budget_array_max) then + if (present(name)) name=budget_name(budget_ind) + if (present(longname)) longname=budget_longname(budget_ind) + if (present(optype)) optype=budget_optype(budget_ind) + if (present(pkgtype)) pkgtype=budget_pkgtype(budget_ind) + if (present(state_ind)) state_ind=budget_state_ind(budget_ind) + if (budget_optype(budget_ind)=='dif' .or. budget_optype(budget_ind)=='sum') then + if (present(stg1name))stg1name=budget_stg1name(budget_ind) + if (present(stg2name))stg2name=budget_stg2name(budget_ind) + if (present(stg1stateidx)) stg1stateidx=budget_stg1stateidx(budget_ind) + if (present(stg2stateidx)) stg2stateidx=budget_stg2stateidx(budget_ind) + if (present(stg1index)) stg1index=budget_stg1index(budget_ind) + if (present(stg2index)) stg2index=budget_stg2index(budget_ind) + else + if (present(stg1name).or.present(stg2name).or.present(stg1stateidx).or.present(stg2stateidx) & + .or.present(stg1index).or.present(stg2index)) & + call endrun(sub//': stage1/2 info not applicable for a budget that is not a difference or sum') + end if + else + ! index out of range + write(errmsg,*) sub//': FATAL: bad value name:',name,' budget index=', budget_ind + call endrun(errmsg) + end if + + end subroutine budget_info_byind + +!============================================================================================== + +subroutine budget_cnt_adjust(ind,reset) + + ! Return the mixing ratio name of a budget + + !-----------------------------Arguments--------------------------------- + integer, intent(in) :: ind ! global budget index (in te array) + logical, intent(in),optional :: reset ! reset budget_cnt + !---------------------------Local workspace----------------------------- + character(len=*), parameter :: sub='budget_cnt_adjust' + character(len=128) :: errmsg + !----------------------------------------------------------------------- + if (ind > 0 .and. ind <= budget_array_max) then + budget_cnt(ind)=budget_cnt(ind)+1 + if (present(reset)) then + if (reset) then + budget_cnt(ind)=0 + end if + end if + else + ! index out of range + write(errmsg,*) sub//': FATAL: bad index value for budget_cnt_adjust=', ind + call endrun(errmsg) + end if + + + end subroutine budget_cnt_adjust +!============================================================================================== +subroutine budget_init() + + ! Initial budget module variables. + + budget_cnt(:) = 0._r8 + budget_subcycle(:) = 0._r8 + budget_num_dyn = 0 + budget_num_phy = 0 + budget_num = 0 + budget_state_ind(:) = 0 + budget_out(:) = .false. + budget_name(:) = 'UNSET' + budget_longname(:)= 'UNSET' + budget_stg1index(:) = 0 + budget_stg2index(:) = 0 + budget_stg1name(:)= 'UNSET' + budget_stg2name(:)= 'UNSET' + +end subroutine budget_init +!============================================================================================== + + +character*64 function budget_name_byind(ind) + + ! Return the mixing ratio name of a budget + + !-----------------------------Arguments--------------------------------- + integer, intent(in) :: ind ! global budget index (in te array) + !---------------------------Local workspace----------------------------- + character(len=*), parameter :: sub='budget_name_byind' + character(len=128) :: errmsg + !----------------------------------------------------------------------- + + if (ind > 0 .and. ind <= budget_array_max) then + budget_name_byind = budget_name(ind) + else + ! index out of range + write(errmsg,*) sub//': FATAL: bad value for budget index=', ind + call endrun(errmsg) + end if + +end function budget_name_byind + +!============================================================================================== + +character*128 function budget_longname_byind(ind) + + ! Return the mixing ratio name of a budget + + !-----------------------------Arguments--------------------------------- + integer, intent(in) :: ind ! global budget index (in te array) + + !---------------------------Local workspace----------------------------- + character(len=*), parameter :: sub='budget_name_byind' + character(len=128) :: errmsg + !----------------------------------------------------------------------- + + if (ind > 0 .and. ind <= budget_array_max) then + budget_longname_byind = budget_longname(ind) + else + ! index out of range + write(errmsg,*) sub//': FATAL: bad value for budget index=', ind + call endrun(errmsg) + end if + +end function budget_longname_byind + +!============================================================================== + +subroutine budget_get_ind (name, budget_ind, abort) + + ! Get the index of a budget. Optional abort argument allows returning + ! control to caller when budget name is not found. Default behavior is + ! to call endrun when name is not found. + + !-----------------------------Arguments--------------------------------- + character(len=*), intent(in) :: name ! budget name + integer, intent(out) :: budget_ind ! global budget index (in q array) + logical, optional, intent(in) :: abort ! optional flag controlling abort + + !---------------------------Local workspace----------------------------- + integer :: m ! budget index + logical :: abort_on_error + character(len=*), parameter :: sub='budget_get_ind' + !----------------------------------------------------------------------- + + ! Find budget name in list + do m = 1, budget_array_max + if (name == budget_name(m)) then + budget_ind = m + return + end if + end do + + ! Unrecognized name + abort_on_error = .true. + if (present(abort)) abort_on_error = abort + + if (abort_on_error) then + write(iulog, *) sub//': FATAL: name:', name, ' not found in list:', budget_name(:) + call endrun(sub//': FATAL: name not found') + end if + +end subroutine budget_get_ind +!============================================================================== + +function budget_ind_byname (name) + + ! Get the index of a budget. Optional abort argument allows returning + ! control to caller when budget name is not found. Default behavior is + ! to call endrun when name is not found. + + !-----------------------------Arguments--------------------------------- + character(len=*), intent(in) :: name ! budget name + + !---------------------------Local workspace----------------------------- + integer :: budget_ind_byname ! function return + integer :: m ! budget index + character(len=*), parameter :: sub='budget_ind_byname' + !----------------------------------------------------------------------- + + ! Find budget name in list + + budget_ind_byname = -1 + do m = 1, budget_array_max + if (trim(name) == trim(budget_name(m))) then + budget_ind_byname = m + return + end if + end do + if (budget_ind_byname == -1) then + write(iulog,*)'ind_byname failed, name=',trim(name),'budget_name=' + do m = 1, budget_array_max + write(iulog,*)'budget_name(',m,')=',budget_name(m) + end do + end if + +!============================================================================== + end function budget_ind_byname + +subroutine budget_chk_dim + + ! Check that the number of registered budgets is budget_array_max + ! Write budget list to log file. + + integer :: i, m + character(len=*), parameter :: sub='budget_chk_dim' + character(len=128) :: errmsg + !----------------------------------------------------------------------- + + ! if (budget_num /= budget_array_max) then + ! write(errmsg, *) sub//': FATAL: number of added budgets (',budget_num, & + ! ') not equal to budget_array_max (', budget_array_max, ')' + ! call endrun (errmsg) + ! endif + + if (masterproc) then + write(iulog,*) 'Budgets list:' + do i = 1, budget_num + write(iulog,'(2x,i4,2x,a8,2x,a128)') i, budget_name(i), budget_longname(i) + end do + end if + +end subroutine budget_chk_dim + +function budget_outfld(m) + + ! Query whether default CAM outfld calls should be made. + + !----------------------------------------------------------------------- + integer, intent(in) :: m ! budget index + + logical :: budget_outfld ! true => use default CAM outfld calls + + character(len=*), parameter :: sub='budget_outfld' + character(len=128) :: errmsg + !----------------------------------------------------------------------- + + if (m > 0 .and. m <= budget_array_max) then + budget_outfld = budget_out(m) + else + ! index out of range + write(errmsg,*) sub//': FATAL: bad value for budget diff index=', m + call endrun(errmsg) + end if + + end function budget_outfld + +function budget_count(ind) + + ! Query whether default CAM outfld calls should be made. + + !----------------------------------------------------------------------- + integer, intent(in) :: ind ! budget index + + integer :: budget_count ! true => use default CAM outfld calls + + character(len=*), parameter :: sub='budget_count' + character(len=128) :: errmsg + !----------------------------------------------------------------------- + + if (ind > 0 .and. ind <= budget_array_max) then + budget_count = budget_cnt(ind) + else + ! index out of range + write(errmsg,*) sub//': FATAL: bad value for budget diff index=', ind + call endrun(errmsg) + end if + + end function budget_count + +!============================================================================== + +end module budgets diff --git a/src/control/cam_comp.F90 b/src/control/cam_comp.F90 index 61246d30c8..5ab644985f 100644 --- a/src/control/cam_comp.F90 +++ b/src/control/cam_comp.F90 @@ -163,12 +163,16 @@ subroutine cam_init( & call cam_initfiles_open() ! Initialize grids and dynamics grid decomposition + + write(iulog,*)'calling dyn_grid_init' call dyn_grid_init() ! Initialize physics grid decomposition + write(iulog,*)'calling phys_grid_init' call phys_grid_init() ! Register advected tracers and physics buffer fields + write(iulog,*)'calling phys_register' call phys_register () ! Initialize ghg surface values before default initial distributions @@ -181,6 +185,7 @@ subroutine cam_init( & if (initial_run_in) then + write(iulog,*)'calling dyn_init' call dyn_init(dyn_in, dyn_out) ! Allocate and setup surface exchange data @@ -196,10 +201,13 @@ subroutine cam_init( & #endif end if + write(iulog,*)'calling phys_init' call phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) + write(iulog,*)'calling bldfld' call bldfld () ! master field list (if branch, only does hash tables) + write(iulog,*)'calling stepon_init' call stepon_init(dyn_in, dyn_out) call offline_driver_init() diff --git a/src/control/cam_control_mod.F90 b/src/control/cam_control_mod.F90 index ce6b3deaad..87306e5249 100644 --- a/src/control/cam_control_mod.F90 +++ b/src/control/cam_control_mod.F90 @@ -10,6 +10,7 @@ module cam_control_mod use spmd_utils, only: masterproc use cam_logfile, only: iulog use cam_abortutils, only: endrun +use budgets, only: budget_init implicit none public diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index 1b97ca1ce7..d1a0ac1e2f 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -13,7 +13,8 @@ module dp_coupling use dyn_grid, only: TimeLevel, edgebuf use dyn_comp, only: dyn_export_t, dyn_import_t -use physics_types, only: physics_state, physics_tend +!short term hack use physics_types, only: physics_state, physics_tend, physics_cnst_limit +use physics_types, only: physics_state, physics_tend!short term hack use phys_grid, only: get_ncols_p use phys_grid, only: get_dyn_col_p, columns_on_task, get_chunk_info_p use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_get_field @@ -546,7 +547,9 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) use hycoef, only: hyai, ps0 use shr_vmath_mod, only: shr_vmath_log use qneg_module, only: qneg3 - use dyn_comp, only: ixo, ixo2, ixh, ixh2 + use physconst, only: thermodynamic_active_species_num + use physconst, only: thermodynamic_active_species_idx_dycore + use physconst, only: thermodynamic_active_species_idx ! arguments type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state @@ -559,15 +562,7 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) real(r8) :: zvirv(pcols,pver) ! Local zvir array pointer real(r8) :: factor_array(pcols,nlev) - integer :: m, i, k, ncol - - !-------------------------------------------- - ! Variables needed for WACCM-X - !-------------------------------------------- - real(r8) :: mmrSum_O_O2_H ! Sum of mass mixing ratios for O, O2, and H - real(r8), parameter :: mmrMin=1.e-20_r8 ! lower limit of o2, o, and h mixing ratios - real(r8), parameter :: N2mmrMin=1.e-6_r8 ! lower limit of o2, o, and h mixing ratios - + integer :: m, i, k, ncol, m_cnst type(physics_buffer_desc), pointer :: pbuf_chnk(:) !---------------------------------------------------------------------------- @@ -609,7 +604,18 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) end do ! wet pressure variables (should be removed from physics!) - +#ifdef ALL_WATER_IN_DP + factor_array(:,:) = 1.0_r8 + do m_cnst=1,thermodynamic_active_species_num + m = thermodynamic_active_species_idx(m_cnst) + do k=1,nlev + do i=1,ncol + ! at this point all q's are dry + factor_array(i,k) = factor_array(i,k)+phys_state(lchnk)%q(i,k,m) + end do + end do + end do +#else do k=1,nlev do i=1,ncol ! to be consistent with total energy formula in physic's check_energy module only @@ -617,7 +623,7 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) factor_array(i,k) = 1+phys_state(lchnk)%q(i,k,1) end do end do - +#endif do k=1,nlev do i=1,ncol phys_state(lchnk)%pdel (i,k) = phys_state(lchnk)%pdeldry(i,k)*factor_array(i,k) @@ -660,45 +666,18 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) end do end if end do - !------------------------------------------------------------ - ! Ensure O2 + O + H (N2) mmr greater than one. - ! Check for unusually large H2 values and set to lower value. - !------------------------------------------------------------ - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - - do i=1,ncol - do k=1,pver - - if (phys_state(lchnk)%q(i,k,ixo) < mmrMin) phys_state(lchnk)%q(i,k,ixo) = mmrMin - if (phys_state(lchnk)%q(i,k,ixo2) < mmrMin) phys_state(lchnk)%q(i,k,ixo2) = mmrMin - mmrSum_O_O2_H = phys_state(lchnk)%q(i,k,ixo)+phys_state(lchnk)%q(i,k,ixo2)+phys_state(lchnk)%q(i,k,ixh) - - if ((1._r8-mmrMin-mmrSum_O_O2_H) < 0._r8) then - - phys_state(lchnk)%q(i,k,ixo) = phys_state(lchnk)%q(i,k,ixo) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H - - phys_state(lchnk)%q(i,k,ixo2) = phys_state(lchnk)%q(i,k,ixo2) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H - - phys_state(lchnk)%q(i,k,ixh) = phys_state(lchnk)%q(i,k,ixh) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H - - endif - - if(phys_state(lchnk)%q(i,k,ixh2) .gt. 6.e-5_r8) then - phys_state(lchnk)%q(i,k,ixh2) = 6.e-5_r8 - endif - - end do - end do - endif - - !----------------------------------------------------------------------------- - ! Call physconst_update to compute cpairv, rairv, mbarv, and cappav as - ! constituent dependent variables. - ! Compute molecular viscosity(kmvis) and conductivity(kmcnd). - ! Fill local zvirv variable; calculated for WACCM-X. - !----------------------------------------------------------------------------- if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + !------------------------------------------------------------ + ! Apply limiters to mixing ratios of major species + !------------------------------------------------------------ +!short term hack call physics_cnst_limit( phys_state(lchnk) ) + !----------------------------------------------------------------------------- + ! Call physconst_update to compute cpairv, rairv, mbarv, and cappav as + ! constituent dependent variables. + ! Compute molecular viscosity(kmvis) and conductivity(kmcnd). + ! Fill local zvirv variable; calculated for WACCM-X. + !----------------------------------------------------------------------------- call physconst_update(phys_state(lchnk)%q, phys_state(lchnk)%t, lchnk, ncol,& to_moist_factor=phys_state(lchnk)%pdeldry(:ncol,:)/phys_state(lchnk)%pdel(:ncol,:) ) zvirv(:,:) = shr_const_rwv / rairv(:,:,lchnk) -1._r8 @@ -707,7 +686,7 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) endif do k = 1, nlev - do i = 1, ncol + do i = 1, ncol phys_state(lchnk)%exner(i,k) = (phys_state(lchnk)%pint(i,pver+1) & / phys_state(lchnk)%pmid(i,k))**cappav(i,k,lchnk) end do diff --git a/src/dynamics/se/dycore/dimensions_mod.F90 b/src/dynamics/se/dycore/dimensions_mod.F90 index 5d3d52a448..8a41ea30c3 100644 --- a/src/dynamics/se/dycore/dimensions_mod.F90 +++ b/src/dynamics/se/dycore/dimensions_mod.F90 @@ -46,10 +46,6 @@ module dimensions_mod integer :: ntrac = 0 !ntrac is set in dyn_comp integer :: qsize = 0 !qsize is set in dyn_comp ! - ! hyperviscosity is applied on approximate pressure levels - ! Similar to CAM-EUL; see CAM5 scietific documentation (Note TN-486), equation (3.09), page 58. - ! - logical, public :: hypervis_dynamic_ref_state = .false. ! fvm dimensions: logical, public :: lprint!for debugging integer, parameter, public :: ngpc=3 !number of Gausspoints for the fvm integral approximation !phl change from 4 diff --git a/src/dynamics/se/dycore/element_mod.F90 b/src/dynamics/se/dycore/element_mod.F90 index 422799b8ef..1ad0dac498 100644 --- a/src/dynamics/se/dycore/element_mod.F90 +++ b/src/dynamics/se/dycore/element_mod.F90 @@ -5,7 +5,7 @@ module element_mod use dimensions_mod, only: np, nc, npsq, nlev, nlevp, qsize_d, max_neigh_edges,ntrac_d use edgetype_mod, only: edgedescriptor_t use gridgraph_mod, only: gridvertex_t - + use budgets, only: budget_array_max implicit none private integer, public, parameter :: timelevels = 3 @@ -74,6 +74,14 @@ module element_mod real (kind=r8) :: pecnd(np,np,nlev) ! pressure perturbation from condensate + ! reference profiles + real (kind=r8) :: T_ref(np,np,nlev) ! reference temperature + real (kind=r8) :: dp_ref(np,np,nlev) ! reference pressure level thickness + ! budgets + real (kind=r8) :: budget(np,np,9,budget_array_max) ! budgets + integer :: budget_cnt(budget_array_max) ! budget count for averaging + integer :: budget_subcycle(budget_array_max) ! budget subcycle count + end type derived_state_t !___________________________________________________________________ diff --git a/src/dynamics/se/dycore/fvm_mapping.F90 b/src/dynamics/se/dycore/fvm_mapping.F90 index 9ff118198c..3a2db525a1 100644 --- a/src/dynamics/se/dycore/fvm_mapping.F90 +++ b/src/dynamics/se/dycore/fvm_mapping.F90 @@ -450,7 +450,7 @@ subroutine dyn2phys_all_vars(nets,nete,elem,fvm,& do ie=nets,nete tmp = 1.0_r8 inv_area = 1.0_r8/dyn2phys(tmp,elem(ie)%metdet(:,:)) - phis_phys(:,ie) = RESHAPE(fvm(ie)%phis_physgrid,SHAPE(phis_phys(:,ie))) + phis_phys(:,ie) = RESHAPE(dyn2phys(elem(ie)%state%phis(:,:),elem(ie)%metdet(:,:),inv_area),SHAPE(phis_phys(:,ie))) ps_phys(:,ie) = ptop if (nc.ne.fv_nphys) then tmp = 1.0_r8 diff --git a/src/dynamics/se/dycore/global_norms_mod.F90 b/src/dynamics/se/dycore/global_norms_mod.F90 index 49f104380e..c89898f5ae 100644 --- a/src/dynamics/se/dycore/global_norms_mod.F90 +++ b/src/dynamics/se/dycore/global_norms_mod.F90 @@ -225,7 +225,7 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& use mesh_mod, only: MeshUseMeshFile use dimensions_mod, only: ksponge_end, kmvis_ref, kmcnd_ref,rho_ref use physconst, only: cpair - + use std_atm_profile,only: std_atm_height type(element_t) , intent(inout) :: elem(:) integer , intent(in) :: nets,nete type (hybrid_t) , intent(in) :: hybrid @@ -241,13 +241,13 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& real (kind=r8) :: max_min_dx,min_min_dx,min_max_dx,max_unif_dx ! used for normalizing scalar HV real (kind=r8) :: max_normDinv, min_normDinv ! used for CFL real (kind=r8) :: min_area, max_area,max_ratio !min/max element area - real (kind=r8) :: avg_area, avg_min_dx + real (kind=r8) :: avg_area, avg_min_dx,tot_area,tot_area_rad real (kind=r8) :: min_hypervis, max_hypervis, avg_hypervis, stable_hv real (kind=r8) :: normDinv_hypervis real (kind=r8) :: x, y, noreast, nw, se, sw real (kind=r8), dimension(np,np,nets:nete) :: zeta real (kind=r8) :: lambda_max, lambda_vis, min_gw, lambda,umax, ugw - real (kind=r8) :: scale1,scale2,scale3, max_laplace + real (kind=r8) :: scale1,scale2,scale3, max_laplace,z(nlev) integer :: ie,corner, i, j, rowind, colind, k type (quadrature_t) :: gp character(LEN=256) :: rk_str @@ -341,6 +341,7 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& enddo call wrap_repro_sum(nvars=2, comm=hybrid%par%comm) avg_area = global_shared_sum(1)/dble(nelem) + tot_area_rad = global_shared_sum(1) avg_min_dx = global_shared_sum(2)/dble(nelem) min_area = ParallelMin(min_area,hybrid) @@ -355,12 +356,15 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& min_area = min_area*rearth*rearth/1000000._r8 max_area = max_area*rearth*rearth/1000000._r8 avg_area = avg_area*rearth*rearth/1000000._r8 + tot_area = tot_area_rad*rearth*rearth/1000000._r8 if (hybrid%masterthread) then write(iulog,* )"" write(iulog,* )"Running Global Integral Diagnostic..." write(iulog,*)"Area of unit sphere is",I_sphere write(iulog,*)"Should be 1.0 to round off..." write(iulog,'(a,f9.3)') 'Element area: max/min',(max_area/min_area) + write(iulog,'(a,E23.15)') 'Total Grid area: ',(tot_area) + write(iulog,'(a,E23.15)') 'Total Grid area rad^2: ',(tot_area_rad) if (.not.MeshUseMeshFile) then write(iulog,'(a,f6.3,f8.2)') "Average equatorial node spacing (deg, km) = ", & dble(90)/dble(ne*(np-1)), PI*rearth/(2000.0_r8*dble(ne*(np-1))) @@ -640,10 +644,15 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& nu_lev(k) = (1.0_r8-scale1)*nu +scale1*nu_max nu_t_lev(k) = (1.0_r8-scale1)*nu_p +scale1*nu_max end if - - if (hybrid%masterthread) write(iulog,*) "nu_t_lev =",k,nu_t_lev(k) - if (hybrid%masterthread) write(iulog,*) "nu,nu_div_lev=",k,nu_lev(k),nu_div_lev(k) end do + if (hybrid%masterthread)then + write(iulog,*) "z computed from barometric formula (using US std atmosphere)" + call std_atm_height(pmid(:),z(:)) + write(iulog,*) "k,pmid_ref,z,nu_lev,nu_t_lev,nu_div_lev" + do k=1,nlev + write(iulog,'(i3,5e11.4)') k,pmid(k),z(k),nu_lev(k),nu_t_lev(k),nu_div_lev(k) + end do + end if !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index 459658200f..500f313394 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -10,7 +10,8 @@ module prim_advance_mod private save - public :: prim_advance_exp, prim_advance_init, applyCAMforcing, calc_tot_energy_dynamics, compute_omega + public :: prim_advance_exp, prim_advance_init, applyCAMforcing, calc_tot_energy_dynamics, compute_omega, & + calc_tot_energy_dynamics_diff type (EdgeBuffer_t) :: edge3,edgeOmega,edgeSponge real (kind=r8), allocatable :: ur_weights(:) @@ -446,8 +447,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, ! ! use physconst, only: gravit, cappa, cpair, tref, lapse_rate, get_dp_ref - use dimensions_mod, only: np, nlev, nc, ntrac, npsq, qsize - use dimensions_mod, only: hypervis_dynamic_ref_state,ksponge_end + use dimensions_mod, only: np, nlev, nc, ntrac, npsq, qsize, ksponge_end use dimensions_mod, only: nu_scale_top,nu_lev,kmvis_ref,kmcnd_ref,rho_ref,km_sponge_factor use dimensions_mod, only: kmvisi_ref,kmcndi_ref,nu_t_lev use control_mod, only: nu, nu_t, hypervis_subcycle,hypervis_subcycle_sponge, nu_p, nu_top @@ -481,8 +481,6 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, integer :: kbeg, kend, kblk real (kind=r8), dimension(np,np,2,nlev,nets:nete) :: vtens real (kind=r8), dimension(np,np,nlev,nets:nete) :: ttens, dptens - real (kind=r8), dimension(np,np,nlev,nets:nete) :: dp3d_ref, T_ref, pmid_ref - real (kind=r8), dimension(np,np,nets:nete) :: ps_ref real (kind=r8), dimension(0:np+1,0:np+1,nlev) :: corners real (kind=r8), dimension(2,2,2) :: cflux real (kind=r8) :: temp (np,np,nlev) @@ -507,46 +505,6 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, ptop = hvcoord%hyai(1)*hvcoord%ps0 - if (hypervis_dynamic_ref_state) then - ! - ! use dynamic reference pressure (P. Callaghan) - ! - call calc_dp3d_reference(elem,edge3,hybrid,nets,nete,nt,hvcoord,dp3d_ref) - do ie=nets,nete - ps_ref(:,:,ie) = ptop + sum(elem(ie)%state%dp3d(:,:,:,nt),3) - end do - else - ! - ! use static reference pressure (hydrostatic balance incl. effect of topography) - ! - do ie=nets,nete - call get_dp_ref(hvcoord%hyai, hvcoord%hybi, hvcoord%ps0,1,np,1,np,1,nlev,& - elem(ie)%state%phis(:,:),dp3d_ref(:,:,:,ie),ps_ref(:,:,ie)) - end do - endif - ! - ! reference temperature profile (Simmons and Jiabin, 1991, QJRMS, Section 2a) - ! - ! Tref = T0+T1*Exner - ! T1 = .0065*Tref*Cp/g ! = ~191 - ! T0 = Tref-T1 ! = ~97 - ! - T1 = lapse_rate*Tref*cpair/gravit - T0 = Tref-T1 - do ie=nets,nete - do k=1,nlev - pmid_ref(:,:,k,ie) =hvcoord%hyam(k)*hvcoord%ps0 + hvcoord%hybm(k)*ps_ref(:,:,ie) - dp3d_ref(:,:,k,ie) = ((hvcoord%hyai(k+1)-hvcoord%hyai(k))*hvcoord%ps0 + & - (hvcoord%hybi(k+1)-hvcoord%hybi(k))*ps_ref(:,:,ie)) - if (hvcoord%hybm(k)>0) then - tmp2 = (pmid_ref(:,:,k,ie)/hvcoord%ps0)**cappa - T_ref(:,:,k,ie) = (T0+T1*tmp2) - else - T_ref(:,:,k,ie) = 0.0_r8 - end if - end do - end do - kbeg=1; kend=nlev kblk = kend - kbeg + 1 @@ -558,11 +516,10 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! do ic=1,hypervis_subcycle - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dBH') + call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dBH',subcycle=.true.) rhypervis_subcycle=1.0_r8/real(hypervis_subcycle,kind=r8) - call biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend,hvcoord,& - dp3d_ref=dp3d_ref,pmid_ref=pmid_ref) + call biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend,hvcoord) do ie=nets,nete ! compute mean flux @@ -719,7 +676,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, enddo end do - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dCH') + call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dCH',subcycle=.true.) do ie=nets,nete !$omp parallel do num_threads(vert_num_threads), private(k,i,j,v1,v2,heating) do k=kbeg,kend @@ -739,7 +696,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, enddo enddo enddo - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dAH') + call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dAH',subcycle=.true.) end do ! @@ -815,7 +772,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, ! Horizontal Laplacian diffusion ! dt=dt2/hypervis_subcycle_sponge - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dBS') + call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dBS',subcycle=.true.) kblk = ksponge_end do ic=1,hypervis_subcycle_sponge rhypervis_subcycle=1.0_r8/real(hypervis_subcycle_sponge,kind=r8) @@ -1001,7 +958,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, end do end do call t_stopf('sponge_diff') - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dAS') + call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dAS',subcycle=.true.) end subroutine advance_hypervis_dp @@ -1493,24 +1450,31 @@ subroutine distribute_flux_at_corners(cflux, corners, getmapP) endif end subroutine distribute_flux_at_corners - subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suffix) + subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suffix, subcycle) use dimensions_mod, only: npsq,nlev,np,lcp_moist,nc,ntrac,qsize use physconst, only: gravit, cpair, rearth,omega use element_mod, only: element_t use cam_history, only: outfld, hist_fld_active use constituents, only: cnst_get_ind - use string_utils, only: strlist_get_ind use hycoef, only: hyai, ps0 use fvm_control_volume_mod, only: fvm_struct use physconst, only: get_dp, get_cp use physconst, only: thermodynamic_active_species_idx_dycore + use physconst, only: thermodynamic_active_species_ice_num + use physconst, only: thermodynamic_active_species_liq_num + use physconst, only: thermodynamic_active_species_liq_idx + use physconst, only: thermodynamic_active_species_ice_idx + use dimensions_mod, only: cnst_name_gll + use budgets, only: budget_info + use cam_logfile, only: iulog !------------------------------Arguments-------------------------------- - type (element_t) , intent(in) :: elem(:) + type (element_t) , intent(inout) :: elem(:) type(fvm_struct) , intent(in) :: fvm(:) integer , intent(in) :: tl, tl_qdp,nets,nete character*(*) , intent(in) :: outfld_name_suffix ! suffix for "outfld" names + logical, optional, intent(in) :: subcycle ! true if called inside subcycle loop !---------------------------Local storage------------------------------- @@ -1518,10 +1482,12 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf real(kind=r8) :: ke(npsq) ! kinetic energy (J/m2) real(kind=r8) :: cdp_fvm(nc,nc,nlev) + real(kind=r8) :: cdp(np,np,nlev) real(kind=r8) :: se_tmp real(kind=r8) :: ke_tmp real(kind=r8) :: ps(np,np) real(kind=r8) :: pdel(np,np,nlev) + ! ! global axial angular momentum (AAM) can be separated into one part (mr) associatedwith the relative motion ! of the atmosphere with respect to the planets surface (also known as wind AAM) and another part (mo) @@ -1533,12 +1499,11 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf real(kind=r8) :: mr_cnst, mo_cnst, cos_lat, mr_tmp, mo_tmp real(kind=r8) :: cp(np,np,nlev) - integer :: ie,i,j,k - integer :: ixwv,ixcldice, ixcldliq, ixtt ! CLDICE, CLDLIQ and test tracer indices + integer :: ie,i,j,k,idx,ixtt,budget_ind,state_ind,iwv character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 !----------------------------------------------------------------------- - + write(iulog,*)'calc_tot outfld_name_suffix=',trim(outfld_name_suffix) name_out1 = 'SE_' //trim(outfld_name_suffix) name_out2 = 'KE_' //trim(outfld_name_suffix) name_out3 = 'WV_' //trim(outfld_name_suffix) @@ -1548,20 +1513,7 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2).or.hist_fld_active(name_out3).or.& hist_fld_active(name_out4).or.hist_fld_active(name_out5).or.hist_fld_active(name_out6)) then - - if (ntrac>0) then - ixwv = 1 - call cnst_get_ind('CLDLIQ' , ixcldliq, abort=.false.) - call cnst_get_ind('CLDICE' , ixcldice, abort=.false.) - else - ! - ! when using CSLAM the condensates on the GLL grid may be located in a different index than in physics - ! - ixwv = -1 - call strlist_get_ind(cnst_name_gll, 'CLDLIQ' , ixcldliq, abort=.false.) - call strlist_get_ind(cnst_name_gll, 'CLDICE' , ixcldice, abort=.false.) - end if - call cnst_get_ind('TT_LW' , ixtt , abort=.false.) + call cnst_get_ind('TT_UN' , ixtt , abort=.false.) ! ! Compute frozen static energy in 3 parts: KE, SE, and energy associated with vapor and liquid ! @@ -1599,6 +1551,41 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf se(i+(j-1)*np) = se(i+(j-1)*np) + elem(ie)%state%phis(i,j)*ps(i,j)/gravit end do end do + +! could store pointer to dyn/phys state index inside of budget and call budget_state_update pass in se,ke etc. + call budget_info(trim(outfld_name_suffix),budget_ind=budget_ind,state_ind=state_ind) + ! reset all when cnt is 0 + if (elem(ie)%derived%budget_cnt(state_ind) == 0) then +!jt write(iulog,*)'zeroing out derived budget for ',trim(outfld_name_suffix) + elem(ie)%derived%budget_subcycle(state_ind) = 0 + elem(ie)%derived%budget(:,:,:,state_ind)=0.0_r8 + end if + if (present(subcycle)) then + if (subcycle) then + elem(ie)%derived%budget_subcycle(state_ind) = elem(ie)%derived%budget_subcycle(state_ind) + 1 + if (elem(ie)%derived%budget_subcycle(state_ind) == 1) then + elem(ie)%derived%budget_cnt(state_ind) = elem(ie)%derived%budget_cnt(state_ind) + 1 + end if +!jt if (ie==nets) write(iulog,*)'cnt and new subcycle after adding 1 ',elem(ie)%derived%budget_cnt(state_ind),elem(ie)%derived%budget_subcycle(state_ind),' for ',trim(outfld_name_suffix),' iam=',iam + else + elem(ie)%derived%budget_cnt(state_ind) = elem(ie)%derived%budget_cnt(state_ind) + 1 + elem(ie)%derived%budget_subcycle(state_ind) = 1 +!jt if (ie==nets) write(iulog,*)'subcycle false new cnt after adding 1 ',elem(ie)%derived%budget_cnt(state_ind),elem(ie)%derived%budget_subcycle(state_ind),' for ',trim(outfld_name_suffix),' iam=',iam + end if + else + elem(ie)%derived%budget_cnt(state_ind) = elem(ie)%derived%budget_cnt(state_ind) + 1 + elem(ie)%derived%budget_subcycle(state_ind) = 1 +!jt if (ie==nets) write(iulog,*)'no subcycle new cnt after adding 1 ',elem(ie)%derived%budget_cnt(state_ind),elem(ie)%derived%budget_subcycle(state_ind),' for ',trim(outfld_name_suffix),' iam=',iam + end if +!jt if (ie==nets) write(iulog,*)'adding se ke to derived budget for ',trim(outfld_name_suffix),' iam=',iam + do j=1,np + do i = 1, np + elem(ie)%derived%budget(i,j,1,state_ind) = elem(ie)%derived%budget(i,j,1,state_ind) + (se(i+(j-1)*np) + ke(i+(j-1)*np)) + elem(ie)%derived%budget(i,j,2,state_ind) = elem(ie)%derived%budget(i,j,2,state_ind) + se(i+(j-1)*np) + elem(ie)%derived%budget(i,j,3,state_ind) = elem(ie)%derived%budget(i,j,3,state_ind) + ke(i+(j-1)*np) + end do + end do + ! ! Output energy diagnostics on GLL grid ! @@ -1608,28 +1595,115 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf ! mass variables are output on CSLAM grid if using CSLAM else GLL grid ! if (ntrac>0) then - if (ixwv>0) then - cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixwv)*fvm(ie)%dp_fvm(1:nc,1:nc,:) - call util_function(cdp_fvm,nc,nlev,name_out3,ie) - end if - if (ixcldliq>0) then - cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixcldliq)*fvm(ie)%dp_fvm(1:nc,1:nc,:) + iwv = 0;if (ntrac>0) iwv=1 + cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,iwv)*fvm(ie)%dp_fvm(1:nc,1:nc,:) + call util_function(cdp_fvm,nc,nlev,name_out3,ie) + do j = 1, nc + do i = 1, nc + elem(ie)%derived%budget(i,j,4,state_ind) = elem(ie)%derived%budget(i,j,4,state_ind) + sum(cdp_fvm(i,j,:)) + end do + end do + elem(ie)%derived%budget(1:nc,1:nc,4,state_ind)=elem(ie)%derived%budget(1:nc,1:nc,4,state_ind)/gravit + ! + ! sum over liquid water + ! + if (thermodynamic_active_species_liq_num>0) then + cdp_fvm = 0.0_r8 + do idx = 1,thermodynamic_active_species_liq_num + cdp_fvm = cdp_fvm + fvm(ie)%c(1:nc,1:nc,:,thermodynamic_active_species_liq_idx(idx))& + *fvm(ie)%dp_fvm(1:nc,1:nc,:) + end do call util_function(cdp_fvm,nc,nlev,name_out4,ie) + do j = 1, nc + do i = 1, nc + elem(ie)%derived%budget(i,j,5,state_ind) = elem(ie)%derived%budget(i,j,5,state_ind) + sum(cdp_fvm(i,j,:)) + end do + end do + elem(ie)%derived%budget(1:nc,1:nc,5,state_ind)=elem(ie)%derived%budget(1:nc,1:nc,5,state_ind)/gravit end if - if (ixcldice>0) then - cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixcldice)*fvm(ie)%dp_fvm(1:nc,1:nc,:) - call util_function(cdp_fvm,nc,nlev,name_out5,ie) + ! + ! sum over ice water + ! + if (thermodynamic_active_species_ice_num>0) then + cdp_fvm = 0.0_r8 + do idx = 1,thermodynamic_active_species_ice_num + cdp_fvm = cdp_fvm + fvm(ie)%c(1:nc,1:nc,:,thermodynamic_active_species_ice_idx(idx))& + *fvm(ie)%dp_fvm(1:nc,1:nc,:) + end do + call util_function(cdp_fvm,nc,nlev,name_out4,ie) + do j = 1, nc + do i = 1, nc + elem(ie)%derived%budget(i,j,6,state_ind) = elem(ie)%derived%budget(i,j,6,state_ind) + sum(cdp_fvm(i,j,:)) + end do + end do + elem(ie)%derived%budget(1:nc,1:nc,6,state_ind)=elem(ie)%derived%budget(1:nc,1:nc,6,state_ind)/gravit end if + ! + ! dry test tracer + ! if (ixtt>0) then cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixtt)*fvm(ie)%dp_fvm(1:nc,1:nc,:) call util_function(cdp_fvm,nc,nlev,name_out6,ie) + do j = 1, nc + do i = 1, nc + elem(ie)%derived%budget(i,j,7,state_ind) = elem(ie)%derived%budget(i,j,7,state_ind) + sum(cdp_fvm(i,j,:)) + end do + end do + elem(ie)%derived%budget(1:nc,1:nc,7,state_ind)=elem(ie)%derived%budget(1:nc,1:nc,7,state_ind)/gravit end if else - call util_function(elem(ie)%state%qdp(:,:,:,1 ,tl_qdp),np,nlev,name_out3,ie) - if (ixcldliq>0) call util_function(elem(ie)%state%qdp(:,:,:,ixcldliq,tl_qdp),np,nlev,name_out4,ie) - if (ixcldice>0) call util_function(elem(ie)%state%qdp(:,:,:,ixcldice,tl_qdp),np,nlev,name_out5,ie) - if (ixtt>0 ) call util_function(elem(ie)%state%qdp(:,:,:,ixtt ,tl_qdp),np,nlev,name_out6,ie) - end if + call util_function(elem(ie)%state%qdp(:,:,:,1,tl_qdp),np,nlev,name_out3,ie) + do j = 1, np + do i = 1, np + elem(ie)%derived%budget(i,j,4,state_ind) = elem(ie)%derived%budget(i,j,4,state_ind) + sum(elem(ie)%state%qdp(i,j,:,1,tl_qdp)) + end do + end do + elem(ie)%derived%budget(1:np,1:np,4,state_ind)=elem(ie)%derived%budget(1:np,1:np,4,state_ind)/gravit + ! + ! sum over liquid water + ! + if (thermodynamic_active_species_liq_num>0) then + cdp = 0.0_r8 + do idx = 1,thermodynamic_active_species_liq_num + cdp = cdp + elem(ie)%state%qdp(:,:,:,thermodynamic_active_species_liq_idx(idx),tl_qdp) + end do + call util_function(cdp,np,nlev,name_out4,ie) + do j = 1, np + do i = 1, np + elem(ie)%derived%budget(i,j,5,state_ind) = elem(ie)%derived%budget(i,j,5,state_ind) + sum(cdp(i,j,:)) + end do + end do + elem(ie)%derived%budget(1:np,1:np,5,state_ind)=elem(ie)%derived%budget(1:np,1:np,5,state_ind)/gravit + end if + ! + ! sum over ice water + ! + if (thermodynamic_active_species_ice_num>0) then + cdp = 0.0_r8 + do idx = 1,thermodynamic_active_species_ice_num + cdp = cdp + elem(ie)%state%qdp(:,:,:,thermodynamic_active_species_ice_idx(idx),tl_qdp) + end do + call util_function(cdp,np,nlev,name_out5,ie) + do j = 1, np + do i = 1, np + elem(ie)%derived%budget(i,j,6,state_ind) = elem(ie)%derived%budget(i,j,6,state_ind) + sum(cdp(i,j,:)) + end do + end do + elem(ie)%derived%budget(1:np,1:np,6,state_ind)=elem(ie)%derived%budget(1:np,1:np,6,state_ind)/gravit + end if + ! + ! dry test tracer + ! + if (ixtt>0) then + call util_function(elem(ie)%state%qdp(:,:,:,ixtt,tl_qdp),np,nlev,name_out6,ie) + do j = 1, np + do i = 1, np + elem(ie)%derived%budget(i,j,7,state_ind) = elem(ie)%derived%budget(i,j,7,state_ind) + sum(elem(ie)%state%qdp(i,j,:,ixtt,tl_qdp)) + end do + end do + elem(ie)%derived%budget(1:np,1:np,7,state_ind)=elem(ie)%derived%budget(1:np,1:np,7,state_ind)/gravit + end if + end if end do end if ! @@ -1649,8 +1723,6 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf name_out2 = 'MO_' //trim(outfld_name_suffix) if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2)) then - call strlist_get_ind(cnst_name_gll, 'CLDLIQ', ixcldliq, abort=.false.) - call strlist_get_ind(cnst_name_gll, 'CLDICE', ixcldice, abort=.false.) mr_cnst = rearth**3/gravit mo_cnst = omega*rearth**4/gravit do ie=nets,nete @@ -1672,12 +1744,179 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf end do call outfld(name_out1 ,mr ,npsq,ie) call outfld(name_out2 ,mo ,npsq,ie) + do j=1,np + do i = 1, np + elem(ie)%derived%budget(i,j,8,state_ind) = elem(ie)%derived%budget(i,j,8,state_ind) + mr(i+(j-1)*np) + elem(ie)%derived%budget(i,j,9,state_ind) = elem(ie)%derived%budget(i,j,9,state_ind) + mo(i+(j-1)*np) + end do + end do end do end if end subroutine calc_tot_energy_dynamics + + subroutine calc_tot_energy_dynamics_diff(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suffix, subcycle) + use dimensions_mod, only: np,nc,ntrac,npsq + use element_mod, only: element_t + use cam_history, only: hist_fld_active,outfld + use constituents, only: cnst_get_ind + use fvm_control_volume_mod, only: fvm_struct + use physconst, only: thermodynamic_active_species_idx_dycore + use physconst, only: thermodynamic_active_species_ice_num + use physconst, only: thermodynamic_active_species_liq_num + use physconst, only: thermodynamic_active_species_liq_idx + use physconst, only: thermodynamic_active_species_ice_idx + + use budgets, only: budget_info,budget_ind_byname + use cam_logfile, only: iulog + !------------------------------Arguments-------------------------------- + + type (element_t) , intent(inout) :: elem(:) + type(fvm_struct) , intent(in) :: fvm(:) + integer , intent(in) :: tl, tl_qdp,nets,nete + character*(*) , intent(in) :: outfld_name_suffix ! suffix for "outfld" names + logical, optional, intent(in) :: subcycle ! true if called inside subcycle loop + + !---------------------------Local storage------------------------------- + + integer :: ie,ixtt,b_ind,s_ind,is1,is2 + character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 + real(r8), allocatable, dimension(:,:,:,:) :: tmp,tmp1,tmp2 + character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn + !----------------------------------------------------------------------- + write(iulog,*)'calc_tot diff outfld_name_suffix=',trim(outfld_name_suffix) + name_out1 = 'SE_' //trim(outfld_name_suffix) + name_out2 = 'KE_' //trim(outfld_name_suffix) + name_out3 = 'WV_' //trim(outfld_name_suffix) + name_out4 = 'WL_' //trim(outfld_name_suffix) + name_out5 = 'WI_' //trim(outfld_name_suffix) + name_out6 = 'TT_' //trim(outfld_name_suffix) + +!jt if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2).or.hist_fld_active(name_out3).or.& +!jt hist_fld_active(name_out4).or.hist_fld_active(name_out5).or.hist_fld_active(name_out6)) then + call cnst_get_ind('TT_UN' , ixtt , abort=.false.) + ! + ! Compute frozen static energy in 3 parts: KE, SE, and energy associated with vapor and liquid + ! + allocate(tmp(np,np,9,nets:nete)) + allocate(tmp1(np,np,9,nets:nete)) + allocate(tmp2(np,np,9,nets:nete)) + b_ind=budget_ind_byname(trim(outfld_name_suffix)) + call budget_info(b_ind,stg1stateidx=is1, stg2stateidx=is2, optype=budget_optype, pkgtype=budget_pkgtype,state_ind=s_ind) + do ie=nets,nete +!jt write(iulog,*)'calc budgets name:',trim(outfld_name_suffix),' optype:',budget_optype,' pkgtype:',budget_pkgtype,' cnt:',elem(ie)%derived%budget_cnt(s_ind),'is1/is2:',is1,is2 + ! advance budget_cnt + if (present(subcycle)) then + if (subcycle) then + ! reset subcycle when cnt is 0 + if (elem(ie)%derived%budget_cnt(s_ind) == 0) then + elem(ie)%derived%budget_subcycle(s_ind) = 0 + elem(ie)%derived%budget(:,:,:,s_ind)=0.0_r8 + end if + elem(ie)%derived%budget_subcycle(s_ind) = elem(ie)%derived%budget_subcycle(s_ind) + 1 + if (elem(ie)%derived%budget_subcycle(s_ind) == 1) then + elem(ie)%derived%budget_cnt(s_ind) = elem(ie)%derived%budget_cnt(s_ind) + 1 + end if + else + elem(ie)%derived%budget_cnt(s_ind) = elem(ie)%derived%budget_cnt(s_ind) + 1 + elem(ie)%derived%budget_subcycle(s_ind) = 1 + end if + else + elem(ie)%derived%budget_cnt(s_ind) = elem(ie)%derived%budget_cnt(s_ind) + 1 + elem(ie)%derived%budget_subcycle(s_ind) = 1 + end if + if (elem(ie)%derived%budget_cnt(is1)==0.or.elem(ie)%derived%budget_cnt(is2)==0) then +!jt write(iulog,*)'budget_cnt is 0 set tmp to zero, cnt(is1b),cnt(is2b) ',trim(outfld_name_suffix),elem(ie)%derived%budget_cnt(is1),elem(ie)%derived%budget_cnt(is2) + tmp(:,:,:,ie)=0._r8 + else + tmp1(:,:,:,ie)=elem(ie)%derived%budget(:,:,:,is1) + tmp2(:,:,:,ie)=elem(ie)%derived%budget(:,:,:,is2) + end if + if (budget_optype=='dif') then +!jt write(iulog,*)'set difference for is1,is2,dyn_state_ind',is1,is2,s_ind + tmp(:,:,:,ie)=(tmp1(:,:,:,ie)-tmp2(:,:,:,ie)) + else if (budget_optype=='sum') then +!jt write(iulog,*)'set sum for is1,is2,dyn_state_ind',is1,is2,s_ind + tmp(:,:,:,ie)=(tmp1(:,:,:,ie)+tmp2(:,:,:,ie)) + else + call endrun('dyn_readnl: ERROR: budget_optype unknown:'//budget_optype) + end if + elem(ie)%derived%budget(:,:,:,s_ind)=tmp(:,:,:,ie) + ! + ! Output energy diagnostics on GLL grid + ! +! call outfld(name_out1,elem(ie)%derived%budget(:,:,2,s_ind),npsq,ie) +! call outfld(name_out2,elem(ie)%derived%budget(:,:,3,s_ind),npsq,ie) + ! + ! mass variables are output on CSLAM grid if using CSLAM else GLL grid + ! +! if (ntrac>0) then +! call outfld(name_out3,elem(ie)%derived%budget(:,:,4,s_ind),nc*nc,ie) + ! + ! sum over liquid water + ! +! if (thermodynamic_active_species_liq_num>0) & +! call outfld(name_out4,elem(ie)%derived%budget(:,:,5,s_ind),nc*nc,ie) + ! + ! sum over ice water + ! +! if (thermodynamic_active_species_ice_num>0) & +! call outfld(name_out5,elem(ie)%derived%budget(:,:,6,s_ind),nc*nc,ie) + ! + ! dry test tracer + ! +! if (ixtt>0) & +! call outfld(name_out6,elem(ie)%derived%budget(:,:,7,s_ind),nc*nc,ie) +! else +! call outfld(name_out3,elem(ie)%derived%budget(:,:,4,s_ind),npsq,ie) + ! + ! sum over liquid water + ! +! if (thermodynamic_active_species_liq_num>0) & +! call outfld(name_out4,elem(ie)%derived%budget(:,:,5,s_ind),npsq,ie) + ! + ! sum over ice water + ! +! if (thermodynamic_active_species_ice_num>0) & +! call outfld(name_out5,elem(ie)%derived%budget(:,:,6,s_ind),npsq,ie) + ! + ! dry test tracer + ! +! if (ixtt>0) & +! call outfld(name_out6,elem(ie)%derived%budget(:,:,7,s_ind),npsq,ie) +! end if + end do +!jt end if + deallocate(tmp) + deallocate(tmp1) + deallocate(tmp2) + ! + ! Axial angular momentum diagnostics + ! + ! Code follows + ! + ! Lauritzen et al., (2014): Held-Suarez simulations with the Community Atmosphere Model + ! Spectral Element (CAM-SE) dynamical core: A global axial angularmomentum analysis using Eulerian + ! and floating Lagrangian vertical coordinates. J. Adv. Model. Earth Syst. 6,129-140, + ! doi:10.1002/2013MS000268 + ! + ! MR is equation (6) without \Delta A and sum over areas (areas are in units of radians**2) + ! MO is equation (7) without \Delta A and sum over areas (areas are in units of radians**2) + ! + name_out1 = 'MR_' //trim(outfld_name_suffix) + name_out2 = 'MO_' //trim(outfld_name_suffix) + +!!$ if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2)) then +!!$ do ie=nets,nete +!!$ call outfld(name_out1 ,elem(ie)%derived%budget(:,:,8,s_ind) ,npsq,ie) +!!$ call outfld(name_out2 ,elem(ie)%derived%budget(:,:,9,s_ind) ,npsq,ie) +!!$ end do +!!$ end if + + end subroutine calc_tot_energy_dynamics_diff + subroutine output_qdp_var_dynamics(qdp,nx,num_trac,nets,nete,outfld_name) use dimensions_mod, only: nlev,ntrac use cam_history , only: outfld, hist_fld_active @@ -1705,7 +1944,7 @@ subroutine output_qdp_var_dynamics(qdp,nx,num_trac,nets,nete,outfld_name) call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) call cnst_get_ind('CLDICE', ixcldice, abort=.false.) - call cnst_get_ind('TT_LW' , ixtt , abort=.false.) + call cnst_get_ind('TT_MD' , ixtt , abort=.false.) do ie=nets,nete call util_function(qdp(:,:,:,1,ie),nx,nlev,name_out1,ie) @@ -1855,293 +2094,4 @@ subroutine compute_omega(hybrid,n0,qn0,elem,deriv,nets,nete,dt,hvcoord) end if !call FreeEdgeBuffer(edgeOmega) end subroutine compute_omega - - - subroutine calc_dp3d_reference(elem,edge3,hybrid,nets,nete,nt,hvcoord,dp3d_ref) - ! - ! calc_dp3d_reference: When the del^4 horizontal damping is applied to dp3d - ! the values are implicitly affected by natural variations - ! due to surface topography. - ! - ! To account for these physicaly correct variations, use - ! the current state values to compute appropriate - ! reference values for the current (lagrangian) ETA-surfaces. - ! Damping should then be applied to values relative to - ! this reference. - !======================================================================= - use hybvcoord_mod ,only: hvcoord_t - use physconst ,only: rair,cappa - use element_mod, only: element_t - use dimensions_mod, only: np,nlev - use hybrid_mod, only: hybrid_t - use edge_mod, only: edgevpack, edgevunpack - use bndry_mod, only: bndry_exchange - ! - ! Passed variables - !------------------- - type(element_t ),target,intent(inout):: elem(:) - type(EdgeBuffer_t) ,intent(inout):: edge3 - type(hybrid_t ) ,intent(in ):: hybrid - integer ,intent(in ):: nets,nete - integer ,intent(in ):: nt - type(hvcoord_t ) ,intent(in ):: hvcoord - real(kind=r8) ,intent(out ):: dp3d_ref(np,np,nlev,nets:nete) - ! - ! Local Values - !-------------- - real(kind=r8):: Phis_avg(np,np, nets:nete) - real(kind=r8):: Phi_avg (np,np,nlev,nets:nete) - real(kind=r8):: RT_avg (np,np,nlev,nets:nete) - real(kind=r8):: P_val (np,np,nlev) - real(kind=r8):: Ps_val (np,np) - real(kind=r8):: Phi_val (np,np,nlev) - real(kind=r8):: Phi_ival(np,np) - real(kind=r8):: I_Phi (np,np,nlev+1) - real(kind=r8):: Alpha (np,np,nlev ) - real(kind=r8):: I_P (np,np,nlev+1) - real(kind=r8):: DP_avg (np,np,nlev) - real(kind=r8):: P_avg (np,np,nlev) - real(kind=r8):: Ps_avg (np,np) - real(kind=r8):: Ps_ref (np,np) - real(kind=r8):: RT_lapse(np,np) - real(kind=r8):: dlt_Ps (np,np) - real(kind=r8):: dPhi (np,np,nlev) - real(kind=r8):: dPhis (np,np) - real(kind=r8):: E_Awgt,E_phis,E_phi(nlev),E_T(nlev),Lapse0,Expon0 - integer :: ie,ii,jj,kk,kptr - - ! Loop over elements - !-------------------- - do ie=nets,nete - - ! Calculate Pressure values from dp3dp - !-------------------------------------- - P_val(:,:,1) = hvcoord%hyai(1)*hvcoord%ps0 + elem(ie)%state%dp3d(:,:,1,nt)*0.5_r8 - do kk=2,nlev - P_val(:,:,kk) = P_val(:,:,kk-1) & - + elem(ie)%state%dp3d(:,:,kk-1,nt)*0.5_r8 & - + elem(ie)%state%dp3d(:,:,kk ,nt)*0.5_r8 - end do - Ps_val(:,:) = P_val(:,:,nlev) + elem(ie)%state%dp3d(:,:,nlev,nt)*0.5_r8 - - ! Calculate (dry) geopotential values - !-------------------------------------- - dPhi (:,:,:) = 0.5_r8*(rair*elem(ie)%state%T (:,:,:,nt) & - *elem(ie)%state%dp3d(:,:,:,nt) & - /P_val(:,:,:) ) - Phi_val (:,:,nlev) = elem(ie)%state%phis(:,:) + dPhi(:,:,nlev) - Phi_ival(:,:) = elem(ie)%state%phis(:,:) + dPhi(:,:,nlev)*2._r8 - do kk=(nlev-1),1,-1 - Phi_val (:,:,kk) = Phi_ival(:,:) + dPhi(:,:,kk) - Phi_ival(:,:) = Phi_val (:,:,kk) + dPhi(:,:,kk) - end do - - ! Calculate Element averages - !---------------------------- - E_Awgt = 0.0_r8 - E_phis = 0.0_r8 - E_phi(:) = 0._r8 - E_T (:) = 0._r8 - do jj=1,np - do ii=1,np - E_Awgt = E_Awgt + elem(ie)%spheremp(ii,jj) - E_phis = E_phis + elem(ie)%spheremp(ii,jj)*elem(ie)%state%phis(ii,jj) - E_phi (:) = E_phi (:) + elem(ie)%spheremp(ii,jj)*Phi_val(ii,jj,:) - E_T (:) = E_T (:) + elem(ie)%spheremp(ii,jj)*elem(ie)%state%T(ii,jj,:,nt) - end do - end do - - Phis_avg(:,:,ie) = E_phis/E_Awgt - do kk=1,nlev - Phi_avg(:,:,kk,ie) = E_phi(kk) /E_Awgt - RT_avg (:,:,kk,ie) = E_T (kk)*rair/E_Awgt - end do - end do ! ie=nets,nete - - ! Boundary Exchange of average values - !------------------------------------- - do ie=nets,nete - Phis_avg(:,:,ie) = elem(ie)%spheremp(:,:)*Phis_avg(:,:,ie) - do kk=1,nlev - Phi_avg(:,:,kk,ie) = elem(ie)%spheremp(:,:)*Phi_avg(:,:,kk,ie) - RT_avg (:,:,kk,ie) = elem(ie)%spheremp(:,:)*RT_avg (:,:,kk,ie) - end do - kptr = 0 - call edgeVpack(edge3,Phi_avg(:,:,:,ie),nlev,kptr,ie) - kptr = nlev - call edgeVpack(edge3,RT_avg (:,:,:,ie),nlev,kptr,ie) - kptr = 2*nlev - call edgeVpack(edge3,Phis_avg (:,:,ie),1 ,kptr,ie) - end do ! ie=nets,nete - - call bndry_exchange(hybrid,edge3,location='calc_dp3d_reference') - - do ie=nets,nete - kptr = 0 - call edgeVunpack(edge3,Phi_avg(:,:,:,ie),nlev,kptr,ie) - kptr = nlev - call edgeVunpack(edge3,RT_avg (:,:,:,ie),nlev,kptr,ie) - kptr = 2*nlev - call edgeVunpack(edge3,Phis_avg (:,:,ie),1 ,kptr,ie) - Phis_avg(:,:,ie) = elem(ie)%rspheremp(:,:)*Phis_avg(:,:,ie) - do kk=1,nlev - Phi_avg(:,:,kk,ie) = elem(ie)%rspheremp(:,:)*Phi_avg(:,:,kk,ie) - RT_avg (:,:,kk,ie) = elem(ie)%rspheremp(:,:)*RT_avg (:,:,kk,ie) - end do - end do ! ie=nets,nete - - ! Loop over elements - !-------------------- - do ie=nets,nete - - ! Fill elements with uniformly varying average values - !----------------------------------------------------- - call fill_element(Phis_avg(1,1,ie)) - do kk=1,nlev - call fill_element(Phi_avg(1,1,kk,ie)) - call fill_element(RT_avg (1,1,kk,ie)) - end do - - ! Integrate upward to compute Alpha == (dp3d/P) - !---------------------------------------------- - I_Phi(:,:,nlev+1) = Phis_avg(:,:,ie) - do kk=nlev,1,-1 - I_Phi(:,:,kk) = 2._r8* Phi_avg(:,:,kk,ie) - I_Phi(:,:,kk+1) - Alpha(:,:,kk) = 2._r8*(Phi_avg(:,:,kk,ie) - I_Phi(:,:,kk+1))/RT_avg(:,:,kk,ie) - end do - - ! Integrate downward to compute corresponding average pressure values - !--------------------------------------------------------------------- - I_P(:,:,1) = hvcoord%hyai(1)*hvcoord%ps0 - do kk=1,nlev - DP_avg(:,:,kk ) = I_P(:,:,kk)*(2._r8 * Alpha(:,:,kk))/(2._r8 - Alpha(:,:,kk)) - P_avg (:,:,kk ) = I_P(:,:,kk)*(2._r8 )/(2._r8 - Alpha(:,:,kk)) - I_P (:,:,kk+1) = I_P(:,:,kk)*(2._r8 + Alpha(:,:,kk))/(2._r8 - Alpha(:,:,kk)) - end do - Ps_avg(:,:) = I_P(:,:,nlev+1) - - ! Determine an appropriate d/d lapse rate near the surface - ! OPTIONALLY: Use dry adiabatic lapse rate or environmental lapse rate. - !----------------------------------------------------------------------- - if(.FALSE.) then - ! DRY ADIABATIC laspe rate - !------------------------------ - RT_lapse(:,:) = -cappa - else - ! ENVIRONMENTAL (empirical) laspe rate - !-------------------------------------- - RT_lapse(:,:) = (RT_avg (:,:,nlev-1,ie)-RT_avg (:,:,nlev,ie)) & - /(Phi_avg(:,:,nlev-1,ie)-Phi_avg(:,:,nlev,ie)) - endif - - ! Calcualte reference surface pressure - !-------------------------------------- - dPhis(:,:) = elem(ie)%state%phis(:,:)-Phis_avg(:,:,ie) - do jj=1,np - do ii=1,np - if (abs(RT_lapse(ii,jj)) .gt. 1.e-3_r8) then - Lapse0 = RT_lapse(ii,jj)/RT_avg(ii,jj,nlev,ie) - Expon0 = (-1._r8/RT_lapse(ii,jj)) - Ps_ref(ii,jj) = Ps_avg(ii,jj)*((1._r8 + Lapse0*dPhis(ii,jj))**Expon0) - else - Ps_ref(ii,jj) = Ps_avg(ii,jj)*exp(-dPhis(ii,jj)/RT_avg(ii,jj,nlev,ie)) - endif - end do - end do - - ! Calculate reference dp3d values - !--------------------------------- - dlt_Ps(:,:) = Ps_ref(:,:) - Ps_avg(:,:) - do kk=1,nlev - dp3d_ref(:,:,kk,ie) = DP_avg(:,:,kk) + (hvcoord%hybi(kk+1) & - -hvcoord%hybi(kk ))*dlt_Ps(:,:) - end do - - end do ! ie=nets,nete - - ! End Routine - !------------ - return - end subroutine calc_dp3d_reference - !============================================================================= - - - !============================================================================= - subroutine fill_element(Eval) - ! - ! fill_element_bilin: Fill in element gridpoints using local bi-linear - ! interpolation of nearby average values. - ! - ! NOTE: This routine is hard coded for NP=4, if a - ! different value of NP is used... bad things - ! will happen. - !======================================================================= - use dimensions_mod,only: np - ! - ! Passed variables - !------------------- - real(kind=r8),intent(inout):: Eval(np,np) - ! - ! Local Values - !-------------- - real(kind=r8):: X0 - real(kind=r8):: S1,S2,S3,S4 - real(kind=r8):: C1,C2,C3,C4 - real(kind=r8):: E1,E2,E3,E4,E0 - - X0 = sqrt(1._r8/5._r8) - - ! Set the "known" values Eval - !---------------------------- - S1 = (Eval(1 ,2 )+Eval(1 ,3 ))/2._r8 - S2 = (Eval(2 ,np)+Eval(3 ,np))/2._r8 - S3 = (Eval(np,2 )+Eval(np,3 ))/2._r8 - S4 = (Eval(2 ,1 )+Eval(3 ,1 ))/2._r8 - C1 = Eval(1 ,1 ) - C2 = Eval(1 ,np) - C3 = Eval(np,np) - C4 = Eval(np,1 ) - - ! E0 OPTION: Element Center value: - !--------------------------------- - IF(.FALSE.) THEN - ! Use ELEMENT AVERAGE value contained in (2,2) - !---------------------------------------------- - E0 = Eval(2,2) - ELSE - ! Use AVG OF SIDE VALUES after boundary exchange of E0 (smooting option) - !----------------------------------------------------------------------- - E0 = (S1 + S2 + S3 + S4)/4._r8 - ENDIF - - ! Calc interior values along center axes - !---------------------------------------- - E1 = E0 + X0*(S1-E0) - E2 = E0 + X0*(S2-E0) - E3 = E0 + X0*(S3-E0) - E4 = E0 + X0*(S4-E0) - - ! Calculate Side Gridpoint Values for Eval - !------------------------------------------ - Eval(1 ,2 ) = S1 + X0*(C1-S1) - Eval(1 ,3 ) = S1 + X0*(C2-S1) - Eval(2 ,np) = S2 + X0*(C2-S2) - Eval(3 ,np) = S2 + X0*(C3-S2) - Eval(np,2 ) = S3 + X0*(C4-S3) - Eval(np,3 ) = S3 + X0*(C3-S3) - Eval(2 ,1 ) = S4 + X0*(C1-S4) - Eval(3 ,1 ) = S4 + X0*(C4-S4) - - ! Calculate interior values - !--------------------------- - Eval(2 ,2 ) = E1 + X0*(Eval(2 ,1 )-E1) - Eval(2 ,3 ) = E1 + X0*(Eval(2 ,np)-E1) - Eval(3 ,2 ) = E3 + X0*(Eval(3 ,1 )-E3) - Eval(3 ,3 ) = E3 + X0*(Eval(3 ,np)-E3) - - ! End Routine - !------------ - return - end subroutine fill_element - end module prim_advance_mod diff --git a/src/dynamics/se/dycore/prim_driver_mod.F90 b/src/dynamics/se/dycore/prim_driver_mod.F90 index ffc010d1be..95f3304713 100644 --- a/src/dynamics/se/dycore/prim_driver_mod.F90 +++ b/src/dynamics/se/dycore/prim_driver_mod.F90 @@ -40,6 +40,8 @@ subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) use hybvcoord_mod, only: hvcoord_t use prim_advection_mod, only: prim_advec_init2,deriv use prim_advance_mod, only: compute_omega + use physconst, only: gravit, cappa, cpair, tref, lapse_rate, get_dp_ref + use physconst, only: pstd type (element_t), intent(inout) :: elem(:) type (fvm_struct), intent(inout) :: fvm(:) @@ -62,7 +64,8 @@ subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) real (kind=r8) :: dt_dyn_del2_sponge, dt_remap real (kind=r8) :: dt_tracer_vis ! viscosity timestep used in tracers - real (kind=r8) :: dp + real (kind=r8) :: dp,T1,T0,pmid_ref(np,np) + real (kind=r8) :: ps_ref(np,np,nets:nete) integer :: i,j,k,ie,t,q integer :: n0,n0_qdp @@ -120,7 +123,7 @@ subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) ! so only now does HOMME learn the timstep. print them out: call print_cfl(elem,hybrid,nets,nete,dtnu,& !p top and p mid levels - hvcoord%hyai(1)*hvcoord%ps0,(hvcoord%hyam(:)+hvcoord%hybm(:))*hvcoord%ps0,& + hvcoord%hyai(1)*hvcoord%ps0,hvcoord%hyam(:)*hvcoord%ps0+hvcoord%hybm(:)*pstd,& !dt_remap,dt_tracer_fvm,dt_tracer_se tstep*qsplit*rsplit,tstep*qsplit*fvm_supercycling,tstep*qsplit,& !dt_dyn,dt_dyn_visco,dt_tracer_visco, dt_phys @@ -138,6 +141,32 @@ subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) n0=tl%n0 call TimeLevel_Qdp( tl, qsplit, n0_qdp) call compute_omega(hybrid,n0,n0_qdp,elem,deriv,nets,nete,dt_remap,hvcoord) + ! + ! pre-compute pressure-level thickness reference profile + ! + do ie=nets,nete + call get_dp_ref(hvcoord%hyai, hvcoord%hybi, hvcoord%ps0,1,np,1,np,1,nlev,& + elem(ie)%state%phis(:,:),elem(ie)%derived%dp_ref(:,:,:),ps_ref(:,:,ie)) + end do + ! + ! pre-compute reference temperature profile (Simmons and Jiabin, 1991, QJRMS, Section 2a) + ! + ! Tref = T0+T1*Exner + ! T1 = .0065*Tref*Cp/g ! = ~191 + ! T0 = Tref-T1 ! = ~97 + ! + T1 = lapse_rate*Tref*cpair/gravit + T0 = Tref-T1 + do ie=nets,nete + do k=1,nlev + pmid_ref =hvcoord%hyam(k)*hvcoord%ps0 + hvcoord%hybm(k)*ps_ref(:,:,ie) + if (hvcoord%hybm(k)>0) then + elem(ie)%derived%T_ref(:,:,k) = T0+T1*(pmid_ref/hvcoord%ps0)**cappa + else + elem(ie)%derived%T_ref(:,:,k) = 0.0_r8 + end if + end do + end do if (hybrid%masterthread) write(iulog,*) "initial state:" call prim_printstate(elem, tl, hybrid,nets,nete, fvm) @@ -245,14 +274,14 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst call TimeLevel_Qdp( tl, qsplit, n0_qdp) - call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%n0,n0_qdp,'dAF') + call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%n0,n0_qdp,'dAF', subcycle=.true.) call ApplyCAMForcing(elem,fvm,tl%n0,n0_qdp,dt_remap,dt_phys,nets,nete,nsubstep) - call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') + call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD', subcycle=.true.) do r=1,rsplit if (r.ne.1) call TimeLevel_update(tl,"leapfrog") call prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,r) enddo - + ! defer final timelevel update until after remap and diagnostics call TimeLevel_Qdp( tl, qsplit, n0_qdp, np1_qdp) @@ -263,7 +292,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst ! always for tracers !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAD') + call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAD', subcycle=.true.) if (variable_nsplit.or.compute_diagnostics) then ! @@ -280,7 +309,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! time step is complete. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAR') + call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAR', subcycle=.true.) if (nsubstep==nsplit) then call compute_omega(hybrid,tl%np1,np1_qdp,elem,deriv,nets,nete,dt_remap,hvcoord) diff --git a/src/dynamics/se/dycore/viscosity_mod.F90 b/src/dynamics/se/dycore/viscosity_mod.F90 index 714b731169..1240d4a15f 100644 --- a/src/dynamics/se/dycore/viscosity_mod.F90 +++ b/src/dynamics/se/dycore/viscosity_mod.F90 @@ -50,8 +50,7 @@ module viscosity_mod CONTAINS -subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend,hvcoord,& - dp3d_ref,T_ref,pmid_ref) +subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend,hvcoord) use derivative_mod, only : subcell_Laplace_fluxes use dimensions_mod, only : ntrac, nu_div_lev,nu_lev use hybvcoord_mod, only : hvcoord_t @@ -68,7 +67,6 @@ subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid, real (kind=r8), intent(out), dimension(nc,nc,4,nlev,nets:nete) :: dpflux real (kind=r8), dimension(np,np,2,nlev,nets:nete) :: vtens real (kind=r8), dimension(np,np,nlev,nets:nete) :: ttens,dptens - real (kind=r8), dimension(np,np,nlev,nets:nete), optional :: dp3d_ref,T_ref,pmid_ref type (EdgeBuffer_t) , intent(inout) :: edge3 type (derivative_t) , intent(in) :: deriv type (hvcoord_t) , intent(in) :: hvcoord @@ -93,107 +91,70 @@ subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid, !so tensor is only used on second call to laplace_sphere_wk var_coef1 = .true. if(hypervis_scaling > 0) var_coef1 = .false. - dp_thresh=.025_r8 ! tunable coefficient - do ie=nets,nete + dp_thresh=.025_r8 ! tunable coefficient + do ie=nets,nete !$omp parallel do num_threads(vert_num_threads) private(k,tmp) do k=kbeg,kend - nu_ratio1=1 - nu_ratio2=1 - if (nu_div_lev(k)/=nu_lev(k)) then - if(hypervis_scaling /= 0) then - ! we have a problem with the tensor in that we cant seperate - ! div and curl components. So we do, with tensor V: - ! nu * (del V del ) * ( nu_ratio * grad(div) - curl(curl)) - nu_ratio1=nu_div_lev(k)/nu_lev(k) - nu_ratio2=1 - else - nu_ratio1=sqrt(nu_div_lev(k)/nu_lev(k)) - nu_ratio2=sqrt(nu_div_lev(k)/nu_lev(k)) - endif - endif - - if (present(T_ref)) then - tmp=elem(ie)%state%T(:,:,k,nt)-T_ref(:,:,k,ie) - else - tmp=elem(ie)%state%T(:,:,k,nt) - end if + nu_ratio1=1 + nu_ratio2=1 + if (nu_div_lev(k)/=nu_lev(k)) then + if(hypervis_scaling /= 0) then + ! we have a problem with the tensor in that we cant seperate + ! div and curl components. So we do, with tensor V: + ! nu * (del V del ) * ( nu_ratio * grad(div) - curl(curl)) + nu_ratio1=nu_div_lev(k)/nu_lev(k) + nu_ratio2=1 + else + nu_ratio1=sqrt(nu_div_lev(k)/nu_lev(k)) + nu_ratio2=sqrt(nu_div_lev(k)/nu_lev(k)) + endif + endif + + tmp=elem(ie)%state%T(:,:,k,nt)-elem(ie)%derived%T_ref(:,:,k) call laplace_sphere_wk(tmp,deriv,elem(ie),ttens(:,:,k,ie),var_coef=var_coef1) - if (present(dp3d_ref)) then - tmp=elem(ie)%state%dp3d(:,:,k,nt)-dp3d_ref(:,:,k,ie) - else - tmp=elem(ie)%state%dp3d(:,:,k,nt) - end if + + tmp=elem(ie)%state%dp3d(:,:,k,nt)-elem(ie)%derived%dp_ref(:,:,k) call laplace_sphere_wk(tmp,deriv,elem(ie),dptens(:,:,k,ie),var_coef=var_coef1) call vlaplace_sphere_wk(elem(ie)%state%v(:,:,:,k,nt),deriv,elem(ie),.true.,vtens(:,:,:,k,ie), & var_coef=var_coef1,nu_ratio=nu_ratio1) - enddo - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! add p correction to approximate Laplace on pressure surfaces - ! Laplace_p(T) = Laplace(T) - dT/dp Laplace(p) - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! lap_p_wk should be precomputed: - do k=1,nlev - call laplace_sphere_wk(pmid_ref(:,:,k,ie),deriv,elem(ie),lap_p_wk(:,:,k),var_coef=.false.) - enddo - - ! average T to interfaces, then compute dT/dp on midpoints: - T_i(:,:,1) = elem(ie)%state%T(:,:,1,nt) - T_i(:,:,nlevp) = elem(ie)%state%T(:,:,nlev,nt) - do k=2,nlev - T_i(:,:,k)=(elem(ie)%state%T(:,:,k,nt) + elem(ie)%state%T(:,:,k-1,nt))/2 - enddo - - do k=1,nlev - if (hvcoord%hybm(k)>0) then - tmp(:,:) = (T_i(:,:,k+1)-T_i(:,:,k))/dp3d_ref(:,:,k,ie) - tmp(:,:)=tmp(:,:) / (1.0_r8 + abs(tmp(:,:))/dp_thresh) - ttens(:,:,k,ie)=ttens(:,:,k,ie)-tmp(:,:)*lap_p_wk(:,:,k) ! correction term - endif - enddo - - - - + enddo - kptr = kbeg - 1 call edgeVpack(edge3,ttens(:,:,kbeg:kend,ie),kblk,kptr,ie) - + kptr = kbeg - 1 + nlev call edgeVpack(edge3,vtens(:,:,1,kbeg:kend,ie),kblk,kptr,ie) - + kptr = kbeg - 1 + 2*nlev call edgeVpack(edge3,vtens(:,:,2,kbeg:kend,ie),kblk,kptr,ie) - - kptr = kbeg - 1 + 3*nlev + + kptr = kbeg - 1 + 3*nlev call edgeVpack(edge3,dptens(:,:,kbeg:kend,ie),kblk,kptr,ie) enddo - + call bndry_exchange(hybrid,edge3,location='biharmonic_wk_dp3d') - + do ie=nets,nete !CLEAN rspheremv => elem(ie)%rspheremp(:,:) kptr = kbeg - 1 call edgeVunpack(edge3,ttens(:,:,kbeg:kend,ie),kblk,kptr,ie) - - kptr = kbeg - 1 + nlev + + kptr = kbeg - 1 + nlev call edgeVunpack(edge3,vtens(:,:,1,kbeg:kend,ie),kblk,kptr,ie) - - kptr = kbeg - 1 + 2*nlev + + kptr = kbeg - 1 + 2*nlev call edgeVunpack(edge3,vtens(:,:,2,kbeg:kend,ie),kblk,kptr,ie) - - kptr = kbeg - 1 + 3*nlev + + kptr = kbeg - 1 + 3*nlev call edgeVunpack(edge3,dptens(:,:,kbeg:kend,ie),kblk,kptr,ie) - + if (ntrac>0) then do k=1,nlev -!CLEAN tmp(:,:)= rspheremv(:,:)*dptens(:,:,k,ie) - tmp(:,:)= elem(ie)%rspheremp(:,:)*dptens(:,:,k,ie) - call subcell_Laplace_fluxes(tmp, deriv, elem(ie), np, nc,dpflux(:,:,:,k,ie)) +!CLEAN tmp(:,:)= rspheremv(:,:)*dptens(:,:,k,ie) + tmp(:,:)= elem(ie)%rspheremp(:,:)*dptens(:,:,k,ie) + call subcell_Laplace_fluxes(tmp, deriv, elem(ie), np, nc,dpflux(:,:,:,k,ie)) enddo endif @@ -213,7 +174,7 @@ subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid, v(:,:,2)=elem(ie)%rspheremp(:,:)*vtens(:,:,2,k,ie) call vlaplace_sphere_wk(v(:,:,:),deriv,elem(ie),.true.,vtens(:,:,:,k,ie), & var_coef=.true.,nu_ratio=nu_ratio2) - + enddo enddo !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -228,7 +189,7 @@ subroutine biharmonic_wk_omega(elem,ptens,deriv,edge3,hybrid,nets,nete,kbeg,kend real (kind=r8), dimension(np,np,nlev,nets:nete) :: ptens type (EdgeBuffer_t) , intent(inout) :: edge3 type (derivative_t) , intent(in) :: deriv - + ! local integer :: i,j,k,kptr,ie,kblk real (kind=r8), dimension(:,:), pointer :: rspheremv diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index eede8ca792..a2f12fad91 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -10,7 +10,7 @@ module dyn_comp cnst_is_a_water_species use cam_control_mod, only: initial_run use cam_initfiles, only: initial_file_get_id, topo_file_get_id, pertlim -use phys_control, only: use_gw_front, use_gw_front_igw, waccmx_is +use phys_control, only: use_gw_front, use_gw_front_igw use dyn_grid, only: ini_grid_name, timelevel, hvcoord, edgebuf, & ini_grid_hdim_name @@ -46,6 +46,7 @@ module dyn_comp use edge_mod, only: initEdgeBuffer, edgeVpack, edgeVunpack, FreeEdgeBuffer use edgetype_mod, only: EdgeBuffer_t use bndry_mod, only: bndry_exchange +use budgets, only: budget_add implicit none private @@ -77,13 +78,6 @@ module dyn_comp integer, public :: frontgf_idx = -1 integer, public :: frontga_idx = -1 -! constituent indices for waccm-x dry air properties -integer, public, protected :: & - ixo = -1, & - ixo2 = -1, & - ixh = -1, & - ixh2 = -1 - interface read_dyn_var module procedure read_dyn_field_2d module procedure read_dyn_field_3d @@ -120,7 +114,7 @@ subroutine dyn_readnl(NLFileName) use control_mod, only: sponge_del4_nu_div_fac, sponge_del4_nu_fac, sponge_del4_lev use dimensions_mod, only: ne, npart use dimensions_mod, only: lcp_moist - use dimensions_mod, only: hypervis_dynamic_ref_state,large_Courant_incr + use dimensions_mod, only: large_Courant_incr use dimensions_mod, only: fvm_supercycling, fvm_supercycling_jet use dimensions_mod, only: kmin_jet, kmax_jet use params_mod, only: SFCURVE @@ -169,7 +163,6 @@ subroutine dyn_readnl(NLFileName) integer :: se_horz_num_threads integer :: se_vert_num_threads integer :: se_tracer_num_threads - logical :: se_hypervis_dynamic_ref_state logical :: se_lcp_moist logical :: se_write_restart_unstruct logical :: se_large_Courant_incr @@ -217,7 +210,6 @@ subroutine dyn_readnl(NLFileName) se_horz_num_threads, & se_vert_num_threads, & se_tracer_num_threads, & - se_hypervis_dynamic_ref_state,& se_lcp_moist, & se_write_restart_unstruct, & se_large_Courant_incr, & @@ -293,7 +285,6 @@ subroutine dyn_readnl(NLFileName) call MPI_bcast(se_horz_num_threads, 1, MPI_integer, masterprocid, mpicom,ierr) call MPI_bcast(se_vert_num_threads, 1, MPI_integer, masterprocid, mpicom,ierr) call MPI_bcast(se_tracer_num_threads, 1, MPI_integer, masterprocid, mpicom,ierr) - call MPI_bcast(se_hypervis_dynamic_ref_state, 1, mpi_logical, masterprocid, mpicom, ierr) call MPI_bcast(se_lcp_moist, 1, mpi_logical, masterprocid, mpicom, ierr) call MPI_bcast(se_write_restart_unstruct, 1, mpi_logical, masterprocid, mpicom, ierr) call MPI_bcast(se_large_Courant_incr, 1, mpi_logical, masterprocid, mpicom, ierr) @@ -363,7 +354,6 @@ subroutine dyn_readnl(NLFileName) vert_remap_uvTq_alg = set_vert_remap(se_vert_remap_T, se_vert_remap_uvTq_alg) vert_remap_tracer_alg = set_vert_remap(se_vert_remap_T, se_vert_remap_tracer_alg) fv_nphys = se_fv_nphys - hypervis_dynamic_ref_state = se_hypervis_dynamic_ref_state lcp_moist = se_lcp_moist large_Courant_incr = se_large_Courant_incr fvm_supercycling = se_fvm_supercycling @@ -462,7 +452,6 @@ subroutine dyn_readnl(NLFileName) write(iulog, '(a,a)') 'dyn_readnl: se_vert_remap_T = ',trim(se_vert_remap_T) write(iulog, '(a,a)') 'dyn_readnl: se_vert_remap_uvTq_alg = ',trim(se_vert_remap_uvTq_alg) write(iulog, '(a,a)') 'dyn_readnl: se_vert_remap_tracer_alg = ',trim(se_vert_remap_tracer_alg) - write(iulog, '(a,l4)') 'dyn_readnl: se_hypervis_dynamic_ref_state = ',hypervis_dynamic_ref_state write(iulog, '(a,l4)') 'dyn_readnl: lcp_moist = ',lcp_moist write(iulog, '(a,i0)') 'dyn_readnl: se_fvm_supercycling = ',fvm_supercycling write(iulog, '(a,i0)') 'dyn_readnl: se_fvm_supercycling_jet = ',fvm_supercycling_jet @@ -597,7 +586,7 @@ subroutine dyn_init(dyn_in, dyn_out) use dyn_grid, only: elem, fvm use cam_pio_utils, only: clean_iodesc_list use physconst, only: thermodynamic_active_species_num, thermodynamic_active_species_idx - use physconst, only: thermodynamic_active_species_idx_dycore, rair, cpair + use physconst, only: thermodynamic_active_species_idx_dycore, rair, cpair, pstd use physconst, only: thermodynamic_active_species_liq_idx,thermodynamic_active_species_ice_idx use physconst, only: thermodynamic_active_species_liq_idx_dycore,thermodynamic_active_species_ice_idx_dycore use physconst, only: thermodynamic_active_species_liq_num, thermodynamic_active_species_ice_num @@ -619,6 +608,7 @@ subroutine dyn_init(dyn_in, dyn_out) use control_mod, only: vert_remap_uvTq_alg, vert_remap_tracer_alg use std_atm_profile, only: std_atm_height use dyn_tests_utils, only: vc_dycore, vc_dry_pressure, string_vc, vc_str_lgth + use budgets, only: budget_num, budget_outfld, budget_info ! Dummy arguments: type(dyn_import_t), intent(out) :: dyn_in type(dyn_export_t), intent(out) :: dyn_out @@ -677,6 +667,9 @@ subroutine dyn_init(dyn_in, dyn_out) character(len=*), parameter :: sub = 'dyn_init' real(r8) :: km_sponge_factor_local(nlev+1) + character(len=64) :: budget_name ! budget names + character(len=3) :: budget_pkgtype ! budget type phy or dyn + character(len=128) :: budget_longname ! long name of budgets !---------------------------------------------------------------------------- vc_dycore = vc_dry_pressure if (masterproc) then @@ -800,16 +793,15 @@ subroutine dyn_init(dyn_in, dyn_out) (hvcoord%hyam(:)+hvcoord%hybm(:))*hvcoord%ps0,km_sponge_factor,& kmvis_ref,kmcnd_ref,rho_ref) + write(iulog,*) "Molecular viscoity and thermal conductivity reference profile" + write(iulog,*) "k, p, z, km_sponge_factor, kmvis_ref/rho_ref, kmcnd_ref/(cp*rho_ref):" do k=1,nlev ! only apply molecular viscosity where viscosity is > 1000 m/s^2 if (MIN(kmvis_ref(k)/rho_ref(k),kmcnd_ref(k)/(cpair*rho_ref(k)))>1000.0_r8) then if (masterproc) then - press = (hvcoord%hyam(k)+hvcoord%hybm(k))*hvcoord%ps0 + press = hvcoord%hyam(k)*hvcoord%ps0+hvcoord%hybm(k)*pstd call std_atm_height(press,z) - write(iulog,'(a,i3,3e11.4)') "k, p, z, km_sponge_factor :",k, & - press, z,km_sponge_factor(k) - write(iulog,'(a,2e11.4)') "kmvis_ref/rho_ref, kmcnd_ref/(cp*rho_ref): ", & - kmvis_ref(k)/rho_ref(k),kmcnd_ref(k)/(cpair*rho_ref(k)) + write(iulog,'(i3,5e11.4)') k,press, z,km_sponge_factor(k),kmvis_ref(k)/rho_ref(k),kmcnd_ref(k)/(cpair*rho_ref(k)) end if kmol_end = k else @@ -931,7 +923,73 @@ subroutine dyn_init(dyn_in, dyn_out) end if end do end do - ! + + ! Register stages for budgets + istage=1 + call budget_add('dED', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) + istage=istage+1 + call budget_add('dAF', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) + istage=istage+1 + call budget_add('dBD', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) + istage=istage+1 + call budget_add('dAD', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) + istage=istage+1 + call budget_add('dAR', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) + istage=istage+1 + call budget_add('dBF', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) + istage=istage+1 + call budget_add('dBH', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) + istage=istage+1 + call budget_add('dCH', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) + istage=istage+1 + call budget_add('dAH', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) + istage=istage+1 + call budget_add('dBS', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) + istage=istage+1 + call budget_add('dAS', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) + ! + ! Register budgets. + ! + call budget_add('BD_dyn_total','dBF','dED',pkgtype='dyn',optype='dif',longname="dE/dt dyn total (dycore+phys tendency (dBF-dED)",outfld=.true.) + + call budget_add('rate_2d_dyn','dAD','dBD',pkgtype='dyn',optype='dif',longname="rate_of_change_2d_dyn (dAD-dBD)",outfld=.false.) + + call budget_add('rate_vert_remap','dAR','dAD',pkgtype='dyn',optype='dif',longname="rate_of_change_2d_dyn (dAR-dAD)",outfld=.false.) + + call budget_add('BD_dyn_adai','rate_2d_dyn','rate_vert_remap',pkgtype='dyn',optype='sum',longname="dE/dt total adiabatic dynamics (adiab=rate2ddyn+vremap) ",outfld=.true.) + + call budget_add('BD_dyn_2D','dAD','dBD',pkgtype='dyn',optype='dif',longname="dE/dt 2D dynamics (dAD-dBD)",outfld=.true.) + + call budget_add('BD_dyn_remap','dAR','dAD',pkgtype='dyn',optype='dif',longname="dE/dt vertical remapping (dAR-dAD)",outfld=.true.) + + call budget_add('BD_dyn_ptend','dBD','dAF',pkgtype='dyn',optype='dif',longname="dE/dt physics tendency in dynamics (dBD-dAF)",outfld=.true.) + + call budget_add('BD_dyn_hvis','dCH','dBH',pkgtype='dyn',optype='dif',longname="dE/dt hypervis del4 (dCH-dBH)",outfld=.true.) + + call budget_add('BD_dyn_fric','dAH','dCH',pkgtype='dyn',optype='dif',longname="dE/dt hypervis frictional heating del4 (dAH-dCH)",outfld=.true.) + + call budget_add('BD_dyn_difdel4tot','dAH','dBH',pkgtype='dyn',optype='dif',longname="dE/dt hypervis del4 total (dAH-dBH)",outfld=.true.) + + call budget_add('BD_dyn_sponge','dAS','dBS',pkgtype='dyn',optype='dif',longname="dE/dt hypervis sponge total (dAS-dBS)",outfld=.true.) + + call budget_add('BD_dyn_difftot','BD_dyn_difdel4tot','BD_dyn_sponge',pkgtype='dyn',optype='sum',longname="dE/dt explicit diffusion total (hvisdel4tot+hvisspngtot)",outfld=.true.) + + call budget_add('BD_dyn_res','BD_dyn_2D','BD_dyn_difftot',pkgtype='dyn',optype='dif',longname="dE/dt residual (2ddyn-expdifftot)",outfld=.true.) + + call budget_add('hrate','dAH','dCH',pkgtype='dyn',optype='dif',longname="rate of change heating term put back in (dAH-dCH)",outfld=.false.) + +! register history budget variables + do m=1,budget_num + if (budget_outfld(m)) then + call budget_info(m,name=budget_name,longname=budget_longname,pkgtype=budget_pkgtype) + + if (trim(budget_pkgtype)=='dyn') then + write(iulog,*)'adding field:',trim(budget_name),' index=',m,' tot=',budget_num + call addfld(trim(budget_name), horiz_only, 'A', 'W/m2', trim(budget_longname)) + endif + end if + end do + ! add dynamical core tracer tendency output ! if (ntrac>0) then @@ -954,14 +1012,6 @@ subroutine dyn_init(dyn_in, dyn_out) call add_default(tottnam(ixcldice), budget_hfile_num, ' ') end if - ! constituent indices for waccm-x - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - call cnst_get_ind('O', ixo) - call cnst_get_ind('O2', ixo2) - call cnst_get_ind('H', ixh) - call cnst_get_ind('H2', ixh2) - end if - call test_mapping_addfld end subroutine dyn_init @@ -970,7 +1020,7 @@ end subroutine dyn_init subroutine dyn_run(dyn_state) use physconst, only: thermodynamic_active_species_num, dry_air_species_num use physconst, only: thermodynamic_active_species_idx_dycore - use prim_advance_mod, only: calc_tot_energy_dynamics + use prim_advance_mod, only: calc_tot_energy_dynamics,calc_tot_energy_dynamics_diff use prim_driver_mod, only: prim_run_subcycle use dimensions_mod, only: cnst_name_gll use time_mod, only: tstep, nsplit, timelevel_qdp @@ -978,6 +1028,10 @@ subroutine dyn_run(dyn_state) use control_mod, only: qsplit, rsplit, ftype_conserve use thread_mod, only: horz_num_threads use time_mod, only: tevolve + use budgets, only: budget_cnt,budget_num, budget_info, & + budget_outfld,budget_count + use global_norms_mod, only: global_integral, wrap_repro_sum + use parallel_mod, only: global_shared_buf, global_shared_sum type(dyn_export_t), intent(inout) :: dyn_state @@ -991,11 +1045,18 @@ subroutine dyn_run(dyn_state) real(r8) :: ftmp(npsq,nlev,3) real(r8) :: dtime + real(r8) :: global_ave real(r8) :: rec2dt, pdel + real(r8), allocatable, dimension(:,:,:) :: tmp,tmptot,tmpse,tmpke,tmp1,tmp2 real(r8), allocatable, dimension(:,:,:) :: ps_before real(r8), allocatable, dimension(:,:,:) :: abs_ps_tend + real (kind=r8) :: omega_cn(2,nelemd) !min and max of vertical Courant number + integer :: is1,is2,is1b,is2b,budget_state_ind + character(len=64) :: budget_name ! budget names + character(len=3) :: budget_pkgtype ! budget type phy or dyn + character(len=3) :: budget_optype ! budget type phy or dyn !---------------------------------------------------------------------------- #ifdef debug_coupling @@ -1145,6 +1206,131 @@ subroutine dyn_run(dyn_state) ! output vars on CSLAM fvm grid call write_dyn_vars(dyn_state) + ! update energy budget differences + + do i=1,budget_num + call budget_info(i,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=budget_state_ind) + if (budget_pkgtype=='dyn'.and.(budget_optype=='dif'.or.budget_optype=='sum')) & + call calc_tot_energy_dynamics_diff(dyn_state%elem,dyn_state%fvm, nets, nete, TimeLevel%n0, n0_qdp,trim(budget_name)) + end do + +!!$ + allocate(tmp(np,np,nets:nete)) + allocate(tmptot(np,np,nets:nete)) + allocate(tmpse(np,np,nets:nete)) + allocate(tmpke(np,np,nets:nete)) + allocate(tmp1(np,np,nets:nete)) + allocate(tmp2(np,np,nets:nete)) + tmp=0._r8 + tmp1=0._r8 + tmp2=0._r8 + tmptot=0._r8 + tmpse=0._r8 + tmpke=0._r8 +!!$ do i=1,budget_num +!!$ call budget_info(i,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=budget_state_ind) +!!$ if (budget_pkgtype=='dyn') then +!!$ do ie=nets,nete +!!$ if (budget_optype=='stg') then +!!$ write(iulog,*)'outfld stage (already set in state) for ',budget_name +!!$ tmp(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,1,budget_state_ind) +!!$ else +!!$ call budget_info(i,istage1=is1, istage2=is2,istage1b=is1b,istage2b=is2b) +!!$ write(iulog,*)'calc budgets name:',budget_name,' optype:',budget_optype,' pkgtype:',budget_pkgtype,' cnt:',dyn_state%elem(ie)%derived%budget_cnt(budget_state_ind),'is1/is2/is1b/is2b:',is1,is2,is1b,is2b +!!$ if (dyn_state%elem(ie)%derived%budget_cnt(is1)==0.or.dyn_state%elem(ie)%derived%budget_cnt(is2)==0) then +!!$ write(iulog,*)'budget_cnt is 0 set tmp to zero, cnt(is1b),cnt(is2b) ',budget_name,dyn_state%elem(ie)%derived%budget_cnt(is1),dyn_state%elem(ie)%derived%budget_cnt(is2) +!!$ tmp(:,:,ie)=0._r8 +!!$ else +!!$ write(iulog,*)'preincrement cnt for: ',budget_name,' cnt:',dyn_state%elem(ie)%derived%budget_cnt(budget_state_ind),' i:',i +!!$ dyn_state%elem(ie)%derived%budget_cnt(budget_state_ind)=dyn_state%elem(ie)%derived%budget_cnt(budget_state_ind)+1 +!!$ write(iulog,*)'incrementing cnt for: ',budget_name,' cnt:',budget_cnt(i),' i:',i +!!$ ! tmp(:,:,ie)=(elem(ie)%derived%budget(:,:,1,is1)-elem(ie)%derived%budget(:,:,1,is2))/budget_cnt(is1)/dtime +!!$! tmp1(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,1,is1)/budget_count(is1b) +!!$! tmp2(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,1,is2)/budget_count(is2b) +!!$ tmp1(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,1,is1) +!!$ tmp2(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,1,is2) +!!$ if (budget_optype=='dif') then +!!$ write(iulog,*)'set difference for is1,is2,dyn_state_ind',is1,is2,budget_state_ind +!!$ tmp(:,:,ie)=(tmp1(:,:,ie)-tmp2(:,:,ie)) +!!$!jt tmp(:,:,ie)=(dyn_state%elem(ie)%derived%budget(:,:,1,is1)-dyn_state%elem(ie)%derived%budget(:,:,1,is2))/1/dtime +!!$ else if (budget_optype=='sum') then +!!$ write(iulog,*)'set sum for is1,is2,dyn_state_ind',is1,is2,budget_state_ind +!!$!jt tmp(:,:,ie)=(dyn_state%elem(ie)%derived%budget(:,:,1,is1)+dyn_state%elem(ie)%derived%budget(:,:,1,is2))/1/dtime +!!$ tmp(:,:,ie)=(tmp1(:,:,ie)+tmp2(:,:,ie)) +!!$ else +!!$ call endrun('dyn_readnl: ERROR: budget_optype unknown:'//budget_optype) +!!$ end if +!!$ dyn_state%elem(ie)%derived%budget(:,:,1,budget_state_ind)=tmp(:,:,ie) +!!$ end if +!!$ end if +!!$ +!!$!jt if (ie==nets) write(iulog,*)'calling outfld for name,pkgtype,budget_idx,tot=',budget_name,budget_pkgtype,budget_optype,i,budget_num +!!$!jt if (budget_outfld(i)) call outfld(trim(budget_name),RESHAPE(tmp(:,:,ie),(/npsq/)),npsq,ie) +!!$ end do +!!$ end if +!!$ end do + + ! output budget globals + + if (.true.) then + do i=1,budget_num + call budget_info(i,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=budget_state_ind) + if (budget_pkgtype=='dyn') then + ! Normalize energy sums and convert to W/s + write(iulog,*)budget_name,'norm cnt=',dyn_state%elem(nets)%derived%budget_cnt(budget_state_ind),'sub=',dyn_state%elem(nets)%derived%budget_subcycle(budget_state_ind) + do ie=nets,nete + tmp(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,1,budget_state_ind)/dyn_state%elem(ie)%derived%budget_cnt(budget_state_ind)/dtime + if (dyn_state%elem(nets)%derived%budget_subcycle(budget_state_ind).ne.0) then +! tmptot(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,1,budget_state_ind)/dyn_state%elem(ie)%derived%budget_subcycle(budget_state_ind) +! tmpse(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,2,budget_state_ind)/dyn_state%elem(ie)%derived%budget_subcycle(budget_state_ind) +! tmpke(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,3,budget_state_ind)/dyn_state%elem(ie)%derived%budget_subcycle(budget_state_ind) + tmptot(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,1,budget_state_ind) + tmpse(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,2,budget_state_ind) + tmpke(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,3,budget_state_ind) + end if + tmp1(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,2,budget_state_ind)/dyn_state%elem(ie)%derived%budget_cnt(budget_state_ind)/dtime + tmp2(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,3,budget_state_ind)/dyn_state%elem(ie)%derived%budget_cnt(budget_state_ind)/dtime + enddo + + global_ave = global_integral(dyn_state%elem, tmp(:,:,nets:nete),hybrid,np,nets,nete) + write(iulog,*)budget_name,' global average normalized cnt dtime=',global_ave,'cnt=',dyn_state%elem(nets)%derived%budget_cnt(budget_state_ind),'sub=',dyn_state%elem(nets)%derived%budget_subcycle(budget_state_ind) + global_ave = global_integral(dyn_state%elem, tmp1(:,:,nets:nete),hybrid,np,nets,nete) + write(iulog,*)budget_name,' global average se normalized cnt dtime=',global_ave,'state_ind=',budget_state_ind,'tot budget num=',i + global_ave = global_integral(dyn_state%elem, tmp2(:,:,nets:nete),hybrid,np,nets,nete) + write(iulog,*)budget_name,' global average ke normalized cnt dtime=',global_ave,'state_ind=',budget_state_ind,'tot budget num=',i + if (dyn_state%elem(nets)%derived%budget_subcycle(budget_state_ind).ne.0) then + global_ave = global_integral(dyn_state%elem, tmptot(:,:,nets:nete),hybrid,np,nets,nete) + write(iulog,*)budget_name,' global average se+ke sums=',global_ave + global_ave = global_integral(dyn_state%elem, tmpse(:,:,nets:nete),hybrid,np,nets,nete) + write(iulog,*)budget_name,' global average se sums=',global_ave + global_ave = global_integral(dyn_state%elem, tmpke(:,:,nets:nete),hybrid,np,nets,nete) + write(iulog,*)budget_name,' global average ke sums=',global_ave + end if + ! reset dyn budget states + ! reset budget counts - stage or diff budget will just be i. If difference must reset components of diff + do ie=nets,nete + dyn_state%elem(ie)%derived%budget(:,:,:,budget_state_ind)=0._r8 + dyn_state%elem(ie)%derived%budget_cnt(budget_state_ind)=0 + end do +!!$ if (budget_optype=='dif' .or. budget_optype=='sum') then +!!$ call budget_info(i,istage1=is1, istage2=is2) +!!$ do ie=nets,nete +!!$ if (ie==nets) write(iulog,*)'count for is1=',is1,' =',dyn_state%elem(ie)%derived%budget_cnt(is1),' is2=',is2,' =',dyn_state%elem(ie)%derived%budget_cnt(is2) +!!$ dyn_state%elem(ie)%derived%budget_cnt(is1)=0 +!!$ dyn_state%elem(ie)%derived%budget_cnt(is2)=0 +!!$ if (ie==nets) write(iulog,*)'reset count for is1=',is1,' =',dyn_state%elem(ie)%derived%budget_cnt(is1),' is2=',is2,' =',dyn_state%elem(ie)%derived%budget_cnt(is2) +!!$ end do +!!$ end if + end if + end do + end if + deallocate(tmp) + deallocate(tmptot) + deallocate(tmpse) + deallocate(tmpke) + deallocate(tmp1) + deallocate(tmp2) + end subroutine dyn_run !=============================================================================== diff --git a/src/dynamics/se/restart_dynamics.F90 b/src/dynamics/se/restart_dynamics.F90 index aa0c8ab37f..d3b1aa28fa 100644 --- a/src/dynamics/se/restart_dynamics.F90 +++ b/src/dynamics/se/restart_dynamics.F90 @@ -12,7 +12,7 @@ module restart_dynamics ! grid format may also be used for an initial run. use shr_kind_mod, only: r8 => shr_kind_r8 -use spmd_utils, only: iam +use spmd_utils, only: iam, masterproc use constituents, only: cnst_name use dyn_grid, only: timelevel, fvm, elem, edgebuf @@ -726,9 +726,9 @@ subroutine read_elem() call PIO_InitDecomp(pio_subsystem, pio_double, (/ncol,nlev/), ldof, iodesc3d) deallocate(ldof) - allocate(var3d(ncol*nlev), var2d(ncol)) + allocate(var2d(nelemd*np*np), stat=ierr) + if (ierr/=0) call endrun( sub//': not able to allocate var2d' ) var2d = 0._r8 - var3d = 0._r8 call pio_setframe(File, psdry_desc, t_idx) call pio_read_darray(File, psdry_desc, iodesc2d, var2d, ierr) @@ -743,6 +743,11 @@ subroutine read_elem() end do end do + deallocate(var2d) + allocate(var3d(nelemd*np*np*nlev), stat=ierr) + if (ierr/=0) call endrun( sub//': not able to allocate var3d' ) + var3d = 0._r8 + call pio_setframe(File, udesc, t_idx) call pio_read_darray(File, udesc, iodesc3d, var3d, ierr) call cam_pio_handle_error(ierr, sub//': reading U') @@ -805,7 +810,9 @@ subroutine read_elem() end do end do - deallocate(var3d, var2d) + deallocate(var3d) + + if (masterproc) write(iulog,*) sub//': completed successfully' end subroutine read_elem diff --git a/src/dynamics/se/stepon.F90 b/src/dynamics/se/stepon.F90 index bd5577f765..8edef919d4 100644 --- a/src/dynamics/se/stepon.F90 +++ b/src/dynamics/se/stepon.F90 @@ -122,6 +122,7 @@ subroutine stepon_run2(phys_state, phys_tend, dyn_in, dyn_out) use time_mod, only: TimeLevel_Qdp use control_mod, only: qsplit use prim_advance_mod, only: calc_tot_energy_dynamics + use cam_logfile, only: iulog ! arguments @@ -144,6 +145,7 @@ subroutine stepon_run2(phys_state, phys_tend, dyn_in, dyn_out) call t_stopf('p_d_coupling') if (iam < par%nprocs) then +!jt write(iulog,*)'calling calc with name dED' call calc_tot_energy_dynamics(dyn_in%elem,dyn_in%fvm, 1, nelemd, tl_f, tl_fQdp,'dED') end if diff --git a/src/physics/cam/budgets.F90 b/src/physics/cam/budgets.F90 deleted file mode 100644 index 5e1e7adbdc..0000000000 --- a/src/physics/cam/budgets.F90 +++ /dev/null @@ -1,411 +0,0 @@ - -module budgets - -! Metadata manager for the budgets. - -use shr_kind_mod, only: r8 => shr_kind_r8 -use shr_const_mod, only: shr_const_rgas -use spmd_utils, only: masterproc -use cam_abortutils, only: endrun -use cam_logfile, only: iulog - -implicit none -private -save - -! Public interfaces -public :: & - budget_stage_add, &! add a budget to the list of budgets - budget_diff_add, &! add a budget to the list of budgets - budget_num_avail, &! returns the number of available slots in the budget array - budget_get_ind, &! get the index of a budget - budget_chk_dim, &! check that number of budgets added equals dimensions (budget_array_max) - budget_name_byind, &! return name of a budget - budget_longname_byind, &! return longnamee of a budget - budget_type_byind, &! return stage or difference type of a budget - budget_info_byind, &! return stage or difference type of a budget - budget_outfld ! Returns true if default CAM output was specified in the budget_stage_add calls. - -! Public data - -integer, parameter, public :: budget_array_max = 30 ! number of budget diffs - -integer, public :: budget_cnt(budget_array_max) ! outfld this stage -integer, public :: budget_num = 0 ! -logical, public, protected :: budget_out(budget_array_max) ! outfld this stage -character(len=16), public, protected :: budget_name(budget_array_max) ! budget names -character(len=128),public, protected :: budget_longname(budget_array_max) ! long name of budgets -integer, public, protected :: budget_s1_ind(budget_array_max) -integer, public, protected :: budget_s2_ind(budget_array_max) -character(len=16), public, protected :: budget_s1name(budget_array_max) -character(len=16), public, protected :: budget_s2name(budget_array_max) - -! -! Constants for each budget - -!character*3, public, protected :: budget_type(budget_array_max)! stage or difference -character*3, public :: budget_type(budget_array_max)! stage or difference - -!++bee - temporary... These names should be declared in the module that makes the addfld and outfld calls. -! Lists of budget names and diagnostics -character(len=16), public :: physbudget (budget_array_max) ! budgets after physics (FV core only) -character(len=16), public :: dynbudget (budget_array_max) ! budgets before physics (FV core only) - -!============================================================================================== -CONTAINS -!============================================================================================== - -subroutine budget_readnl(nlfile) - - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_logical - - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr - character(len=*), parameter :: sub = 'budget_readnl' - - !----------------------------------------------------------------------------- - -!!$ if (masterproc) then -!!$ unitn = getunit() -!!$ open( unitn, file=trim(nlfile), status='old' ) -!!$ call find_group_name(unitn, 'budgets_nl', status=ierr) -!!$ if (ierr == 0) then -!!$ read(unitn, budgets_nl, iostat=ierr) -!!$ if (ierr /= 0) then -!!$ call endrun(sub//': FATAL: reading namelist') -!!$ end if -!!$ end if -!!$ close(unitn) -!!$ call freeunit(unitn) -!!$ end if - -!!$ if (masterproc) then -!!$ write(iulog,*)'Summary of budget module options:' -!!$ end if - -end subroutine budget_readnl - - -subroutine budget_stage_add (name, ind, longname, cam_outfld) - - ! Register a budget. - - character(len=*), intent(in) :: & - name ! budget name used as variable name in history file output (8 char max) - integer, intent(out) :: ind ! global budget index (in q array) - - character(len=*), intent(in), optional :: & - longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) - logical, intent(in), optional :: & - cam_outfld ! true => default CAM output of budget in kg/kg - - character(len=*), parameter :: sub='budget_stage_add' - character(len=128) :: errmsg - !----------------------------------------------------------------------- - - ! set budget index and check validity - budget_num = budget_num+1 - ind = budget_num - if (budget_num > budget_array_max) then - write(errmsg, *) sub//': FATAL: budget stage index greater than budget stage max=', budget_array_max - call endrun(errmsg) - end if - - ! set budget name and constants - budget_name(ind) = name - if (present(longname)) then - budget_longname(ind) = longname - else - budget_longname(ind) = name - end if - - ! set outfld type - ! (false: the module declaring the budget is responsible for outfld calls) - if (present(cam_outfld)) then - budget_out(ind) = cam_outfld - else - budget_out(ind) = .false. - end if - budget_type(ind)='stg' -end subroutine budget_stage_add - -!============================================================================== -subroutine budget_diff_add (name, istage1, istage2, longname, cam_outfld) - - ! Register a budget. - - character(len=*), intent(in) :: & - name ! budget name used as variable name in history file output (8 char max) - - integer, intent(in) :: istage1,istage2 ! global budget stage index (in te_budgets array) - - character(len=*), intent(in), optional :: & - longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) - - logical, intent(in), optional :: & - cam_outfld ! true => default CAM output of budget in kg/kg - - character(len=*), parameter :: sub='budget_diff_add' - character(len=128) :: errmsg - integer :: ind - !----------------------------------------------------------------------- - - ! set budget index and check validity - budget_num = budget_num+1 - ind = budget_num - if (budget_num > budget_array_max) then - write(errmsg, *) sub//': FATAL: budget diff index greater than budget_array_max=', budget_array_max - call endrun(errmsg) - end if - - ! set budget name and constants - budget_name(ind) = name - if (present(longname)) then - budget_longname(ind) = longname - else - budget_longname(ind) = name - end if - - budget_s1_ind(ind) = istage1 - budget_s2_ind(ind) = istage2 - budget_s1name(ind) = budget_name_byind(istage1) - budget_s2name(ind) = budget_name_byind(istage2) - - ! set outfld type - ! (false: the module declaring the budget is responsible for outfld calls) - if (present(cam_outfld)) then - budget_out(ind) = cam_outfld - else - budget_out(ind) = .false. - end if - budget_type(ind)='dif' - end subroutine budget_diff_add -!============================================================================== - -function budget_num_avail() - - ! return number of available slots in the budget array - - integer budget_num_avail - - budget_num_avail = budget_array_max - budget_num - -end function budget_num_avail - -!============================================================================================== - -character*3 function budget_type_byind(ind) - - ! Return the type of a budget stage or difference - - !-----------------------------Arguments--------------------------------- - integer, intent(in) :: ind ! global budget index (in te array) - - !---------------------------Local workspace----------------------------- - character(len=*), parameter :: sub='budget_type_byind' - character(len=128) :: errmsg - !----------------------------------------------------------------------- - if (ind > 0 .and. ind <= budget_array_max) then - budget_type_byind = budget_type(ind) - else - ! index out of range - write(errmsg,*) sub//': FATAL: bad value for budget index=', ind - call endrun(errmsg) - end if - -end function budget_type_byind - -!============================================================================================== - -subroutine budget_info_byind(ind, name, longname, stage1, istage1, stage2, istage2) - - ! Return the mixing ratio name of a budget - - !-----------------------------Arguments--------------------------------- - integer, intent(in) :: ind ! global budget index (in te array) - character(len=*), intent(out), optional :: & - name, &! budget name - longname, &! budget long_name - stage1, &! stage1 name value for difference budget - stage2 ! stage2 name value for difference budget - integer, intent(out), optional :: & - istage1, &! stage1 index for difference budget - istage2 ! stage2 index for difference budget - - !---------------------------Local workspace----------------------------- - character(len=*), parameter :: sub='budget_name_byind' - character(len=128) :: errmsg - !----------------------------------------------------------------------- - if (ind > 0 .and. ind <= budget_array_max) then - if (present(name)) name=budget_name(ind) - if (present(longname)) longname=budget_longname(ind) - if (present(stage1)) stage1=budget_s1name(ind) - if (present(stage2)) stage2=budget_s2name(ind) - if (present(istage1)) istage1=budget_s1_ind(ind) - if (present(istage2)) istage2=budget_s2_ind(ind) - else - ! index out of range - write(errmsg,*) sub//': FATAL: bad value for budget index=', ind - call endrun(errmsg) - end if - - - end subroutine budget_info_byind - -!============================================================================================== - -character*16 function budget_name_byind(ind) - - ! Return the mixing ratio name of a budget - - !-----------------------------Arguments--------------------------------- - integer, intent(in) :: ind ! global budget index (in te array) - !---------------------------Local workspace----------------------------- - character(len=*), parameter :: sub='budget_name_byind' - character(len=128) :: errmsg - !----------------------------------------------------------------------- - - if (ind > 0 .and. ind <= budget_array_max) then - budget_name_byind = budget_name(ind) - else - ! index out of range - write(errmsg,*) sub//': FATAL: bad value for budget index=', ind - call endrun(errmsg) - end if - -end function budget_name_byind - -!============================================================================================== - -character*128 function budget_longname_byind(ind) - - ! Return the mixing ratio name of a budget - - !-----------------------------Arguments--------------------------------- - integer, intent(in) :: ind ! global budget index (in te array) - - !---------------------------Local workspace----------------------------- - character(len=*), parameter :: sub='budget_name_byind' - character(len=128) :: errmsg - !----------------------------------------------------------------------- - - if (ind > 0 .and. ind <= budget_array_max) then - budget_longname_byind = budget_longname(ind) - else - ! index out of range - write(errmsg,*) sub//': FATAL: bad value for budget index=', ind - call endrun(errmsg) - end if - -end function budget_longname_byind - -!============================================================================== - -subroutine budget_get_ind (name, ind, abort) - - ! Get the index of a budget. Optional abort argument allows returning - ! control to caller when budget name is not found. Default behavior is - ! to call endrun when name is not found. - - !-----------------------------Arguments--------------------------------- - character(len=*), intent(in) :: name ! budget name - integer, intent(out) :: ind ! global budget index (in q array) - logical, optional, intent(in) :: abort ! optional flag controlling abort - - !---------------------------Local workspace----------------------------- - integer :: m ! budget index - logical :: abort_on_error - character(len=*), parameter :: sub='budget_get_ind' - !----------------------------------------------------------------------- - - ! Find budget name in list - do m = 1, budget_array_max - if (name == budget_name(m)) then - ind = m - return - end if - end do - - ! Unrecognized name - abort_on_error = .true. - if (present(abort)) abort_on_error = abort - - if (abort_on_error) then - write(iulog, *) sub//': FATAL: name:', name, ' not found in list:', budget_name(:) - call endrun(sub//': FATAL: name not found') - end if - - ! error return - ind = -1 - -end subroutine budget_get_ind - -!============================================================================== - - -subroutine budget_chk_dim - - ! Check that the number of registered budgets is budget_array_max - ! Write budget list to log file. - - integer :: i, m - character(len=*), parameter :: sub='budget_chk_dim' - character(len=128) :: errmsg - !----------------------------------------------------------------------- - - ! if (budget_num /= budget_array_max) then - ! write(errmsg, *) sub//': FATAL: number of added budgets (',budget_num, & - ! ') not equal to budget_array_max (', budget_array_max, ')' - ! call endrun (errmsg) - ! endif - - if (masterproc) then - write(iulog,*) 'Budget stages list:' - do i = 1, budget_num - write(iulog,'(2x,i4,2x,a8,2x,a128)') i, budget_name(i), budget_longname(i) - end do - write(iulog,*) 'Budgets list:' - do i = 1, budget_num - write(iulog,'(2x,i4,2x,a8,2x,a128)') i, budget_name(i), budget_longname(i) - end do - end if - - ! ! Set names of physics and dynamics budget - ! do m=1,budget_array_max - ! physbudget (m) = trim(budget_name(m))//'AP' - ! dynbudget (m) = trim(budget_name(m))//'BP' - ! end do - -end subroutine budget_chk_dim - -function budget_outfld(m) - - ! Query whether default CAM outfld calls should be made. - - !----------------------------------------------------------------------- - integer, intent(in) :: m ! budget index - - logical :: budget_outfld ! true => use default CAM outfld calls - - character(len=*), parameter :: sub='budget_outfld' - character(len=128) :: errmsg - !----------------------------------------------------------------------- - - if (m > 0 .and. m <= budget_array_max) then - budget_outfld = budget_out(m) - else - ! index out of range - write(errmsg,*) sub//': FATAL: bad value for budget diff index=', m - call endrun(errmsg) - end if - - end function budget_outfld - -!============================================================================== - -end module budgets diff --git a/src/physics/cam/cam_diagnostics.F90 b/src/physics/cam/cam_diagnostics.F90 index 08d312854c..9714beddf3 100644 --- a/src/physics/cam/cam_diagnostics.F90 +++ b/src/physics/cam/cam_diagnostics.F90 @@ -14,7 +14,7 @@ module cam_diagnostics use cam_history, only: outfld, write_inithist, hist_fld_active, inithist_all use constituents, only: pcnst, cnst_name, cnst_longname, cnst_cam_outfld -use constituents, only: ptendnam, dmetendnam, apcnst, bpcnst, cnst_get_ind +use constituents, only: ptendnam, apcnst, bpcnst, cnst_get_ind use dycore, only: dycore_is use phys_control, only: phys_getopts use wv_saturation, only: qsat, qsat_water, svp_ice_vect @@ -242,7 +242,7 @@ subroutine diag_init_dry(pbuf2d) call register_vector_field('UAP','VAP') call addfld (apcnst(1), (/ 'lev' /), 'A','kg/kg', trim(cnst_longname(1))//' (after physics)') - if ( dycore_is('LR') .or. dycore_is('SE') .or. dycore_is('FV3') ) then + if (.not.dycore_is('EUL')) then call addfld ('TFIX', horiz_only, 'A', 'K/s', 'T fixer (T equivalent of Energy correction)') end if call addfld ('TTEND_TOT', (/ 'lev' /), 'A', 'K/s', 'Total temperature tendency') @@ -386,7 +386,7 @@ subroutine diag_init_dry(pbuf2d) call add_default ('UAP ' , history_budget_histfile_num, ' ') call add_default ('VAP ' , history_budget_histfile_num, ' ') call add_default (apcnst(1) , history_budget_histfile_num, ' ') - if ( dycore_is('LR') .or. dycore_is('SE') .or. dycore_is('FV3') ) then + if (.not. dycore_is('EUL')) then call add_default ('TFIX ' , history_budget_histfile_num, ' ') end if end if @@ -543,18 +543,6 @@ subroutine diag_init_moist(pbuf2d) if (ixcldice > 0) then call addfld (ptendnam(ixcldice),(/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name(ixcldice))//' total physics tendency ') end if - if ( dycore_is('LR') .or. dycore_is('FV3') )then - call addfld (dmetendnam( 1),(/ 'lev' /), 'A','kg/kg/s', & - trim(cnst_name( 1))//' dme adjustment tendency (FV) ') - if (ixcldliq > 0) then - call addfld (dmetendnam(ixcldliq),(/ 'lev' /), 'A','kg/kg/s', & - trim(cnst_name(ixcldliq))//' dme adjustment tendency (FV) ') - end if - if (ixcldice > 0) then - call addfld (dmetendnam(ixcldice),(/ 'lev' /), 'A','kg/kg/s', & - trim(cnst_name(ixcldice))//' dme adjustment tendency (FV) ') - end if - end if ! outfld calls in diag_physvar_ic @@ -645,15 +633,6 @@ subroutine diag_init_moist(pbuf2d) if (ixcldice > 0) then call add_default (ptendnam(ixcldice), history_budget_histfile_num, ' ') end if - if ( dycore_is('LR') .or. dycore_is('FV3') )then - call add_default(dmetendnam(1) , history_budget_histfile_num, ' ') - if (ixcldliq > 0) then - call add_default(dmetendnam(ixcldliq), history_budget_histfile_num, ' ') - end if - if (ixcldice > 0) then - call add_default(dmetendnam(ixcldice), history_budget_histfile_num, ' ') - end if - end if if( history_budget_histfile_num > 1 ) then call add_default ('DTCOND ' , history_budget_histfile_num, ' ') end if @@ -2075,7 +2054,7 @@ subroutine diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt) ! Total physics tendency for Temperature ! (remove global fixer tendency from total for FV and SE dycores) - if (dycore_is('LR') .or. dycore_is('SE') .or. dycore_is('FV3') ) then + if (.not. dycore_is('EUL')) then call check_energy_get_integrals( heat_glob_out=heat_glob ) ftem2(:ncol) = heat_glob/cpair call outfld('TFIX', ftem2, pcols, lchnk ) @@ -2115,7 +2094,7 @@ end subroutine diag_phys_tend_writeout_dry !####################################################################### subroutine diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, & - tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini) + qini, cldliqini, cldiceini) !--------------------------------------------------------------- ! @@ -2130,9 +2109,6 @@ subroutine diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, & type(physics_buffer_desc), pointer :: pbuf(:) type(physics_tend ), intent(in) :: tend real(r8), intent(in) :: ztodt ! physics timestep - real(r8), intent(inout) :: tmp_q (pcols,pver) ! As input, holds pre-adjusted tracers (FV) - real(r8), intent(inout) :: tmp_cldliq(pcols,pver) ! As input, holds pre-adjusted tracers (FV) - real(r8), intent(inout) :: tmp_cldice(pcols,pver) ! As input, holds pre-adjusted tracers (FV) real(r8), intent(in) :: qini (pcols,pver) ! tracer fields at beginning of physics real(r8), intent(in) :: cldliqini (pcols,pver) ! tracer fields at beginning of physics real(r8), intent(in) :: cldiceini (pcols,pver) ! tracer fields at beginning of physics @@ -2165,35 +2141,6 @@ subroutine diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, & end if end if - ! Tendency for dry mass adjustment of q (FV only) - - if (dycore_is('LR') .or. dycore_is('FV3') ) then - tmp_q (:ncol,:pver) = (state%q(:ncol,:pver, 1) - tmp_q (:ncol,:pver))*rtdt - if (ixcldliq > 0) then - tmp_cldliq(:ncol,:pver) = (state%q(:ncol,:pver,ixcldliq) - tmp_cldliq(:ncol,:pver))*rtdt - else - tmp_cldliq(:ncol,:pver) = 0.0_r8 - end if - if (ixcldice > 0) then - tmp_cldice(:ncol,:pver) = (state%q(:ncol,:pver,ixcldice) - tmp_cldice(:ncol,:pver))*rtdt - else - tmp_cldice(:ncol,:pver) = 0.0_r8 - end if - if ( cnst_cam_outfld( 1) ) then - call outfld (dmetendnam( 1), tmp_q , pcols, lchnk) - end if - if (ixcldliq > 0) then - if ( cnst_cam_outfld(ixcldliq) ) then - call outfld (dmetendnam(ixcldliq), tmp_cldliq, pcols, lchnk) - end if - end if - if (ixcldice > 0) then - if ( cnst_cam_outfld(ixcldice) ) then - call outfld (dmetendnam(ixcldice), tmp_cldice, pcols, lchnk) - end if - end if - end if - ! Total physics tendency for moisture and other tracers if ( cnst_cam_outfld( 1) ) then @@ -2217,8 +2164,7 @@ end subroutine diag_phys_tend_writeout_moist !####################################################################### - subroutine diag_phys_tend_writeout(state, pbuf, tend, ztodt, & - tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini) + subroutine diag_phys_tend_writeout(state, pbuf, tend, ztodt, qini, cldliqini, cldiceini) !--------------------------------------------------------------- ! @@ -2233,9 +2179,6 @@ subroutine diag_phys_tend_writeout(state, pbuf, tend, ztodt, & type(physics_buffer_desc), pointer :: pbuf(:) type(physics_tend ), intent(in) :: tend real(r8), intent(in) :: ztodt ! physics timestep - real(r8) , intent(inout) :: tmp_q (pcols,pver) ! As input, holds pre-adjusted tracers (FV) - real(r8), intent(inout) :: tmp_cldliq(pcols,pver) ! As input, holds pre-adjusted tracers (FV) - real(r8), intent(inout) :: tmp_cldice(pcols,pver) ! As input, holds pre-adjusted tracers (FV) real(r8), intent(in) :: qini (pcols,pver) ! tracer fields at beginning of physics real(r8), intent(in) :: cldliqini (pcols,pver) ! tracer fields at beginning of physics real(r8), intent(in) :: cldiceini (pcols,pver) ! tracer fields at beginning of physics @@ -2245,7 +2188,7 @@ subroutine diag_phys_tend_writeout(state, pbuf, tend, ztodt, & call diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt) if (moist_physics) then call diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, & - tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini) + qini, cldliqini, cldiceini) end if end subroutine diag_phys_tend_writeout diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 0c7138730c..7d71e5beb7 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -183,7 +183,7 @@ subroutine check_energy_init() !----------------------------------------------------------------------- use cam_history, only: addfld, add_default, horiz_only use phys_control, only: phys_getopts - use budgets, only: budget_num, budget_outfld, budget_info_byind + use budgets, only: budget_num, budget_outfld, budget_info implicit none @@ -191,6 +191,7 @@ subroutine check_energy_init() integer :: history_budget_histfile_num ! output history file number for budget fields integer :: m ! budget array index into te_budgets character(len=16):: budget_name ! budget names + character(len=3) :: budget_pkgtype ! budget type phy or dyn character(len=128):: budget_longname ! long name of budgets !----------------------------------------------------------------------- @@ -215,8 +216,12 @@ subroutine check_energy_init() ! register history budget variables do m=1,budget_num if (budget_outfld(m)) then - call budget_info_byind(m,name=budget_name,longname=budget_longname) - call addfld(trim(budget_name), horiz_only, 'A', 'W/m2', trim(budget_longname)) + call budget_info(m,name=budget_name,longname=budget_longname,pkgtype=budget_pkgtype) +!jt write(iulog,*)'looking at field:',trim(budget_name),' index=',m,' tot=',budget_num,' pkgtype=',budget_pkgtype + if (trim(budget_pkgtype)=='phy') then +!jt write(iulog,*)'adding field:',trim(budget_name),' index=',m,' tot=',budget_num + call addfld(trim(budget_name), horiz_only, 'A', 'W/m2', trim(budget_longname)) + endif end if end do !!$ call addfld('BP_phy_params', horiz_only, 'A', 'W/m2', 'dE/dt CAM physics parameterizations (phAP-phBP)') @@ -582,8 +587,10 @@ subroutine check_energy_budget(state, dtime, nstep) use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_chunk use dyn_tests_utils, only: vc_dycore, vc_height use physics_types, only: phys_te_idx, dyn_te_idx - use budgets, only: budget_cnt,budget_num, budget_get_ind, budget_info_byind, & - budget_type_byind, budget_outfld + use budgets, only: budget_num, budget_info, & + budget_type_byind, budget_outfld, budget_num_phy, & + budget_cnt_adjust + use cam_abortutils, only: endrun !----------------------------------------------------------------------- ! Compute global mean total energy of physics input and output states ! computed consistently with dynamical core vertical coordinate @@ -591,7 +598,7 @@ subroutine check_energy_budget(state, dtime, nstep) !----------------------------------------------------------------------- !------------------------------Arguments-------------------------------- - type(physics_state), intent(in ), dimension(begchunk:endchunk) :: state + type(physics_state), intent(inout ), dimension(begchunk:endchunk) :: state real(r8), intent(in) :: dtime ! physics time step integer , intent(in) :: nstep ! current timestep number @@ -600,53 +607,100 @@ subroutine check_energy_budget(state, dtime, nstep) integer :: ncol ! number of active columns integer :: lchnk ! chunk index - real(r8) :: te(pcols,begchunk:endchunk,budget_num) - ! total energy of input/output states (copy) - real(r8) :: te_glob(budget_num) ! global means of total energy +!jt real(r8),allocatable :: te(pcols,begchunk:endchunk,budget_num_phy) + real(r8),allocatable :: te(:,:,:) ! total energy of input/output states (copy) +!jt real(r8),allocatable :: te_glob(budget_num_phy) ! global means of total energy + real(r8),allocatable :: te_glob(:) ! global means of total energy real(r8) :: phparam,dyparam,phpwork,dypwork,phefix,dyefix,phphys,dyphys - integer :: i,ind,is1,is2 + integer :: i,ii,ind,is1,is2,is1b,is2b character*16 :: budget_name ! parameterization name for fluxes + character*3 :: budget_pkgtype ! parameterization type phy or dyn + character*3 :: budget_optype ! dif or stg !----------------------------------------------------------------------- + if (.not.allocated (te)) then + allocate( te(pcols,begchunk:endchunk,budget_num_phy)) +!jt write(iulog,*)'shape te=',shape(te),budget_num_phy + end if + if (.not.allocated (te_glob)) then + allocate( te_glob(budget_num_phy)) +!jt write(iulog,*)'shape te_glob=',shape(te_glob) + else + write(iulog,*)'no alloc call shape te_glob=',shape(te_glob) + end if + te=0.0_r8 + te_glob=0.0_r8 + ! calculate energy budget differences do lchnk = begchunk, endchunk ncol = state(lchnk)%ncol - do i=1,budget_num - if (budget_type_byind(i)=='dif') then - call budget_info_byind(i,name=budget_name, istage1=is1, istage2=is2) - if (budget_cnt(is1)==0.or.budget_cnt(is2)==0) then - te(:,lchnk,i)=0._r8 - else - te(:,lchnk,i) = (state(lchnk)%te_budgets(:,1,is1)-state(lchnk)%te_budgets(:,1,is2))/budget_cnt(is1)/dtime + do ii=1,budget_num + call budget_info(ii,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=i) + if (budget_pkgtype=='phy') then + if (budget_optype=='dif') then + call budget_info(ii,stg1stateidx=is1, stg2stateidx=is2,stg1index=is1b,stg2index=is2b) + if (state(lchnk)%budget_cnt(is1b).ne.state(lchnk)%budget_cnt(is2b)) then + write(iulog,*)'budget_cnt mismatch stage1=',state(lchnk)%budget_cnt(is1b),'stage2=',state(lchnk)%budget_cnt(is2b) + call endrun() + end if + if (state(lchnk)%budget_cnt(is1b)==0.or.state(lchnk)%budget_cnt(is2b)==0) then + te(:,lchnk,i)=0._r8 + else + write(iulog,*)'calculating budget differences for ',budget_name,' ',budget_pkgtype,' ',budget_optype,' te i=',i,' of ',budget_num_phy,' state_ind=',i,' budget_cnt(is1b)=',state(lchnk)%budget_cnt(is1b),' dtime=',dtime,' is1b/is2b=',is1b,'/',is2b + te(:,lchnk,i) = (state(lchnk)%te_budgets(:,1,is1)-state(lchnk)%te_budgets(:,1,is2))/state(lchnk)%budget_cnt(is1b)/dtime + end if + else if (budget_optype=='sum') then + call budget_info(ii,stg1stateidx=is1, stg2stateidx=is2,stg1index=is1b,stg2index=is2b) + if (state(lchnk)%budget_cnt(is1b).ne.state(lchnk)%budget_cnt(is2b)) then + write(iulog,*)'budget_cnt mismatch stage1=',state(lchnk)%budget_cnt(is1b),'stage2=',state(lchnk)%budget_cnt(is2b) + call endrun() + end if + if (state(lchnk)%budget_cnt(is1b)==0.or.state(lchnk)%budget_cnt(is2b)==0) then + te(:,lchnk,i)=0._r8 + else + write(iulog,*)'calculating budget sums for ',budget_name,' ',budget_pkgtype,' ',budget_optype,' te i=',i,' of ',budget_num_phy,' state_ind=',i,' budget_cnt(is1b)=',state(lchnk)%budget_cnt(is1b),' dtime=',dtime,' is1b/is2b=',is1b,'/',is2b + te(:,lchnk,i) = (state(lchnk)%te_budgets(:,1,is1)+state(lchnk)%te_budgets(:,1,is2))/state(lchnk)%budget_cnt(is1b)/dtime + end if + else + write(iulog,*)'setting te for stage ',budget_name,' ',budget_pkgtype,' ',budget_optype,' te i=',i,' of ',budget_num_phy,' state_ind=',i,' dtime=',dtime + te(:,lchnk,i)=state(lchnk)%te_budgets(:,1,i) end if - else - call budget_info_byind(i,name=budget_name) - te(:,lchnk,i)=0._r8 +!jt if (lchnk==begchunk) write(iulog,*)'calling outfld for lchnk,name,pkgtype,budget_idx,tot=',lchnk,budget_name,budget_pkgtype,budget_optype,i,budget_num + if (budget_outfld(i).and.budget_pkgtype=='phy') call outfld(trim(budget_name), te(:ncol,lchnk,i), pcols, lchnk) end if - if (budget_outfld(i)) call outfld(trim(budget_name), te(:ncol,lchnk,i), pcols, lchnk) end do end do - write(iulog,*)'done with te loop, next looking at te array values for 1,2,9,10,15,16' - - ! Compute global means of input and output energies and of + ! Compute global means of input and output energies and of ! surface pressure for heating rate (assume uniform ptop) - call gmean(te, te_glob, budget_num) + call gmean(te, te_glob, budget_num_phy) + + do ii=1,budget_num + call budget_info(ii,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=i) + if (budget_pkgtype=='phy') then + write(iulog,*)'global tot for ',budget_name,':',te_glob(i),'b4budget_cnt_incr',state(begchunk)%budget_cnt(ii) +!jt call budget_cnt_adjust(ii,reset=.true.) + do lchnk = begchunk, endchunk + state(lchnk)%budget_cnt(ii)=0 + end do + write(iulog,*)'afbudget_cnt_incr',state(begchunk)%budget_cnt(ii) + end if + end do if (begchunk .le. endchunk) then - call budget_get_ind('BD_phy_params',ind, .true.) + call budget_info('BD_phy_params',state_ind=ind) dyparam = te_glob(ind) - call budget_get_ind('BP_phy_params',ind, .true.) + call budget_info('BP_phy_params',state_ind=ind) phparam = te_glob(ind) - call budget_get_ind('BD_pwork',ind, .true.) + call budget_info('BD_pwork',state_ind=ind) dypwork = te_glob(ind) - call budget_get_ind('BP_pwork',ind, .true.) + call budget_info('BP_pwork',state_ind=ind) phpwork = te_glob(ind) - call budget_get_ind('BD_efix',ind, .true.) + call budget_info('BD_efix',state_ind=ind) dyefix = te_glob(ind) - call budget_get_ind('BP_efix',ind, .true.) + call budget_info('BP_efix',state_ind=ind) phefix = te_glob(ind) - call budget_get_ind('BD_phys_tot',ind, .true.) + call budget_info('BD_phys_tot',state_ind=ind) dyphys = te_glob(ind) - call budget_get_ind('BP_phys_tot',ind, .true.) + call budget_info('BP_phys_tot',state_ind=ind) phphys = te_glob(ind) if (masterproc) then write(iulog,'(1x,a,1x,4(1x,e25.17))') "nstep, phys param,pwork,efix,phys", phparam, phpwork, phefix, phphys @@ -911,7 +965,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix, vc) use cam_history, only: hist_fld_active, outfld use dyn_tests_utils, only: vc_physics, vc_height use cam_abortutils, only: endrun - use budgets, only: budget_cnt, budget_get_ind + use budgets, only: budget_cnt_adjust, budget_info !------------------------------Arguments-------------------------------- type(physics_state), intent(inout) :: state @@ -937,7 +991,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix, vc) integer :: ncol ! number of atmospheric columns integer :: i,k ! column, level indices integer :: vc_loc ! local vertical coordinate variable - integer :: ind ! budget array index + integer :: ind,budget_ind ! budget array index integer :: ixtt ! test tracer index character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 !----------------------------------------------------------------------- @@ -955,7 +1009,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix, vc) lchnk = state%lchnk ncol = state%ncol - call budget_get_ind(trim(outfld_name_suffix),ind) + call budget_info(trim(outfld_name_suffix),budget_ind=budget_ind,state_ind=ind) if (present(vc)) then vc_loc = vc @@ -990,11 +1044,11 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix, vc) vc_loc, ps = state%ps(1:ncol), phis = state%phis(1:ncol), & z = state%z_ini(1:ncol,:), se = se, ke = ke, wv = wv, liq = liq, ice = ice) - call cnst_get_ind('TT_LW' , ixtt , abort=.false.) + call cnst_get_ind('TT_UN' , ixtt , abort=.false.) tt = 0._r8 if (ixtt > 1) then - if (name_out6 == 'TT_pAM'.or.name_out6 == 'TT_zAM') then + if (name_out6 == 'TT_phAM'.or.name_out6 == 'TT_dyAM') then ! ! after dme_adjust mixing ratios are all wet ! @@ -1021,8 +1075,9 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix, vc) state%te_budgets(1:ncol,5,ind)=liq(1:ncol) state%te_budgets(1:ncol,6,ind)=ice(1:ncol) state%te_budgets(1:ncol,7,ind)=tt(1:ncol) - budget_cnt(ind) = 1 - + state%budget_cnt(ind)=state%budget_cnt(ind)+1 +!jt call budget_cnt_adjust(budget_ind) + write(iulog,*)'incr count for ',outfld_name_suffix,' count=',state%budget_cnt(ind) ! Output energy diagnostics call outfld(name_out1 ,se , pcols ,lchnk ) diff --git a/src/physics/cam/constituents.F90 b/src/physics/cam/constituents.F90 index 528f254497..404bbcec24 100644 --- a/src/physics/cam/constituents.F90 +++ b/src/physics/cam/constituents.F90 @@ -72,7 +72,6 @@ module constituents character(len=16), public :: fixcnam (pcnst) ! names of species slt fixer tendencies character(len=16), public :: tendnam (pcnst) ! names of total tendencies of species character(len=16), public :: ptendnam (pcnst) ! names of total physics tendencies of species -character(len=16), public :: dmetendnam(pcnst) ! names of dme adjusted tracers (FV) character(len=16), public :: sflxnam (pcnst) ! names of surface fluxes of species character(len=16), public :: tottnam (pcnst) ! names for horz + vert + fixer tendencies @@ -497,7 +496,6 @@ subroutine cnst_chk_dim fixcnam (m) = 'DF'//cnst_name(m) tendnam (m) = 'TE'//cnst_name(m) ptendnam (m) = 'PTE'//cnst_name(m) - dmetendnam(m) = 'DME'//cnst_name(m) tottnam (m) = 'TA'//cnst_name(m) sflxnam(m) = 'SF'//cnst_name(m) end do diff --git a/src/physics/cam/physics_types.F90 b/src/physics/cam/physics_types.F90 index 8c2240d41d..721c6b50e6 100644 --- a/src/physics/cam/physics_types.F90 +++ b/src/physics/cam/physics_types.F90 @@ -111,6 +111,7 @@ module physics_types z_ini ! Height of initial state (used for energy computations) real(r8), dimension(:,:,:),allocatable :: & te_budgets ! te budget array + integer, allocatable :: budget_cnt(:) ! budget counter integer :: count ! count of values with significant energy or water imbalances integer, dimension(:),allocatable :: & latmapback, &! map from column to unique lat for that column @@ -603,6 +604,11 @@ subroutine physics_state_check(state, name) varname="state%te_budgets ("//trim(budget_name(m))//")", msg=msg) end do + do m = 1,budget_array_max + call shr_assert_in_domain(state%budget_cnt(m), is_nan=.false., & + varname="state%budget_cnt ("//trim(budget_name(m))//")", msg=msg) + end do + ! Now run other checks (i.e. values are finite and within a range that ! is physically meaningful). @@ -1155,7 +1161,7 @@ subroutine init_geo_unique(phys_state,ncol) end subroutine init_geo_unique !=============================================================================== - subroutine physics_dme_adjust(state, tend, qini, dt) + subroutine physics_dme_adjust(state, tend, fdq3d,dt) !----------------------------------------------------------------------- ! ! Purpose: Adjust the dry mass in each layer back to the value of physics input state @@ -1186,7 +1192,7 @@ subroutine physics_dme_adjust(state, tend, qini, dt) ! type(physics_state), intent(inout) :: state type(physics_tend ), intent(inout) :: tend - real(r8), intent(in ) :: qini(pcols,pver) ! initial specific humidity + real(r8), intent(in ) :: fdq3d(pcols,pver) ! water increment real(r8), intent(in ) :: dt ! model physics timestep ! !---------------------------Local workspace----------------------------- @@ -1199,7 +1205,7 @@ subroutine physics_dme_adjust(state, tend, qini, dt) real(r8) :: utmp(pcols) ! temp variable for recalculating the initial u values real(r8) :: vtmp(pcols) ! temp variable for recalculating the initial v values - real(r8) :: zvirv(pcols,pver) ! Local zvir array pointer + real(r8) :: zvirv(pcols,pver) ! Local zvir array pointer real(r8),allocatable :: cpairv_loc(:,:) ! @@ -1219,10 +1225,8 @@ subroutine physics_dme_adjust(state, tend, qini, dt) ! constituents, momentum, and total energy state%ps(:ncol) = state%pint(:ncol,1) do k = 1, pver - - ! adjusment factor is just change in water vapor - fdq(:ncol) = 1._r8 + state%q(:ncol,k,1) - qini(:ncol,k) - + ! adjusment factor is change in thermodynamically active water species + fdq(:ncol) = 1._r8 + fdq3d(:ncol,k) ! adjust constituents to conserve mass in each layer do m = 1, pcnst state%q(:ncol,k,m) = state%q(:ncol,k,m) / fdq(:ncol) @@ -1392,6 +1396,10 @@ subroutine physics_state_copy(state_in, state_out) end do end do + do m = 1, budget_array_max + state_out%budget_cnt(m) = state_in%budget_cnt(m) + end do + end subroutine physics_state_copy !=============================================================================== @@ -1602,6 +1610,9 @@ subroutine physics_state_alloc(state,lchnk,psetcols) allocate(state%te_budgets(psetcols,7,budget_array_max), stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%te_budgets') + allocate(state%budget_cnt(budget_array_max), stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%budget_cnt') + allocate(state%pint(psetcols,pver+1), stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%pint') @@ -1668,6 +1679,7 @@ subroutine physics_state_alloc(state,lchnk,psetcols) state%zm(:,:) = inf state%q(:,:,:) = inf state%te_budgets(:,:,:) = inf + state%budget_cnt(:) = 0 state%pint(:,:) = inf state%pintdry(:,:) = inf @@ -1795,6 +1807,12 @@ subroutine physics_state_dealloc(state) deallocate(state%z_ini, stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%z_ini') + deallocate(state%te_budgets, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%te_budgets') + + deallocate(state%budget_cnt, stat=ierr) + if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%budget_cnt') + deallocate(state%latmapback, stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%latmapback') diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 4a2eab5a33..b8604924af 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -72,8 +72,8 @@ module physpkg integer :: sgh30_idx = 0 integer :: qini_idx = 0 - integer :: cldliqini_idx = 0 - integer :: cldiceini_idx = 0 + integer :: liqini_idx = 0 + integer :: iceini_idx = 0 integer :: prec_str_idx = 0 integer :: snow_str_idx = 0 @@ -89,16 +89,6 @@ module physpkg integer :: ducore_idx = 0 ! ducore index in physics buffer integer :: dvcore_idx = 0 ! dvcore index in physics buffer -! Budget indexes - integer :: iphap = 0 ! budget index in budget meta data structure - integer :: idyap = 0 ! budget index in budget meta data structure - integer :: iphbp = 0 ! budget index in budget meta data structure - integer :: idybp = 0 ! budget index in budget meta data structure - integer :: iphbf = 0 ! budget index in budget meta data structure - integer :: idybf = 0 ! budget index in budget meta data structure - integer :: ipham = 0 ! budget index in budget meta data structure - integer :: idyam = 0 ! budget index in budget meta data structure - !======================================================================= contains !======================================================================= @@ -162,7 +152,7 @@ subroutine phys_register use dyn_comp, only: dyn_register use spcam_drivers, only: spcam_register use offline_driver, only: offline_driver_reg - use budgets, only: budget_stage_add, budget_diff_add + use budgets, only: budget_add !---------------------------Local variables----------------------------- ! @@ -193,24 +183,34 @@ subroutine phys_register call subcol_register() ! Register stages for budgets. - call budget_stage_add('phAP',iphap,'vertically integrated phys energy after physics',.true.) - call budget_stage_add('dyAP',idyap,'vertically integrated dyn energy after physics',.true.) - call budget_stage_add('phBP',iphbp,'vertically integrated phys energy before physics',.true.) - call budget_stage_add('dyBP',idybp,'vertically integrated dyn energy before physics',.true.) - call budget_stage_add('phBF',iphbf,'vertically integrated phys energy before fixer',.true.) - call budget_stage_add('dyBF',idybf,'vertically integrated dyn energy before fixer',.true.) - call budget_stage_add('phAM',ipham,'vertically integrated phys energy after dry mass adj',.true.) - call budget_stage_add('dyAM',idyam,'vertically integrated dyn energy after dry mass adj',.true.) + call budget_add('phAP','phy',longname='vertically integrated phys energy after physics',outfld=.true.) + call budget_add('dyAP','phy',longname='vertically integrated dyn energy after physics',outfld=.true.) + call budget_add('phBP','phy',longname='vertically integrated phys energy before physics',outfld=.true.) + call budget_add('dyBP','phy',longname='vertically integrated dyn energy before physics',outfld=.true.) + call budget_add('phBF','phy',longname='vertically integrated phys energy before fixer',outfld=.true.) + call budget_add('dyBF','phy',longname='vertically integrated dyn energy before fixer',outfld=.true.) + call budget_add('phAM','phy',longname='vertically integrated phys energy after dry mass adj',outfld=.true.) + call budget_add('dyAM','phy',longname='vertically integrated dyn energy after dry mass adj',outfld=.true.) + + ! Register budgets. +!!$ call budget_add('BP_phy_params',iphAP,iphBP,'phy','dif',longname='dE/dt CAM physics parameterizations (phAP-phBP)',outfld=.true.) +!!$ call budget_add('BD_phy_params',idyAP,idyBP,'phy','dif',longname='dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)',outfld=.true.) +!!$ call budget_add('BP_pwork',iphAM,iphAP,'phy','dif',longname='dE/dt dry mass adjustment (phAM-phAP)',outfld=.true.) +!!$ call budget_add('BD_pwork',idyAM,idyAP,'phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)',outfld=.true.) +!!$ call budget_add('BP_efix',iphBP,iphBF,'phy','dif',longname='dE/dt energy fixer (phBP-phBF)',outfld=.true.) +!!$ call budget_add('BD_efix',idyBP,idyBF,'phy','dif',longname='dE/dt energy fixer using dycore E (dyBP-dyBF)',outfld=.true.) +!!$ call budget_add('BP_phys_tot',iphAM,iphBF,'phy','dif',longname='dE/dt physics total (phAM-phBF)',outfld=.true.) +!!$ call budget_add('BD_phys_tot',idyAM,idyBF,'phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)',outfld=.true.) ! Register budgets. - call budget_diff_add('BP_phy_params', iphAP,iphBP,'dE/dt CAM physics parameterizations (phAP-phBP)',.true.) - call budget_diff_add('BD_phy_params', idyAP,idyBP,'dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)',.true.) - call budget_diff_add('BP_pwork',iphAM,iphAP,'dE/dt dry mass adjustment (phAM-phAP)',.true.) - call budget_diff_add('BD_pwork', idyAM,idyAP,'dE/dt dry mass adjustment using dycore E (dyAM-dyAP)',.true.) - call budget_diff_add('BP_efix', iphBP,iphBF,'dE/dt energy fixer (phBP-phBF)',.true.) - call budget_diff_add('BD_efix', idyBP,idyBF, 'dE/dt energy fixer using dycore E (dyBP-dyBF)',.true.) - call budget_diff_add('BP_phys_tot', iphAM,iphBF, 'dE/dt physics total (phAM-phBF)',.true.) - call budget_diff_add('BD_phys_tot', idyAM,idyBF,'dE/dt physics total using dycore E (dyAM-dyBF)',.true.) + call budget_add('BP_phy_params','phAP','phBP','phy','dif',longname='dE/dt CAM physics parameterizations (phAP-phBP)',outfld=.true.) + call budget_add('BD_phy_params','dyAP','dyBP','phy','dif',longname='dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)',outfld=.true.) + call budget_add('BP_pwork','phAM','phAP','phy','dif',longname='dE/dt dry mass adjustment (phAM-phAP)',outfld=.true.) + call budget_add('BD_pwork','dyAM','dyAP','phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)',outfld=.true.) + call budget_add('BP_efix','phBP','phBF','phy','dif',longname='dE/dt energy fixer (phBP-phBF)',outfld=.true.) + call budget_add('BD_efix','dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E (dyBP-dyBF)',outfld=.true.) + call budget_add('BP_phys_tot','phAM','phBF','phy','dif',longname='dE/dt physics total (phAM-phBF)',outfld=.true.) + call budget_add('BD_phys_tot','dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)',outfld=.true.) ! Register water vapor. ! ***** N.B. ***** This must be the first call to cnst_add so that @@ -230,8 +230,8 @@ subroutine phys_register ! Fields for physics package diagnostics call pbuf_add_field('QINI', 'physpkg', dtype_r8, (/pcols,pver/), qini_idx) - call pbuf_add_field('CLDLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), cldliqini_idx) - call pbuf_add_field('CLDICEINI', 'physpkg', dtype_r8, (/pcols,pver/), cldiceini_idx) + call pbuf_add_field('LIQINI', 'physpkg', dtype_r8, (/pcols,pver/), liqini_idx) + call pbuf_add_field('ICEINI', 'physpkg', dtype_r8, (/pcols,pver/), iceini_idx) ! check energy package call check_energy_register @@ -795,7 +795,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use cam_snapshot, only: cam_snapshot_init use cam_history, only: addfld, register_vector_field, add_default, horiz_only use phys_control, only: phys_getopts - use budgets, only: budget_num, budget_info_byind, budget_outfld + use budgets, only: budget_num, budget_info, budget_outfld, budget_init use check_energy, only: check_energy_budget_init ! Input/output arguments @@ -821,6 +821,9 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) call physics_type_alloc(phys_state, phys_tend, begchunk, endchunk, pcols) + ! Initialize budget variables +!jt call budget_init() + do lchnk = begchunk, endchunk call physics_state_set_grid(lchnk, phys_state(lchnk)) call check_energy_budget_init(phys_state(lchnk)) @@ -1067,7 +1070,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) !!$ ! addfld calls for budget stages and diffs !!$ do i=1,budget_num -!!$ call budget_info_byind(i, name=budget_name, longname=budget_longname) +!!$ call budget_info(i, name=budget_name, longname=budget_longname) !!$ write(iulog,*)'addfld i,budget_name=',i,budget_name,budget_num !!$ if (budget_outfld(i)) call addfld(trim(budget_name), horiz_only, 'A', 'W/m2', trim(budget_longname)) !!$ end do @@ -1393,6 +1396,8 @@ subroutine tphysac (ztodt, cam_in, & use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_tend ! WACCM-X use aoa_tracers, only: aoa_tracers_timestep_tend use physconst, only: rhoh2o, latvap,latice + use physconst, only: dry_air_species_num,thermodynamic_active_species_num + use physconst, only: thermodynamic_active_species_idx use dyn_tests_utils, only: vc_dycore use aero_model, only: aero_model_drydep use carma_intr, only: carma_emission_tend, carma_timestep_tend @@ -1444,8 +1449,8 @@ subroutine tphysac (ztodt, cam_in, & integer :: lchnk ! chunk identifier integer :: ncol ! number of atmospheric columns integer i,k,m ! Longitude, level indices + integer :: m_cnst ! tracer index integer :: yr, mon, day, tod ! components of a date - integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water. logical :: labort ! abort flag @@ -1455,12 +1460,11 @@ subroutine tphysac (ztodt, cam_in, & real(r8) obklen(pcols) ! Obukhov length real(r8) :: fh2o(pcols) ! h2o flux to balance source from methane chemistry real(r8) :: flx_heat(pcols) ! Heat flux for check_energy_chng. - real(r8) :: tmp_q (pcols,pver) ! tmp space - real(r8) :: tmp_cldliq(pcols,pver) ! tmp space - real(r8) :: tmp_cldice(pcols,pver) ! tmp space real(r8) :: tmp_trac (pcols,pver,pcnst) ! tmp space real(r8) :: tmp_pdel (pcols,pver) ! tmp space real(r8) :: tmp_ps (pcols) ! tmp space + real(r8) :: tot_water (pcols,pver,2) ! total water (initial, present) + real(r8) :: tot_water_chg(pcols,pver) ! total water change logical :: moist_mixing_ratio_dycore ! physics buffer fields for total energy and mass adjustment @@ -1468,8 +1472,8 @@ subroutine tphysac (ztodt, cam_in, & real(r8), pointer, dimension(:,:) :: cld real(r8), pointer, dimension(:,:) :: qini - real(r8), pointer, dimension(:,:) :: cldliqini - real(r8), pointer, dimension(:,:) :: cldiceini + real(r8), pointer, dimension(:,:) :: liqini + real(r8), pointer, dimension(:,:) :: iceini real(r8), pointer, dimension(:,:) :: dtcore real(r8), pointer, dimension(:,:) :: ducore real(r8), pointer, dimension(:,:) :: dvcore @@ -1501,8 +1505,8 @@ subroutine tphysac (ztodt, cam_in, & call pbuf_get_field(pbuf, dvcore_idx, dvcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, qini_idx, qini) - call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) - call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + call pbuf_get_field(pbuf, liqini_idx, liqini) + call pbuf_get_field(pbuf, iceini_idx, iceini) ifld = pbuf_get_index('CLD') call pbuf_get_field(pbuf, ifld, cld, start=(/1,1,itim_old/),kount=(/pcols,pver,1/)) @@ -1901,14 +1905,6 @@ subroutine tphysac (ztodt, cam_in, & ! assumes moist. This is done in p_d_coupling for other dynamics. Bundy, Feb 2004. if (moist_mixing_ratio_dycore) call set_dry_to_wet(state) ! Physics had dry, dynamics wants moist - ! Scale dry mass and energy (does nothing if dycore is EUL or SLD) - call cnst_get_ind('CLDLIQ', ixcldliq) - call cnst_get_ind('CLDICE', ixcldice) - - tmp_q (:ncol,:pver) = state%q(:ncol,:pver,1) - tmp_cldliq(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) - tmp_cldice(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) - ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. ! So, save off tracers if (.not.moist_mixing_ratio_dycore.and.& @@ -1921,7 +1917,26 @@ subroutine tphysac (ztodt, cam_in, & call set_dry_to_wet(state) - call physics_dme_adjust(state, tend, qini, ztodt) +#ifdef ALL_WATER_IN_DP + ! + ! initial total water + ! + tot_water(:ncol,:pver,1) = qini(:ncol,:pver)+liqini(:ncol,:pver)+iceini(:ncol,:pver) + ! + ! total water "now" + ! + tot_water(:ncol,:pver,2) = 0.0_r8 + do m_cnst=dry_air_species_num+1,thermodynamic_active_species_num + m = thermodynamic_active_species_idx(m_cnst) + tot_water(:ncol,:pver,2) = tot_water(:ncol,:pver,2)+state%q(:ncol,:pver,m) + end do + tot_water_chg(:ncol,:pver) = tot_water(:ncol,:pver,2) - tot_water(:ncol,:pver,1) +#else + tot_water(:ncol,:pver,1) = qini(:ncol,:pver) + tot_water(:ncol,:pver,2) = state%q(:ncol,:pver,1) + tot_water_chg(:ncol,:pver) = tot_water(:ncol,:pver,2) - tot_water(:ncol,:pver,1) +#endif + call physics_dme_adjust(state, tend, tot_water_chg, ztodt) call calc_te_and_aam_budgets(state, 'phAM') call calc_te_and_aam_budgets(state, 'dyAM', vc=vc_dycore) @@ -1937,8 +1952,26 @@ subroutine tphysac (ztodt, cam_in, & call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat) end if - - call physics_dme_adjust(state, tend, qini, ztodt) +#ifdef ALL_WATER_IN_DP + ! + ! initial total water + ! + tot_water(:ncol,:pver,1) = qini(:ncol,:pver)+liqini(:ncol,:pver)+iceini(:ncol,:pver) + ! + ! total water "now" + ! + tot_water(:ncol,:pver,2) = 0.0_r8 + do m_cnst=dry_air_species_num+1,thermodynamic_active_species_num + m = thermodynamic_active_species_idx(m_cnst) + tot_water(:ncol,:pver,2) = tot_water(:ncol,:pver,2)+state%q(:ncol,:pver,m) + end do + tot_water_chg(:ncol,:pver) = tot_water(:ncol,:pver,2) - tot_water(:ncol,:pver,1) +#else + tot_water(:ncol,:pver,1) = qini(:ncol,:pver) + tot_water(:ncol,:pver,2) = state%q(:ncol,:pver,1) + tot_water_chg(:ncol,:pver) = tot_water(:ncol,:pver,2) - tot_water(:ncol,:pver,1) +#endif + call physics_dme_adjust(state, tend, tot_water_chg, ztodt) if (trim(cam_take_snapshot_after) == "physics_dme_adjust") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& @@ -1975,8 +2008,7 @@ subroutine tphysac (ztodt, cam_in, & endif endif - call diag_phys_tend_writeout (state, pbuf, tend, ztodt, tmp_q, tmp_cldliq, tmp_cldice, & - qini, cldliqini, cldiceini) + call diag_phys_tend_writeout (state, pbuf, tend, ztodt, qini, liqini, iceini) call clybry_fam_set( ncol, lchnk, map2chm, state%q, pbuf ) @@ -2030,6 +2062,8 @@ subroutine tphysbc (ztodt, state, & use cam_diagnostics, only: diag_clip_tend_writeout use cam_history, only: outfld use physconst, only: cpair, latvap + use physconst, only: thermodynamic_active_species_liq_num,thermodynamic_active_species_liq_idx + use physconst, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_ice_idx use constituents, only: pcnst, qmin, cnst_get_ind use convect_deep, only: convect_deep_tend, convect_deep_tend_2, deep_scheme_does_scav_trans use time_manager, only: is_first_step, get_nstep @@ -2105,6 +2139,7 @@ subroutine tphysbc (ztodt, state, & integer :: i ! column indicex integer :: ixcldice, ixcldliq, ixq ! constituent indices for cloud liquid and ice water. + integer :: m, m_cnst ! for macro/micro co-substepping integer :: macmic_it ! iteration variables real(r8) :: cld_macmic_ztodt ! modified timestep @@ -2116,8 +2151,8 @@ subroutine tphysbc (ztodt, state, & ! physics buffer fields for total energy and mass adjustment real(r8), pointer, dimension(: ) :: teout real(r8), pointer, dimension(:,:) :: qini - real(r8), pointer, dimension(:,:) :: cldliqini - real(r8), pointer, dimension(:,:) :: cldiceini + real(r8), pointer, dimension(:,:) :: liqini + real(r8), pointer, dimension(:,:) :: iceini real(r8), pointer, dimension(:,:) :: dtcore real(r8), pointer, dimension(:,:) :: ducore real(r8), pointer, dimension(:,:) :: dvcore @@ -2190,8 +2225,8 @@ subroutine tphysbc (ztodt, state, & call pbuf_get_field(pbuf, teout_idx, teout, (/1,itim_old/), (/pcols,1/)) call pbuf_get_field(pbuf, qini_idx, qini) - call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) - call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + call pbuf_get_field(pbuf, liqini_idx, liqini) + call pbuf_get_field(pbuf, iceini_idx, iceini) ifld = pbuf_get_index('DTCORE') call pbuf_get_field(pbuf, ifld, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) @@ -2252,13 +2287,29 @@ subroutine tphysbc (ztodt, state, & ! Save state for convective tendency calculations. call diag_conv_tend_ini(state, pbuf) +#ifdef ALL_WATER_IN_DP call cnst_get_ind('Q', ixq) call cnst_get_ind('CLDLIQ', ixcldliq) call cnst_get_ind('CLDICE', ixcldice) qini (:ncol,:pver) = state%q(:ncol,:pver, 1) - cldliqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) - cldiceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) - + liqini(:ncol,:pver) = 0.0_r8 + do m_cnst=1,thermodynamic_active_species_liq_num + m = thermodynamic_active_species_liq_idx(m_cnst) + liqini(:ncol,:pver) = liqini(:ncol,:pver)+state%q(:ncol,:pver,m) + end do + iceini(:ncol,:pver) = 0.0_r8 + do m_cnst=1,thermodynamic_active_species_ice_num + m = thermodynamic_active_species_ice_idx(m_cnst) + iceini(:ncol,:pver) = iceini(:ncol,:pver)+state%q(:ncol,:pver,m) + end do +#else + call cnst_get_ind('Q', ixq) + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('CLDICE', ixcldice) + qini (:ncol,:pver) = state%q(:ncol,:pver, 1) + liqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) + iceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) +#endif call outfld('TEOUT', teout , pcols, lchnk ) call outfld('TEINP', state%te_ini(:,dyn_te_idx), pcols, lchnk ) call outfld('TEFIX', state%te_cur(:,dyn_te_idx), pcols, lchnk ) diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index 71b70208ae..b7b9c65797 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -69,8 +69,8 @@ module physpkg integer :: sgh30_idx = 0 integer :: qini_idx = 0 - integer :: cldliqini_idx = 0 - integer :: cldiceini_idx = 0 + integer :: liqini_idx = 0 + integer :: iceini_idx = 0 integer :: prec_str_idx = 0 integer :: snow_str_idx = 0 @@ -190,8 +190,8 @@ subroutine phys_register ! Fields for physics package diagnostics call pbuf_add_field('QINI', 'physpkg', dtype_r8, (/pcols,pver/), qini_idx) - call pbuf_add_field('CLDLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), cldliqini_idx) - call pbuf_add_field('CLDICEINI', 'physpkg', dtype_r8, (/pcols,pver/), cldiceini_idx) + call pbuf_add_field('LIQINI', 'physpkg', dtype_r8, (/pcols,pver/), liqini_idx) + call pbuf_add_field('ICEINI', 'physpkg', dtype_r8, (/pcols,pver/), iceini_idx) ! check energy package call check_energy_register @@ -1300,6 +1300,9 @@ subroutine tphysac (ztodt, cam_in, & use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_tend ! WACCM-X use aoa_tracers, only: aoa_tracers_timestep_tend use physconst, only: rhoh2o + use physconst, only: dry_air_species_num,thermodynamic_active_species_num + use physconst, only: thermodynamic_active_species_liq_num,thermodynamic_active_species_liq_idx + use physconst, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_ice_idx use aero_model, only: aero_model_drydep use check_energy, only: check_energy_chng, calc_te_and_aam_budgets use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng @@ -1429,12 +1432,11 @@ subroutine tphysac (ztodt, cam_in, & real(r8) obklen(pcols) ! Obukhov length real(r8) :: fh2o(pcols) ! h2o flux to balance source from methane chemistry real(r8) :: flx_heat(pcols) ! Heat flux for check_energy_chng. - real(r8) :: tmp_q (pcols,pver) ! tmp space - real(r8) :: tmp_cldliq(pcols,pver) ! tmp space - real(r8) :: tmp_cldice(pcols,pver) ! tmp space real(r8) :: tmp_trac (pcols,pver,pcnst) ! tmp space real(r8) :: tmp_pdel (pcols,pver) ! tmp space real(r8) :: tmp_ps (pcols) ! tmp space + real(r8) :: tot_water (pcols,pver,2) ! total water (initial, present) + real(r8) :: tot_water_chg(pcols,pver) ! total water change logical :: moist_mixing_ratio_dycore ! physics buffer fields for total energy and mass adjustment @@ -1442,8 +1444,8 @@ subroutine tphysac (ztodt, cam_in, & real(r8), pointer, dimension(:,:) :: cld real(r8), pointer, dimension(:,:) :: qini - real(r8), pointer, dimension(:,:) :: cldliqini - real(r8), pointer, dimension(:,:) :: cldiceini + real(r8), pointer, dimension(:,:) :: liqini + real(r8), pointer, dimension(:,:) :: iceini real(r8), pointer, dimension(:,:) :: dtcore real(r8), pointer, dimension(:,:) :: ducore real(r8), pointer, dimension(:,:) :: dvcore @@ -1508,8 +1510,8 @@ subroutine tphysac (ztodt, cam_in, & call pbuf_get_field(pbuf, dvcore_idx, dvcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, qini_idx, qini) - call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) - call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + call pbuf_get_field(pbuf, liqini_idx, liqini) + call pbuf_get_field(pbuf, iceini_idx, iceini) ifld = pbuf_get_index('CLD') call pbuf_get_field(pbuf, ifld, cld, start=(/1,1,itim_old/),kount=(/pcols,pver,1/)) @@ -2272,12 +2274,6 @@ subroutine tphysac (ztodt, cam_in, & ! FV: convert dry-type mixing ratios to moist here because physics_dme_adjust ! assumes moist. This is done in p_d_coupling for other dynamics. Bundy, Feb 2004. moist_mixing_ratio_dycore = dycore_is('LR').or. dycore_is('FV3') - if (moist_mixing_ratio_dycore) call set_dry_to_wet(state) ! Physics had dry, dynamics wants moist - - ! Scale dry mass and energy (does nothing if dycore is EUL or SLD) - tmp_q (:ncol,:pver) = state%q(:ncol,:pver,ixq) - tmp_cldliq(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) - tmp_cldice(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. ! So, save off tracers @@ -2291,8 +2287,26 @@ subroutine tphysac (ztodt, cam_in, & call set_dry_to_wet(state) - - call physics_dme_adjust(state, tend, qini, ztodt) +#ifdef ALL_WATER_IN_DP + ! + ! initial total water + ! + tot_water(:ncol,:pver,1) = qini(:ncol,:pver)+liqini(:ncol,:pver)+iceini(:ncol,:pver) + ! + ! total water "now" + ! + tot_water(:ncol,:pver,2) = 0.0_r8 + do m_cnst=dry_air_species_num+1,thermodynamic_active_species_num + m = thermodynamic_active_species_idx(m_cnst) + tot_water(:ncol,:pver,2) = tot_water(:ncol,:pver,2)+state%q(:ncol,:pver,m) + end do + tot_water_chg(:ncol,:pver) = tot_water(:ncol,:pver,2) - tot_water(:ncol,:pver,1) +#else + tot_water(:ncol,:pver,1) = qini(:ncol,:pver) + tot_water(:ncol,:pver,2) = state%q(:ncol,:pver,1) + tot_water_chg(:ncol,:pver) = tot_water(:ncol,:pver,2) - tot_water(:ncol,:pver,1) +#endif + call physics_dme_adjust(state, tend, tot_water_chg, ztodt) call calc_te_and_aam_budgets(state, 'phAM') call calc_te_and_aam_budgets(state, 'dyAM',vc=vc_dycore) @@ -2308,8 +2322,26 @@ subroutine tphysac (ztodt, cam_in, & call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) end if - - call physics_dme_adjust(state, tend, qini, ztodt) +#ifdef ALL_WATER_IN_DP + ! + ! initial total water + ! + tot_water(:ncol,:pver,1) = qini(:ncol,:pver)+liqini(:ncol,:pver)+iceini(:ncol,:pver) + ! + ! total water "now" + ! + tot_water(:ncol,:pver,2) = 0.0_r8 + do m_cnst=dry_air_species_num+1,thermodynamic_active_species_num + m = thermodynamic_active_species_idx(m_cnst) + tot_water(:ncol,:pver,2) = tot_water(:ncol,:pver,2)+state%q(:ncol,:pver,m) + end do + tot_water_chg(:ncol,:pver) = tot_water(:ncol,:pver,2) - tot_water(:ncol,:pver,1) +#else + tot_water(:ncol,:pver,1) = qini(:ncol,:pver) + tot_water(:ncol,:pver,2) = state%q(:ncol,:pver,1) + tot_water_chg(:ncol,:pver) = tot_water(:ncol,:pver,2) - tot_water(:ncol,:pver,1) +#endif + call physics_dme_adjust(state, tend, tot_water_chg, ztodt) if (trim(cam_take_snapshot_after) == "physics_dme_adjust") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& @@ -2345,8 +2377,7 @@ subroutine tphysac (ztodt, cam_in, & endif endif - call diag_phys_tend_writeout (state, pbuf, tend, ztodt, tmp_q, tmp_cldliq, tmp_cldice, & - qini, cldliqini, cldiceini) + call diag_phys_tend_writeout (state, pbuf, tend, ztodt, qini, liqini, iceini) call clybry_fam_set( ncol, lchnk, map2chm, state%q, pbuf ) @@ -2453,8 +2484,8 @@ subroutine tphysbc (ztodt, state, & ! physics buffer fields for total energy and mass adjustment real(r8), pointer, dimension(: ) :: teout real(r8), pointer, dimension(:,:) :: qini - real(r8), pointer, dimension(:,:) :: cldliqini - real(r8), pointer, dimension(:,:) :: cldiceini + real(r8), pointer, dimension(:,:) :: liqini + real(r8), pointer, dimension(:,:) :: iceini real(r8), pointer, dimension(:,:) :: dtcore real(r8), pointer, dimension(:,:) :: ducore real(r8), pointer, dimension(:,:) :: dvcore @@ -2516,8 +2547,8 @@ subroutine tphysbc (ztodt, state, & call pbuf_get_field(pbuf, teout_idx, teout, (/1,itim_old/), (/pcols,1/)) call pbuf_get_field(pbuf, qini_idx, qini) - call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) - call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + call pbuf_get_field(pbuf, liqini_idx, liqini) + call pbuf_get_field(pbuf, iceini_idx, iceini) call pbuf_get_field(pbuf, dtcore_idx, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, ducore_idx, ducore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) @@ -2578,12 +2609,29 @@ subroutine tphysbc (ztodt, state, & ! Save state for convective tendency calculations. call diag_conv_tend_ini(state, pbuf) +#ifdef ALL_WATER_IN_DP call cnst_get_ind('Q', ixq) call cnst_get_ind('CLDLIQ', ixcldliq) call cnst_get_ind('CLDICE', ixcldice) - qini (:ncol,:pver) = state%q(:ncol,:pver, ixq) - cldliqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) - cldiceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) + qini (:ncol,:pver) = state%q(:ncol,:pver, 1) + liqini(:ncol,:pver) = 0.0_r8 + do m_cnst=1,thermodynamic_active_species_liq_num + m = thermodynamic_active_species_liq_idx(m_cnst) + liqini(:ncol,:pver) = liqini(:ncol,:pver)+state%q(:ncol,:pver,m) + end do + iceini(:ncol,:pver) = 0.0_r8 + do m_cnst=1,thermodynamic_active_species_ice_num + m = thermodynamic_active_species_ice_idx(m_cnst) + iceini(:ncol,:pver) = iceini(:ncol,:pver)+state%q(:ncol,:pver,m) + end do +#else + call cnst_get_ind('Q', ixq) + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('CLDICE', ixcldice) + qini (:ncol,:pver) = state%q(:ncol,:pver, 1) + liqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) + iceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) +#endif call outfld('TEOUT', teout , pcols, lchnk ) call outfld('TEINP', state%te_ini(:,dyn_te_idx), pcols, lchnk ) From ce29f55e3bdfe5fd1828c40f1b3ebd7443f57b7d Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Mon, 15 Aug 2022 03:58:15 -0600 Subject: [PATCH 007/140] remove debug print --- src/control/budgets.F90 | 89 +-------------------- src/dynamics/se/dycore/prim_advance_mod.F90 | 11 --- src/dynamics/se/dyn_comp.F90 | 58 -------------- src/dynamics/se/stepon.F90 | 1 - src/physics/cam/check_energy.F90 | 13 --- 5 files changed, 1 insertion(+), 171 deletions(-) diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index 1552138f7a..cb650e9d55 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -158,86 +158,10 @@ subroutine budget_stage_add (name, pkgtype, longname, outfld) budget_optype(budget_num)='stg' budget_pkgtype(budget_num)=pkgtype budget_state_ind(budget_num)=state_idx - write(iulog,*)'inside budget_stage_add/name/type/op/state_idx/phyidx/dynidx/tot',trim(name),pkgtype,budget_optype(budget_num),budget_state_ind(budget_num),budget_num_phy,budget_num_dyn,budget_num end subroutine budget_stage_add !!$!============================================================================== -!!$subroutine budget_diff_add (name, istage1, istage2, pkgtype, optype, longname, outfld, state_ind) -!!$ -!!$ ! Register a budget. -!!$ -!!$ character(len=*), intent(in) :: & -!!$ name ! budget name used as variable name in history file output (8 char max) -!!$ -!!$ integer, intent(in) :: istage1,istage2 ! global budget stage index (in te_budgets array) -!!$ -!!$ character(len=*), intent(in) :: & -!!$ pkgtype ! budget type either phy or dyn -!!$ -!!$ character(len=*), intent(in) :: & -!!$ optype ! dif (difference) or sum or stg (stage) -!!$ -!!$ character(len=*), intent(in), optional :: & -!!$ longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) -!!$ -!!$ logical, intent(in), optional :: & -!!$ outfld ! true => default CAM output of budget in kg/kg -!!$ -!!$ integer, intent(out), optional :: & -!!$ state_ind ! pass back dynamics/physics index for this budget -!!$ -!!$ character(len=*), parameter :: sub='budget_diff_add' -!!$ character(len=128) :: errmsg -!!$ integer :: state_idx -!!$ !----------------------------------------------------------------------- -!!$ ! set budget index and check validity -!!$ if (pkgtype=='phy') then -!!$ budget_num_phy=budget_num_phy+1 -!!$ state_idx = budget_num_phy -!!$!jt write(iulog,*)'adding physics budget idx',name,' ',budget_num_phy -!!$ else if (pkgtype=='dyn') then -!!$ budget_num_dyn=budget_num_dyn+1 -!!$ state_idx = budget_num_dyn -!!$!jt write(iulog,*)'adding dynamics budget idx',name,' ',budget_num_dyn -!!$ else -!!$ call endrun('bad budget pkgtype') -!!$ end if -!!$ budget_num= budget_num+1 -!!$ budget_pkgtype(budget_num)=pkgtype -!!$ if (budget_num > budget_array_max) then -!!$ write(errmsg, *) sub//': FATAL: budget diff index:',budget_num,' greater than budget_array_max=', budget_array_max -!!$ call endrun(errmsg) -!!$ end if -!!$ -!!$ ! set budget name and constants -!!$ budget_name(budget_num) = name -!!$ if (present(longname)) then -!!$ budget_longname(budget_num) = longname -!!$ else -!!$ budget_longname(budget_num) = name -!!$ end if -!!$ -!!$ budget_stg1index(budget_num) = istage1 -!!$ budget_stg2index(budget_num) = istage2 -!!$ budget_stg1name(budget_num) = budget_name_byind(istage1) -!!$ budget_stg2name(budget_num) = budget_name_byind(istage2) -!!$ -!!$ ! set outfld type -!!$ ! (false: the module declaring the budget is responsible for outfld calls) -!!$ if (present(outfld)) then -!!$ budget_out(budget_num) = outfld -!!$ else -!!$ budget_out(budget_num) = .false. -!!$ end if -!!$ -!!$ budget_optype(budget_num)=optype -!!$ -!!$ budget_state_ind(budget_num)=state_idx -!!$ if (present(state_ind)) state_ind=state_idx -!!$ -!!$!jt write(iulog,*)'inside budget_diff_add/name/type/op/is1/is2/phyidx/dynidx/tot',trim(name),pkgtype,budget_optype(budget_num),istage1,istage2,budget_num_phy,budget_num_dyn,budget_num -!!$ end subroutine budget_diff_add -!!$!============================================================================== + subroutine budget_diff_add (name, stg1name, stg2name, pkgtype, optype, longname, outfld) ! Register a budget. @@ -265,11 +189,9 @@ subroutine budget_diff_add (name, stg1name, stg2name, pkgtype, optype, longname, if (pkgtype=='phy') then budget_num_phy=budget_num_phy+1 state_idx = budget_num_phy -!jt write(iulog,*)'adding physics budget idx',name,' ',budget_num_phy else if (pkgtype=='dyn') then budget_num_dyn=budget_num_dyn+1 state_idx = budget_num_dyn -!jt write(iulog,*)'adding dynamics budget idx',name,' ',budget_num_dyn else call endrun('bad budget pkgtype') end if @@ -306,7 +228,6 @@ subroutine budget_diff_add (name, stg1name, stg2name, pkgtype, optype, longname, budget_optype(budget_num)=optype budget_state_ind(budget_num)=state_idx - write(iulog,*)'inside budget_diff_add/name/type/op/is1/is2/is1b/is2b/phyidx/dynidx/tot',trim(name),pkgtype,budget_optype(budget_num),budget_stg1stateidx(budget_num),budget_stg2stateidx(budget_num),budget_stg1index(budget_num),budget_stg2index(budget_num),budget_num_phy,budget_num_dyn,budget_num end subroutine budget_diff_add !============================================================================== @@ -371,7 +292,6 @@ subroutine budget_info_byname(name, budget_ind, longname, stg1name, stg1stateidx character(len=128) :: errmsg integer :: b_ind !----------------------------------------------------------------------- -!jt write(6,*)'calling budget_get_ind with name',trim(name) b_ind=budget_ind_byname(trim(name)) if (b_ind > 0 .and. b_ind <= budget_array_max) then if (present(budget_ind)) budget_ind=b_ind @@ -423,7 +343,6 @@ subroutine budget_info_byind(budget_ind, name, longname, stg1name, stg1stateidx, character(len=*), parameter :: sub='budget_info_byind' character(len=128) :: errmsg !----------------------------------------------------------------------- - write(iulog,*)'budget_info_byind b_ind,name,pkg,opt,state_ind,s1n,s1s,s1b,s2n,s2s,s2b=',budget_ind,trim(budget_name(budget_ind)),budget_pkgtype(budget_ind),budget_optype(budget_ind),budget_state_ind(budget_ind),trim(budget_stg1name(budget_ind)),trim(budget_stg2name(budget_ind)) if (budget_ind > 0 .and. budget_ind <= budget_array_max) then if (present(name)) name=budget_name(budget_ind) if (present(longname)) longname=budget_longname(budget_ind) @@ -629,12 +548,6 @@ subroutine budget_chk_dim character(len=128) :: errmsg !----------------------------------------------------------------------- - ! if (budget_num /= budget_array_max) then - ! write(errmsg, *) sub//': FATAL: number of added budgets (',budget_num, & - ! ') not equal to budget_array_max (', budget_array_max, ')' - ! call endrun (errmsg) - ! endif - if (masterproc) then write(iulog,*) 'Budgets list:' do i = 1, budget_num diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index 500f313394..07e9717ec2 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -1503,7 +1503,6 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 !----------------------------------------------------------------------- - write(iulog,*)'calc_tot outfld_name_suffix=',trim(outfld_name_suffix) name_out1 = 'SE_' //trim(outfld_name_suffix) name_out2 = 'KE_' //trim(outfld_name_suffix) name_out3 = 'WV_' //trim(outfld_name_suffix) @@ -1556,7 +1555,6 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf call budget_info(trim(outfld_name_suffix),budget_ind=budget_ind,state_ind=state_ind) ! reset all when cnt is 0 if (elem(ie)%derived%budget_cnt(state_ind) == 0) then -!jt write(iulog,*)'zeroing out derived budget for ',trim(outfld_name_suffix) elem(ie)%derived%budget_subcycle(state_ind) = 0 elem(ie)%derived%budget(:,:,:,state_ind)=0.0_r8 end if @@ -1566,18 +1564,14 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf if (elem(ie)%derived%budget_subcycle(state_ind) == 1) then elem(ie)%derived%budget_cnt(state_ind) = elem(ie)%derived%budget_cnt(state_ind) + 1 end if -!jt if (ie==nets) write(iulog,*)'cnt and new subcycle after adding 1 ',elem(ie)%derived%budget_cnt(state_ind),elem(ie)%derived%budget_subcycle(state_ind),' for ',trim(outfld_name_suffix),' iam=',iam else elem(ie)%derived%budget_cnt(state_ind) = elem(ie)%derived%budget_cnt(state_ind) + 1 elem(ie)%derived%budget_subcycle(state_ind) = 1 -!jt if (ie==nets) write(iulog,*)'subcycle false new cnt after adding 1 ',elem(ie)%derived%budget_cnt(state_ind),elem(ie)%derived%budget_subcycle(state_ind),' for ',trim(outfld_name_suffix),' iam=',iam end if else elem(ie)%derived%budget_cnt(state_ind) = elem(ie)%derived%budget_cnt(state_ind) + 1 elem(ie)%derived%budget_subcycle(state_ind) = 1 -!jt if (ie==nets) write(iulog,*)'no subcycle new cnt after adding 1 ',elem(ie)%derived%budget_cnt(state_ind),elem(ie)%derived%budget_subcycle(state_ind),' for ',trim(outfld_name_suffix),' iam=',iam end if -!jt if (ie==nets) write(iulog,*)'adding se ke to derived budget for ',trim(outfld_name_suffix),' iam=',iam do j=1,np do i = 1, np elem(ie)%derived%budget(i,j,1,state_ind) = elem(ie)%derived%budget(i,j,1,state_ind) + (se(i+(j-1)*np) + ke(i+(j-1)*np)) @@ -1786,7 +1780,6 @@ subroutine calc_tot_energy_dynamics_diff(elem,fvm,nets,nete,tl,tl_qdp,outfld_nam real(r8), allocatable, dimension(:,:,:,:) :: tmp,tmp1,tmp2 character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn !----------------------------------------------------------------------- - write(iulog,*)'calc_tot diff outfld_name_suffix=',trim(outfld_name_suffix) name_out1 = 'SE_' //trim(outfld_name_suffix) name_out2 = 'KE_' //trim(outfld_name_suffix) name_out3 = 'WV_' //trim(outfld_name_suffix) @@ -1806,7 +1799,6 @@ subroutine calc_tot_energy_dynamics_diff(elem,fvm,nets,nete,tl,tl_qdp,outfld_nam b_ind=budget_ind_byname(trim(outfld_name_suffix)) call budget_info(b_ind,stg1stateidx=is1, stg2stateidx=is2, optype=budget_optype, pkgtype=budget_pkgtype,state_ind=s_ind) do ie=nets,nete -!jt write(iulog,*)'calc budgets name:',trim(outfld_name_suffix),' optype:',budget_optype,' pkgtype:',budget_pkgtype,' cnt:',elem(ie)%derived%budget_cnt(s_ind),'is1/is2:',is1,is2 ! advance budget_cnt if (present(subcycle)) then if (subcycle) then @@ -1828,17 +1820,14 @@ subroutine calc_tot_energy_dynamics_diff(elem,fvm,nets,nete,tl,tl_qdp,outfld_nam elem(ie)%derived%budget_subcycle(s_ind) = 1 end if if (elem(ie)%derived%budget_cnt(is1)==0.or.elem(ie)%derived%budget_cnt(is2)==0) then -!jt write(iulog,*)'budget_cnt is 0 set tmp to zero, cnt(is1b),cnt(is2b) ',trim(outfld_name_suffix),elem(ie)%derived%budget_cnt(is1),elem(ie)%derived%budget_cnt(is2) tmp(:,:,:,ie)=0._r8 else tmp1(:,:,:,ie)=elem(ie)%derived%budget(:,:,:,is1) tmp2(:,:,:,ie)=elem(ie)%derived%budget(:,:,:,is2) end if if (budget_optype=='dif') then -!jt write(iulog,*)'set difference for is1,is2,dyn_state_ind',is1,is2,s_ind tmp(:,:,:,ie)=(tmp1(:,:,:,ie)-tmp2(:,:,:,ie)) else if (budget_optype=='sum') then -!jt write(iulog,*)'set sum for is1,is2,dyn_state_ind',is1,is2,s_ind tmp(:,:,:,ie)=(tmp1(:,:,:,ie)+tmp2(:,:,:,ie)) else call endrun('dyn_readnl: ERROR: budget_optype unknown:'//budget_optype) diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index a2f12fad91..2df295042c 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -984,7 +984,6 @@ subroutine dyn_init(dyn_in, dyn_out) call budget_info(m,name=budget_name,longname=budget_longname,pkgtype=budget_pkgtype) if (trim(budget_pkgtype)=='dyn') then - write(iulog,*)'adding field:',trim(budget_name),' index=',m,' tot=',budget_num call addfld(trim(budget_name), horiz_only, 'A', 'W/m2', trim(budget_longname)) endif end if @@ -1227,48 +1226,6 @@ subroutine dyn_run(dyn_state) tmptot=0._r8 tmpse=0._r8 tmpke=0._r8 -!!$ do i=1,budget_num -!!$ call budget_info(i,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=budget_state_ind) -!!$ if (budget_pkgtype=='dyn') then -!!$ do ie=nets,nete -!!$ if (budget_optype=='stg') then -!!$ write(iulog,*)'outfld stage (already set in state) for ',budget_name -!!$ tmp(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,1,budget_state_ind) -!!$ else -!!$ call budget_info(i,istage1=is1, istage2=is2,istage1b=is1b,istage2b=is2b) -!!$ write(iulog,*)'calc budgets name:',budget_name,' optype:',budget_optype,' pkgtype:',budget_pkgtype,' cnt:',dyn_state%elem(ie)%derived%budget_cnt(budget_state_ind),'is1/is2/is1b/is2b:',is1,is2,is1b,is2b -!!$ if (dyn_state%elem(ie)%derived%budget_cnt(is1)==0.or.dyn_state%elem(ie)%derived%budget_cnt(is2)==0) then -!!$ write(iulog,*)'budget_cnt is 0 set tmp to zero, cnt(is1b),cnt(is2b) ',budget_name,dyn_state%elem(ie)%derived%budget_cnt(is1),dyn_state%elem(ie)%derived%budget_cnt(is2) -!!$ tmp(:,:,ie)=0._r8 -!!$ else -!!$ write(iulog,*)'preincrement cnt for: ',budget_name,' cnt:',dyn_state%elem(ie)%derived%budget_cnt(budget_state_ind),' i:',i -!!$ dyn_state%elem(ie)%derived%budget_cnt(budget_state_ind)=dyn_state%elem(ie)%derived%budget_cnt(budget_state_ind)+1 -!!$ write(iulog,*)'incrementing cnt for: ',budget_name,' cnt:',budget_cnt(i),' i:',i -!!$ ! tmp(:,:,ie)=(elem(ie)%derived%budget(:,:,1,is1)-elem(ie)%derived%budget(:,:,1,is2))/budget_cnt(is1)/dtime -!!$! tmp1(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,1,is1)/budget_count(is1b) -!!$! tmp2(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,1,is2)/budget_count(is2b) -!!$ tmp1(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,1,is1) -!!$ tmp2(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,1,is2) -!!$ if (budget_optype=='dif') then -!!$ write(iulog,*)'set difference for is1,is2,dyn_state_ind',is1,is2,budget_state_ind -!!$ tmp(:,:,ie)=(tmp1(:,:,ie)-tmp2(:,:,ie)) -!!$!jt tmp(:,:,ie)=(dyn_state%elem(ie)%derived%budget(:,:,1,is1)-dyn_state%elem(ie)%derived%budget(:,:,1,is2))/1/dtime -!!$ else if (budget_optype=='sum') then -!!$ write(iulog,*)'set sum for is1,is2,dyn_state_ind',is1,is2,budget_state_ind -!!$!jt tmp(:,:,ie)=(dyn_state%elem(ie)%derived%budget(:,:,1,is1)+dyn_state%elem(ie)%derived%budget(:,:,1,is2))/1/dtime -!!$ tmp(:,:,ie)=(tmp1(:,:,ie)+tmp2(:,:,ie)) -!!$ else -!!$ call endrun('dyn_readnl: ERROR: budget_optype unknown:'//budget_optype) -!!$ end if -!!$ dyn_state%elem(ie)%derived%budget(:,:,1,budget_state_ind)=tmp(:,:,ie) -!!$ end if -!!$ end if -!!$ -!!$!jt if (ie==nets) write(iulog,*)'calling outfld for name,pkgtype,budget_idx,tot=',budget_name,budget_pkgtype,budget_optype,i,budget_num -!!$!jt if (budget_outfld(i)) call outfld(trim(budget_name),RESHAPE(tmp(:,:,ie),(/npsq/)),npsq,ie) -!!$ end do -!!$ end if -!!$ end do ! output budget globals @@ -1277,7 +1234,6 @@ subroutine dyn_run(dyn_state) call budget_info(i,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=budget_state_ind) if (budget_pkgtype=='dyn') then ! Normalize energy sums and convert to W/s - write(iulog,*)budget_name,'norm cnt=',dyn_state%elem(nets)%derived%budget_cnt(budget_state_ind),'sub=',dyn_state%elem(nets)%derived%budget_subcycle(budget_state_ind) do ie=nets,nete tmp(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,1,budget_state_ind)/dyn_state%elem(ie)%derived%budget_cnt(budget_state_ind)/dtime if (dyn_state%elem(nets)%derived%budget_subcycle(budget_state_ind).ne.0) then @@ -1295,16 +1251,11 @@ subroutine dyn_run(dyn_state) global_ave = global_integral(dyn_state%elem, tmp(:,:,nets:nete),hybrid,np,nets,nete) write(iulog,*)budget_name,' global average normalized cnt dtime=',global_ave,'cnt=',dyn_state%elem(nets)%derived%budget_cnt(budget_state_ind),'sub=',dyn_state%elem(nets)%derived%budget_subcycle(budget_state_ind) global_ave = global_integral(dyn_state%elem, tmp1(:,:,nets:nete),hybrid,np,nets,nete) - write(iulog,*)budget_name,' global average se normalized cnt dtime=',global_ave,'state_ind=',budget_state_ind,'tot budget num=',i global_ave = global_integral(dyn_state%elem, tmp2(:,:,nets:nete),hybrid,np,nets,nete) - write(iulog,*)budget_name,' global average ke normalized cnt dtime=',global_ave,'state_ind=',budget_state_ind,'tot budget num=',i if (dyn_state%elem(nets)%derived%budget_subcycle(budget_state_ind).ne.0) then global_ave = global_integral(dyn_state%elem, tmptot(:,:,nets:nete),hybrid,np,nets,nete) - write(iulog,*)budget_name,' global average se+ke sums=',global_ave global_ave = global_integral(dyn_state%elem, tmpse(:,:,nets:nete),hybrid,np,nets,nete) - write(iulog,*)budget_name,' global average se sums=',global_ave global_ave = global_integral(dyn_state%elem, tmpke(:,:,nets:nete),hybrid,np,nets,nete) - write(iulog,*)budget_name,' global average ke sums=',global_ave end if ! reset dyn budget states ! reset budget counts - stage or diff budget will just be i. If difference must reset components of diff @@ -1312,15 +1263,6 @@ subroutine dyn_run(dyn_state) dyn_state%elem(ie)%derived%budget(:,:,:,budget_state_ind)=0._r8 dyn_state%elem(ie)%derived%budget_cnt(budget_state_ind)=0 end do -!!$ if (budget_optype=='dif' .or. budget_optype=='sum') then -!!$ call budget_info(i,istage1=is1, istage2=is2) -!!$ do ie=nets,nete -!!$ if (ie==nets) write(iulog,*)'count for is1=',is1,' =',dyn_state%elem(ie)%derived%budget_cnt(is1),' is2=',is2,' =',dyn_state%elem(ie)%derived%budget_cnt(is2) -!!$ dyn_state%elem(ie)%derived%budget_cnt(is1)=0 -!!$ dyn_state%elem(ie)%derived%budget_cnt(is2)=0 -!!$ if (ie==nets) write(iulog,*)'reset count for is1=',is1,' =',dyn_state%elem(ie)%derived%budget_cnt(is1),' is2=',is2,' =',dyn_state%elem(ie)%derived%budget_cnt(is2) -!!$ end do -!!$ end if end if end do end if diff --git a/src/dynamics/se/stepon.F90 b/src/dynamics/se/stepon.F90 index 8edef919d4..c7f97eaf3e 100644 --- a/src/dynamics/se/stepon.F90 +++ b/src/dynamics/se/stepon.F90 @@ -145,7 +145,6 @@ subroutine stepon_run2(phys_state, phys_tend, dyn_in, dyn_out) call t_stopf('p_d_coupling') if (iam < par%nprocs) then -!jt write(iulog,*)'calling calc with name dED' call calc_tot_energy_dynamics(dyn_in%elem,dyn_in%fvm, 1, nelemd, tl_f, tl_fQdp,'dED') end if diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 7d71e5beb7..9f5af71b1e 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -217,9 +217,7 @@ subroutine check_energy_init() do m=1,budget_num if (budget_outfld(m)) then call budget_info(m,name=budget_name,longname=budget_longname,pkgtype=budget_pkgtype) -!jt write(iulog,*)'looking at field:',trim(budget_name),' index=',m,' tot=',budget_num,' pkgtype=',budget_pkgtype if (trim(budget_pkgtype)=='phy') then -!jt write(iulog,*)'adding field:',trim(budget_name),' index=',m,' tot=',budget_num call addfld(trim(budget_name), horiz_only, 'A', 'W/m2', trim(budget_longname)) endif end if @@ -619,11 +617,9 @@ subroutine check_energy_budget(state, dtime, nstep) !----------------------------------------------------------------------- if (.not.allocated (te)) then allocate( te(pcols,begchunk:endchunk,budget_num_phy)) -!jt write(iulog,*)'shape te=',shape(te),budget_num_phy end if if (.not.allocated (te_glob)) then allocate( te_glob(budget_num_phy)) -!jt write(iulog,*)'shape te_glob=',shape(te_glob) else write(iulog,*)'no alloc call shape te_glob=',shape(te_glob) end if @@ -645,7 +641,6 @@ subroutine check_energy_budget(state, dtime, nstep) if (state(lchnk)%budget_cnt(is1b)==0.or.state(lchnk)%budget_cnt(is2b)==0) then te(:,lchnk,i)=0._r8 else - write(iulog,*)'calculating budget differences for ',budget_name,' ',budget_pkgtype,' ',budget_optype,' te i=',i,' of ',budget_num_phy,' state_ind=',i,' budget_cnt(is1b)=',state(lchnk)%budget_cnt(is1b),' dtime=',dtime,' is1b/is2b=',is1b,'/',is2b te(:,lchnk,i) = (state(lchnk)%te_budgets(:,1,is1)-state(lchnk)%te_budgets(:,1,is2))/state(lchnk)%budget_cnt(is1b)/dtime end if else if (budget_optype=='sum') then @@ -657,14 +652,11 @@ subroutine check_energy_budget(state, dtime, nstep) if (state(lchnk)%budget_cnt(is1b)==0.or.state(lchnk)%budget_cnt(is2b)==0) then te(:,lchnk,i)=0._r8 else - write(iulog,*)'calculating budget sums for ',budget_name,' ',budget_pkgtype,' ',budget_optype,' te i=',i,' of ',budget_num_phy,' state_ind=',i,' budget_cnt(is1b)=',state(lchnk)%budget_cnt(is1b),' dtime=',dtime,' is1b/is2b=',is1b,'/',is2b te(:,lchnk,i) = (state(lchnk)%te_budgets(:,1,is1)+state(lchnk)%te_budgets(:,1,is2))/state(lchnk)%budget_cnt(is1b)/dtime end if else - write(iulog,*)'setting te for stage ',budget_name,' ',budget_pkgtype,' ',budget_optype,' te i=',i,' of ',budget_num_phy,' state_ind=',i,' dtime=',dtime te(:,lchnk,i)=state(lchnk)%te_budgets(:,1,i) end if -!jt if (lchnk==begchunk) write(iulog,*)'calling outfld for lchnk,name,pkgtype,budget_idx,tot=',lchnk,budget_name,budget_pkgtype,budget_optype,i,budget_num if (budget_outfld(i).and.budget_pkgtype=='phy') call outfld(trim(budget_name), te(:ncol,lchnk,i), pcols, lchnk) end if end do @@ -676,12 +668,9 @@ subroutine check_energy_budget(state, dtime, nstep) do ii=1,budget_num call budget_info(ii,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=i) if (budget_pkgtype=='phy') then - write(iulog,*)'global tot for ',budget_name,':',te_glob(i),'b4budget_cnt_incr',state(begchunk)%budget_cnt(ii) -!jt call budget_cnt_adjust(ii,reset=.true.) do lchnk = begchunk, endchunk state(lchnk)%budget_cnt(ii)=0 end do - write(iulog,*)'afbudget_cnt_incr',state(begchunk)%budget_cnt(ii) end if end do @@ -1076,8 +1065,6 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix, vc) state%te_budgets(1:ncol,6,ind)=ice(1:ncol) state%te_budgets(1:ncol,7,ind)=tt(1:ncol) state%budget_cnt(ind)=state%budget_cnt(ind)+1 -!jt call budget_cnt_adjust(budget_ind) - write(iulog,*)'incr count for ',outfld_name_suffix,' count=',state%budget_cnt(ind) ! Output energy diagnostics call outfld(name_out1 ,se , pcols ,lchnk ) From 50c84a3d74d30adc7f03fa740208f40bff846ffd Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Mon, 15 Aug 2022 13:44:35 -0600 Subject: [PATCH 008/140] fix Externals.cfg --- Externals.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 55c8f48bd8..b29291a7da 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -66,7 +66,7 @@ required = True [cime] tag = cime6.0.46 protocol = git -repo_url = https://github.com/jtruesdal/cime +repo_url = https://github.com/ESMCI/cime local_path = cime required = True @@ -81,7 +81,7 @@ required = True [clm] tag = ctsm5.1.dev103 protocol = git -repo_url = https://github.com/jtruesdal/ctsm +repo_url = https://github.com/ESCOMP/CTSM local_path = components/clm externals = Externals_CLM.cfg required = True From 524706acc75b5f2015537dbbdc7e5fe0e9359552 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Mon, 15 Aug 2022 16:19:31 -0600 Subject: [PATCH 009/140] fix bugs while updating to cam6_3_072 - checked against Peter's script --- src/control/cam_comp.F90 | 8 - src/dynamics/se/dp_coupling.F90 | 20 +- .../se/dycore/fvm_control_volume_mod.F90 | 5 + src/dynamics/se/dycore/prim_advance_mod.F90 | 233 ++++++++---------- src/dynamics/se/dycore/prim_driver_mod.F90 | 2 +- src/dynamics/se/stepon.F90 | 1 - src/physics/cam/cam_diagnostics.F90 | 71 +++++- src/physics/cam/check_energy.F90 | 6 +- src/physics/cam/constituents.F90 | 2 + src/physics/cam/physics_types.F90 | 19 +- src/physics/cam/physpkg.F90 | 126 +++------- src/physics/cam_dev/physpkg.F90 | 103 ++------ 12 files changed, 252 insertions(+), 344 deletions(-) diff --git a/src/control/cam_comp.F90 b/src/control/cam_comp.F90 index 5ab644985f..61246d30c8 100644 --- a/src/control/cam_comp.F90 +++ b/src/control/cam_comp.F90 @@ -163,16 +163,12 @@ subroutine cam_init( & call cam_initfiles_open() ! Initialize grids and dynamics grid decomposition - - write(iulog,*)'calling dyn_grid_init' call dyn_grid_init() ! Initialize physics grid decomposition - write(iulog,*)'calling phys_grid_init' call phys_grid_init() ! Register advected tracers and physics buffer fields - write(iulog,*)'calling phys_register' call phys_register () ! Initialize ghg surface values before default initial distributions @@ -185,7 +181,6 @@ subroutine cam_init( & if (initial_run_in) then - write(iulog,*)'calling dyn_init' call dyn_init(dyn_in, dyn_out) ! Allocate and setup surface exchange data @@ -201,13 +196,10 @@ subroutine cam_init( & #endif end if - write(iulog,*)'calling phys_init' call phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) - write(iulog,*)'calling bldfld' call bldfld () ! master field list (if branch, only does hash tables) - write(iulog,*)'calling stepon_init' call stepon_init(dyn_in, dyn_out) call offline_driver_init() diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index ed04627eec..5f601e1cc3 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -546,9 +546,6 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) use hycoef, only: hyai, ps0 use shr_vmath_mod, only: shr_vmath_log use qneg_module, only: qneg3 - use physconst, only: thermodynamic_active_species_num - use physconst, only: thermodynamic_active_species_idx_dycore - use physconst, only: thermodynamic_active_species_idx ! arguments type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state @@ -561,7 +558,7 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) real(r8) :: zvirv(pcols,pver) ! Local zvir array pointer real(r8) :: factor_array(pcols,nlev) - integer :: m, i, k, ncol, m_cnst + integer :: m, i, k, ncol type(physics_buffer_desc), pointer :: pbuf_chnk(:) !---------------------------------------------------------------------------- @@ -603,18 +600,7 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) end do ! wet pressure variables (should be removed from physics!) -#ifdef ALL_WATER_IN_DP - factor_array(:,:) = 1.0_r8 - do m_cnst=1,thermodynamic_active_species_num - m = thermodynamic_active_species_idx(m_cnst) - do k=1,nlev - do i=1,ncol - ! at this point all q's are dry - factor_array(i,k) = factor_array(i,k)+phys_state(lchnk)%q(i,k,m) - end do - end do - end do -#else + do k=1,nlev do i=1,ncol ! to be consistent with total energy formula in physic's check_energy module only @@ -622,7 +608,7 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) factor_array(i,k) = 1+phys_state(lchnk)%q(i,k,1) end do end do -#endif + do k=1,nlev do i=1,ncol phys_state(lchnk)%pdel (i,k) = phys_state(lchnk)%pdeldry(i,k)*factor_array(i,k) diff --git a/src/dynamics/se/dycore/fvm_control_volume_mod.F90 b/src/dynamics/se/dycore/fvm_control_volume_mod.F90 index c1b3c6fc15..ea4f536ace 100644 --- a/src/dynamics/se/dycore/fvm_control_volume_mod.F90 +++ b/src/dynamics/se/dycore/fvm_control_volume_mod.F90 @@ -17,6 +17,7 @@ module fvm_control_volume_mod use dimensions_mod, only: fv_nphys, nhe_phys, nhr_phys, ns_phys, nhc_phys,fv_nphys use dimensions_mod, only: irecons_tracer use cam_abortutils, only: endrun + use budgets, only: budget_array_max implicit none private @@ -155,6 +156,9 @@ module fvm_control_volume_mod real (kind=r8) , allocatable :: ft(:,:,:) real (kind=r8) , allocatable :: fm(:,:,:,:) real (kind=r8) , allocatable :: dp_phys(:,:,:) + real (kind=r8) , allocatable :: budget(:,:,:,:) ! budgets + integer :: budget_cnt(budget_array_max) ! budget count for averaging + integer :: budget_subcycle(budget_array_max) ! budget subcycle count end type fvm_struct public :: fvm_mesh, fvm_set_cubeboundary, allocate_physgrid_vars @@ -306,6 +310,7 @@ subroutine allocate_physgrid_vars(fvm,par) allocate(fvm(ie)%ft(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,nlev)) allocate(fvm(ie)%fm(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,2,nlev)) allocate(fvm(ie)%dp_phys(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,nlev)) + allocate(fvm(ie)%budget(nc,nc,9,budget_array_max)) end do end subroutine allocate_physgrid_vars end module fvm_control_volume_mod diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index 84233a913c..c796da140b 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -64,7 +64,7 @@ subroutine prim_advance_exp(elem, fvm, deriv, hvcoord, hybrid,dt, tl, nets, net implicit none type (element_t), intent(inout), target :: elem(:) - type(fvm_struct) , intent(in) :: fvm(:) + type(fvm_struct) , intent(inout) :: fvm(:) type (derivative_t) , intent(in) :: deriv type (hvcoord_t) :: hvcoord type (hybrid_t) , intent(in) :: hybrid @@ -468,7 +468,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, type (hybrid_t) , intent(in) :: hybrid type (element_t) , intent(inout), target :: elem(:) - type(fvm_struct) , intent(in) :: fvm(:) + type(fvm_struct) , intent(inout) :: fvm(:) type (EdgeBuffer_t), intent(inout):: edge3 type (derivative_t), intent(in ) :: deriv integer , intent(in) :: nets,nete, nt, qn0 @@ -1456,6 +1456,7 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf use element_mod, only: element_t use cam_history, only: outfld, hist_fld_active use constituents, only: cnst_get_ind + use string_utils, only: strlist_get_ind use hycoef, only: hyai, ps0 use fvm_control_volume_mod, only: fvm_struct use physconst, only: get_dp, get_cp @@ -1471,7 +1472,7 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf !------------------------------Arguments-------------------------------- type (element_t) , intent(inout) :: elem(:) - type(fvm_struct) , intent(in) :: fvm(:) + type(fvm_struct) , intent(inout) :: fvm(:) integer , intent(in) :: tl, tl_qdp,nets,nete character*(*) , intent(in) :: outfld_name_suffix ! suffix for "outfld" names logical, optional, intent(in) :: subcycle ! true if called inside subcycle loop @@ -1482,12 +1483,10 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf real(kind=r8) :: ke(npsq) ! kinetic energy (J/m2) real(kind=r8) :: cdp_fvm(nc,nc,nlev) - real(kind=r8) :: cdp(np,np,nlev) real(kind=r8) :: se_tmp real(kind=r8) :: ke_tmp real(kind=r8) :: ps(np,np) real(kind=r8) :: pdel(np,np,nlev) - ! ! global axial angular momentum (AAM) can be separated into one part (mr) associatedwith the relative motion ! of the atmosphere with respect to the planets surface (also known as wind AAM) and another part (mo) @@ -1499,10 +1498,12 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf real(kind=r8) :: mr_cnst, mo_cnst, cos_lat, mr_tmp, mo_tmp real(kind=r8) :: cp(np,np,nlev) - integer :: ie,i,j,k,idx,ixtt,budget_ind,state_ind,iwv + integer :: ie,i,j,k,budget_ind,state_ind + integer :: ixwv,ixcldice, ixcldliq, ixtt ! CLDICE, CLDLIQ and test tracer indices character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 !----------------------------------------------------------------------- + name_out1 = 'SE_' //trim(outfld_name_suffix) name_out2 = 'KE_' //trim(outfld_name_suffix) name_out3 = 'WV_' //trim(outfld_name_suffix) @@ -1512,7 +1513,20 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2).or.hist_fld_active(name_out3).or.& hist_fld_active(name_out4).or.hist_fld_active(name_out5).or.hist_fld_active(name_out6)) then - call cnst_get_ind('TT_UN' , ixtt , abort=.false.) + + if (ntrac>0) then + ixwv = 1 + call cnst_get_ind('CLDLIQ' , ixcldliq, abort=.false.) + call cnst_get_ind('CLDICE' , ixcldice, abort=.false.) + else + ! + ! when using CSLAM the condensates on the GLL grid may be located in a different index than in physics + ! + ixwv = -1 + call strlist_get_ind(cnst_name_gll, 'CLDLIQ' , ixcldliq, abort=.false.) + call strlist_get_ind(cnst_name_gll, 'CLDICE' , ixcldice, abort=.false.) + end if + call cnst_get_ind('TT_LW' , ixtt , abort=.false.) ! ! Compute frozen static energy in 3 parts: KE, SE, and energy associated with vapor and liquid ! @@ -1589,123 +1603,92 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf ! mass variables are output on CSLAM grid if using CSLAM else GLL grid ! if (ntrac>0) then - iwv = 0;if (ntrac>0) iwv=1 - cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,iwv)*fvm(ie)%dp_fvm(1:nc,1:nc,:) - call util_function(cdp_fvm,nc,nlev,name_out3,ie) - do j = 1, nc - do i = 1, nc - elem(ie)%derived%budget(i,j,4,state_ind) = elem(ie)%derived%budget(i,j,4,state_ind) + sum(cdp_fvm(i,j,:)) - end do - end do - elem(ie)%derived%budget(1:nc,1:nc,4,state_ind)=elem(ie)%derived%budget(1:nc,1:nc,4,state_ind)/gravit - ! - ! sum over liquid water - ! - if (thermodynamic_active_species_liq_num>0) then - cdp_fvm = 0.0_r8 - do idx = 1,thermodynamic_active_species_liq_num - cdp_fvm = cdp_fvm + fvm(ie)%c(1:nc,1:nc,:,thermodynamic_active_species_liq_idx(idx))& - *fvm(ie)%dp_fvm(1:nc,1:nc,:) - end do - call util_function(cdp_fvm,nc,nlev,name_out4,ie) - do j = 1, nc - do i = 1, nc - elem(ie)%derived%budget(i,j,5,state_ind) = elem(ie)%derived%budget(i,j,5,state_ind) + sum(cdp_fvm(i,j,:)) - end do - end do - elem(ie)%derived%budget(1:nc,1:nc,5,state_ind)=elem(ie)%derived%budget(1:nc,1:nc,5,state_ind)/gravit - end if - ! - ! sum over ice water - ! - if (thermodynamic_active_species_ice_num>0) then - cdp_fvm = 0.0_r8 - do idx = 1,thermodynamic_active_species_ice_num - cdp_fvm = cdp_fvm + fvm(ie)%c(1:nc,1:nc,:,thermodynamic_active_species_ice_idx(idx))& - *fvm(ie)%dp_fvm(1:nc,1:nc,:) - end do - call util_function(cdp_fvm,nc,nlev,name_out4,ie) - do j = 1, nc - do i = 1, nc - elem(ie)%derived%budget(i,j,6,state_ind) = elem(ie)%derived%budget(i,j,6,state_ind) + sum(cdp_fvm(i,j,:)) - end do - end do - elem(ie)%derived%budget(1:nc,1:nc,6,state_ind)=elem(ie)%derived%budget(1:nc,1:nc,6,state_ind)/gravit - end if - ! - ! dry test tracer - ! - if (ixtt>0) then - cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixtt)*fvm(ie)%dp_fvm(1:nc,1:nc,:) - call util_function(cdp_fvm,nc,nlev,name_out6,ie) - do j = 1, nc - do i = 1, nc - elem(ie)%derived%budget(i,j,7,state_ind) = elem(ie)%derived%budget(i,j,7,state_ind) + sum(cdp_fvm(i,j,:)) - end do - end do - elem(ie)%derived%budget(1:nc,1:nc,7,state_ind)=elem(ie)%derived%budget(1:nc,1:nc,7,state_ind)/gravit - end if + if (ixwv>0) then + cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixwv)*fvm(ie)%dp_fvm(1:nc,1:nc,:) + call util_function(cdp_fvm,nc,nlev,name_out3,ie) + do j = 1, nc + do i = 1, nc + fvm(ie)%budget(i,j,4,state_ind) = fvm(ie)%budget(i,j,4,state_ind) + sum(cdp_fvm(i,j,:)) + end do + end do + fvm(ie)%budget(1:nc,1:nc,4,state_ind)=fvm(ie)%budget(1:nc,1:nc,4,state_ind)/gravit + end if + if (ixcldliq>0) then + cdp_fvm = 0.0_r8 + cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixcldliq)*fvm(ie)%dp_fvm(1:nc,1:nc,:) + call util_function(cdp_fvm,nc,nlev,name_out4,ie) + do j = 1, nc + do i = 1, nc + fvm(ie)%budget(i,j,5,state_ind) = fvm(ie)%budget(i,j,5,state_ind) + sum(cdp_fvm(i,j,:)) + end do + end do + fvm(ie)%budget(1:nc,1:nc,5,state_ind)=fvm(ie)%budget(1:nc,1:nc,5,state_ind)/gravit + end if + if (ixcldice>0) then + cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixcldice)*fvm(ie)%dp_fvm(1:nc,1:nc,:) + call util_function(cdp_fvm,nc,nlev,name_out5,ie) + + do j = 1, nc + do i = 1, nc + fvm(ie)%budget(i,j,6,state_ind) = fvm(ie)%budget(i,j,6,state_ind) + sum(cdp_fvm(i,j,:)) + end do + end do + fvm(ie)%budget(1:nc,1:nc,6,state_ind)=fvm(ie)%budget(1:nc,1:nc,6,state_ind)/gravit + end if + if (ixtt>0) then + cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixtt)*fvm(ie)%dp_fvm(1:nc,1:nc,:) + call util_function(cdp_fvm,nc,nlev,name_out6,ie) + do j = 1, nc + do i = 1, nc + fvm(ie)%budget(i,j,7,state_ind) = fvm(ie)%budget(i,j,7,state_ind) + sum(cdp_fvm(i,j,:)) + end do + end do + fvm(ie)%budget(1:nc,1:nc,7,state_ind)=fvm(ie)%budget(1:nc,1:nc,7,state_ind)/gravit + end if else - call util_function(elem(ie)%state%qdp(:,:,:,1,tl_qdp),np,nlev,name_out3,ie) - do j = 1, np - do i = 1, np - elem(ie)%derived%budget(i,j,4,state_ind) = elem(ie)%derived%budget(i,j,4,state_ind) + sum(elem(ie)%state%qdp(i,j,:,1,tl_qdp)) - end do - end do - elem(ie)%derived%budget(1:np,1:np,4,state_ind)=elem(ie)%derived%budget(1:np,1:np,4,state_ind)/gravit - ! - ! sum over liquid water - ! - if (thermodynamic_active_species_liq_num>0) then - cdp = 0.0_r8 - do idx = 1,thermodynamic_active_species_liq_num - cdp = cdp + elem(ie)%state%qdp(:,:,:,thermodynamic_active_species_liq_idx(idx),tl_qdp) - end do - call util_function(cdp,np,nlev,name_out4,ie) - do j = 1, np - do i = 1, np - elem(ie)%derived%budget(i,j,5,state_ind) = elem(ie)%derived%budget(i,j,5,state_ind) + sum(cdp(i,j,:)) - end do - end do - elem(ie)%derived%budget(1:np,1:np,5,state_ind)=elem(ie)%derived%budget(1:np,1:np,5,state_ind)/gravit - end if - ! - ! sum over ice water - ! - if (thermodynamic_active_species_ice_num>0) then - cdp = 0.0_r8 - do idx = 1,thermodynamic_active_species_ice_num - cdp = cdp + elem(ie)%state%qdp(:,:,:,thermodynamic_active_species_ice_idx(idx),tl_qdp) - end do - call util_function(cdp,np,nlev,name_out5,ie) - do j = 1, np - do i = 1, np - elem(ie)%derived%budget(i,j,6,state_ind) = elem(ie)%derived%budget(i,j,6,state_ind) + sum(cdp(i,j,:)) - end do - end do - elem(ie)%derived%budget(1:np,1:np,6,state_ind)=elem(ie)%derived%budget(1:np,1:np,6,state_ind)/gravit - end if - ! - ! dry test tracer - ! - if (ixtt>0) then - call util_function(elem(ie)%state%qdp(:,:,:,ixtt,tl_qdp),np,nlev,name_out6,ie) - do j = 1, np - do i = 1, np - elem(ie)%derived%budget(i,j,7,state_ind) = elem(ie)%derived%budget(i,j,7,state_ind) + sum(elem(ie)%state%qdp(i,j,:,ixtt,tl_qdp)) - end do - end do - elem(ie)%derived%budget(1:np,1:np,7,state_ind)=elem(ie)%derived%budget(1:np,1:np,7,state_ind)/gravit - end if - end if - end do - end if - ! - ! Axial angular momentum diagnostics - ! - ! Code follows - ! - ! Lauritzen et al., (2014): Held-Suarez simulations with the Community Atmosphere Model + call util_function(elem(ie)%state%qdp(:,:,:,1,tl_qdp),np,nlev,name_out3,ie) + do j = 1, np + do i = 1, np + elem(ie)%derived%budget(i,j,4,state_ind) = elem(ie)%derived%budget(i,j,4,state_ind) + sum(elem(ie)%state%qdp(i,j,:,1,tl_qdp)) + end do + end do + elem(ie)%derived%budget(1:np,1:np,4,state_ind)=elem(ie)%derived%budget(1:np,1:np,4,state_ind)/gravit + if (ixcldliq>0) then + call util_function(elem(ie)%state%qdp(:,:,:,ixcldliq,tl_qdp),np,nlev,name_out4,ie) + do j = 1, np + do i = 1, np + elem(ie)%derived%budget(i,j,4,state_ind) = elem(ie)%derived%budget(i,j,4,state_ind) + sum(elem(ie)%state%qdp(i,j,:,1,tl_qdp)) + end do + end do + elem(ie)%derived%budget(1:np,1:np,4,state_ind)=elem(ie)%derived%budget(1:np,1:np,4,state_ind)/gravit + end if + if (ixcldice>0) then + call util_function(elem(ie)%state%qdp(:,:,:,ixcldice,tl_qdp),np,nlev,name_out5,ie) + do j = 1, np + do i = 1, np + elem(ie)%derived%budget(i,j,6,state_ind) = elem(ie)%derived%budget(i,j,6,state_ind) + sum(elem(ie)%state%qdp(i,j,:,ixcldice,tl_qdp)) + end do + end do + elem(ie)%derived%budget(1:np,1:np,6,state_ind)=elem(ie)%derived%budget(1:np,1:np,6,state_ind)/gravit + end if + if (ixtt>0) then + call util_function(elem(ie)%state%qdp(:,:,:,ixtt ,tl_qdp),np,nlev,name_out6,ie) + do j = 1, np + do i = 1, np + elem(ie)%derived%budget(i,j,7,state_ind) = elem(ie)%derived%budget(i,j,7,state_ind) + sum(elem(ie)%state%qdp(i,j,:,ixtt,tl_qdp)) + end do + end do + elem(ie)%derived%budget(1:np,1:np,7,state_ind)=elem(ie)%derived%budget(1:np,1:np,7,state_ind)/gravit + end if + end if + end do + end if + ! + ! Axial angular momentum diagnostics + ! + ! Code follows + ! + ! Lauritzen et al., (2014): Held-Suarez simulations with the Community Atmosphere Model ! Spectral Element (CAM-SE) dynamical core: A global axial angularmomentum analysis using Eulerian ! and floating Lagrangian vertical coordinates. J. Adv. Model. Earth Syst. 6,129-140, ! doi:10.1002/2013MS000268 @@ -1717,6 +1700,8 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf name_out2 = 'MO_' //trim(outfld_name_suffix) if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2)) then + call strlist_get_ind(cnst_name_gll, 'CLDLIQ', ixcldliq, abort=.false.) + call strlist_get_ind(cnst_name_gll, 'CLDICE', ixcldice, abort=.false.) mr_cnst = rearth**3/gravit mo_cnst = omega*rearth**4/gravit do ie=nets,nete @@ -1933,7 +1918,7 @@ subroutine output_qdp_var_dynamics(qdp,nx,num_trac,nets,nete,outfld_name) call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.) call cnst_get_ind('CLDICE', ixcldice, abort=.false.) - call cnst_get_ind('TT_MD' , ixtt , abort=.false.) + call cnst_get_ind('TT_LW' , ixtt , abort=.false.) do ie=nets,nete call util_function(qdp(:,:,:,1,ie),nx,nlev,name_out1,ie) diff --git a/src/dynamics/se/dycore/prim_driver_mod.F90 b/src/dynamics/se/dycore/prim_driver_mod.F90 index 79fcbbd7fd..8c59164ce2 100644 --- a/src/dynamics/se/dycore/prim_driver_mod.F90 +++ b/src/dynamics/se/dycore/prim_driver_mod.F90 @@ -282,7 +282,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst if (r.ne.1) call TimeLevel_update(tl,"leapfrog") call prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,r) enddo - + ! defer final timelevel update until after remap and diagnostics call TimeLevel_Qdp( tl, qsplit, n0_qdp, np1_qdp) diff --git a/src/dynamics/se/stepon.F90 b/src/dynamics/se/stepon.F90 index c7f97eaf3e..bd5577f765 100644 --- a/src/dynamics/se/stepon.F90 +++ b/src/dynamics/se/stepon.F90 @@ -122,7 +122,6 @@ subroutine stepon_run2(phys_state, phys_tend, dyn_in, dyn_out) use time_mod, only: TimeLevel_Qdp use control_mod, only: qsplit use prim_advance_mod, only: calc_tot_energy_dynamics - use cam_logfile, only: iulog ! arguments diff --git a/src/physics/cam/cam_diagnostics.F90 b/src/physics/cam/cam_diagnostics.F90 index ee0c7dec7e..51dccf031d 100644 --- a/src/physics/cam/cam_diagnostics.F90 +++ b/src/physics/cam/cam_diagnostics.F90 @@ -14,7 +14,7 @@ module cam_diagnostics use cam_history, only: outfld, write_inithist, hist_fld_active, inithist_all use constituents, only: pcnst, cnst_name, cnst_longname, cnst_cam_outfld -use constituents, only: ptendnam, apcnst, bpcnst, cnst_get_ind +use constituents, only: ptendnam, dmetendnam, apcnst, bpcnst, cnst_get_ind use dycore, only: dycore_is use phys_control, only: phys_getopts use wv_saturation, only: qsat, qsat_water, svp_ice_vect @@ -242,7 +242,7 @@ subroutine diag_init_dry(pbuf2d) call register_vector_field('UAP','VAP') call addfld (apcnst(1), (/ 'lev' /), 'A','kg/kg', trim(cnst_longname(1))//' (after physics)') - if (.not.dycore_is('EUL')) then + if ( dycore_is('LR') .or. dycore_is('SE') .or. dycore_is('FV3') ) then call addfld ('TFIX', horiz_only, 'A', 'K/s', 'T fixer (T equivalent of Energy correction)') end if call addfld ('TTEND_TOT', (/ 'lev' /), 'A', 'K/s', 'Total temperature tendency') @@ -386,7 +386,7 @@ subroutine diag_init_dry(pbuf2d) call add_default ('UAP ' , history_budget_histfile_num, ' ') call add_default ('VAP ' , history_budget_histfile_num, ' ') call add_default (apcnst(1) , history_budget_histfile_num, ' ') - if (.not. dycore_is('EUL')) then + if ( dycore_is('LR') .or. dycore_is('SE') .or. dycore_is('FV3') ) then call add_default ('TFIX ' , history_budget_histfile_num, ' ') end if end if @@ -547,6 +547,18 @@ subroutine diag_init_moist(pbuf2d) if (ixcldice > 0) then call addfld (ptendnam(ixcldice),(/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name(ixcldice))//' total physics tendency ') end if + if ( dycore_is('LR') .or. dycore_is('FV3') )then + call addfld (dmetendnam( 1),(/ 'lev' /), 'A','kg/kg/s', & + trim(cnst_name( 1))//' dme adjustment tendency (FV) ') + if (ixcldliq > 0) then + call addfld (dmetendnam(ixcldliq),(/ 'lev' /), 'A','kg/kg/s', & + trim(cnst_name(ixcldliq))//' dme adjustment tendency (FV) ') + end if + if (ixcldice > 0) then + call addfld (dmetendnam(ixcldice),(/ 'lev' /), 'A','kg/kg/s', & + trim(cnst_name(ixcldice))//' dme adjustment tendency (FV) ') + end if + end if ! outfld calls in diag_physvar_ic @@ -637,6 +649,15 @@ subroutine diag_init_moist(pbuf2d) if (ixcldice > 0) then call add_default (ptendnam(ixcldice), history_budget_histfile_num, ' ') end if + if ( dycore_is('LR') .or. dycore_is('FV3') )then + call add_default(dmetendnam(1) , history_budget_histfile_num, ' ') + if (ixcldliq > 0) then + call add_default(dmetendnam(ixcldliq), history_budget_histfile_num, ' ') + end if + if (ixcldice > 0) then + call add_default(dmetendnam(ixcldice), history_budget_histfile_num, ' ') + end if + end if if( history_budget_histfile_num > 1 ) then call add_default ('DTCOND ' , history_budget_histfile_num, ' ') end if @@ -2083,7 +2104,7 @@ subroutine diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt) ! Total physics tendency for Temperature ! (remove global fixer tendency from total for FV and SE dycores) - if (.not. dycore_is('EUL')) then + if (dycore_is('LR') .or. dycore_is('SE') .or. dycore_is('FV3') ) then call check_energy_get_integrals( heat_glob_out=heat_glob ) ftem2(:ncol) = heat_glob/cpair call outfld('TFIX', ftem2, pcols, lchnk ) @@ -2123,7 +2144,7 @@ end subroutine diag_phys_tend_writeout_dry !####################################################################### subroutine diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, & - qini, cldliqini, cldiceini) + tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini) !--------------------------------------------------------------- ! @@ -2138,6 +2159,9 @@ subroutine diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, & type(physics_buffer_desc), pointer :: pbuf(:) type(physics_tend ), intent(in) :: tend real(r8), intent(in) :: ztodt ! physics timestep + real(r8), intent(inout) :: tmp_q (pcols,pver) ! As input, holds pre-adjusted tracers (FV) + real(r8), intent(inout) :: tmp_cldliq(pcols,pver) ! As input, holds pre-adjusted tracers (FV) + real(r8), intent(inout) :: tmp_cldice(pcols,pver) ! As input, holds pre-adjusted tracers (FV) real(r8), intent(in) :: qini (pcols,pver) ! tracer fields at beginning of physics real(r8), intent(in) :: cldliqini (pcols,pver) ! tracer fields at beginning of physics real(r8), intent(in) :: cldiceini (pcols,pver) ! tracer fields at beginning of physics @@ -2170,6 +2194,35 @@ subroutine diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, & end if end if + ! Tendency for dry mass adjustment of q (FV only) + + if (dycore_is('LR') .or. dycore_is('FV3') ) then + tmp_q (:ncol,:pver) = (state%q(:ncol,:pver, 1) - tmp_q (:ncol,:pver))*rtdt + if (ixcldliq > 0) then + tmp_cldliq(:ncol,:pver) = (state%q(:ncol,:pver,ixcldliq) - tmp_cldliq(:ncol,:pver))*rtdt + else + tmp_cldliq(:ncol,:pver) = 0.0_r8 + end if + if (ixcldice > 0) then + tmp_cldice(:ncol,:pver) = (state%q(:ncol,:pver,ixcldice) - tmp_cldice(:ncol,:pver))*rtdt + else + tmp_cldice(:ncol,:pver) = 0.0_r8 + end if + if ( cnst_cam_outfld( 1) ) then + call outfld (dmetendnam( 1), tmp_q , pcols, lchnk) + end if + if (ixcldliq > 0) then + if ( cnst_cam_outfld(ixcldliq) ) then + call outfld (dmetendnam(ixcldliq), tmp_cldliq, pcols, lchnk) + end if + end if + if (ixcldice > 0) then + if ( cnst_cam_outfld(ixcldice) ) then + call outfld (dmetendnam(ixcldice), tmp_cldice, pcols, lchnk) + end if + end if + end if + ! Total physics tendency for moisture and other tracers if ( cnst_cam_outfld( 1) ) then @@ -2193,7 +2246,8 @@ end subroutine diag_phys_tend_writeout_moist !####################################################################### - subroutine diag_phys_tend_writeout(state, pbuf, tend, ztodt, qini, cldliqini, cldiceini) + subroutine diag_phys_tend_writeout(state, pbuf, tend, ztodt, & + tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini) !--------------------------------------------------------------- ! @@ -2208,6 +2262,9 @@ subroutine diag_phys_tend_writeout(state, pbuf, tend, ztodt, qini, cldliqini, c type(physics_buffer_desc), pointer :: pbuf(:) type(physics_tend ), intent(in) :: tend real(r8), intent(in) :: ztodt ! physics timestep + real(r8) , intent(inout) :: tmp_q (pcols,pver) ! As input, holds pre-adjusted tracers (FV) + real(r8), intent(inout) :: tmp_cldliq(pcols,pver) ! As input, holds pre-adjusted tracers (FV) + real(r8), intent(inout) :: tmp_cldice(pcols,pver) ! As input, holds pre-adjusted tracers (FV) real(r8), intent(in) :: qini (pcols,pver) ! tracer fields at beginning of physics real(r8), intent(in) :: cldliqini (pcols,pver) ! tracer fields at beginning of physics real(r8), intent(in) :: cldiceini (pcols,pver) ! tracer fields at beginning of physics @@ -2217,7 +2274,7 @@ subroutine diag_phys_tend_writeout(state, pbuf, tend, ztodt, qini, cldliqini, c call diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt) if (moist_physics) then call diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, & - qini, cldliqini, cldiceini) + tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini) end if end subroutine diag_phys_tend_writeout diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 383d9e32fa..657b0b1952 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -238,7 +238,7 @@ subroutine check_energy_init() end subroutine check_energy_init -!================================================================================================ +!=============================================================================== subroutine check_energy_timestep_init(state, tend, pbuf, col_type) use physconst, only: get_hydrostatic_energy @@ -1038,11 +1038,11 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix, vc) vc_loc, ps = state%ps(1:ncol), phis = state%phis(1:ncol), & z = state%z_ini(1:ncol,:), se = se, ke = ke, wv = wv, liq = liq, ice = ice) - call cnst_get_ind('TT_UN' , ixtt , abort=.false.) + call cnst_get_ind('TT_LW' , ixtt , abort=.false.) tt = 0._r8 if (ixtt > 1) then - if (name_out6 == 'TT_phAM'.or.name_out6 == 'TT_dyAM') then + if (name_out6 == 'TT_pAM'.or.name_out6 == 'TT_zAM') then ! ! after dme_adjust mixing ratios are all wet ! diff --git a/src/physics/cam/constituents.F90 b/src/physics/cam/constituents.F90 index 404bbcec24..528f254497 100644 --- a/src/physics/cam/constituents.F90 +++ b/src/physics/cam/constituents.F90 @@ -72,6 +72,7 @@ module constituents character(len=16), public :: fixcnam (pcnst) ! names of species slt fixer tendencies character(len=16), public :: tendnam (pcnst) ! names of total tendencies of species character(len=16), public :: ptendnam (pcnst) ! names of total physics tendencies of species +character(len=16), public :: dmetendnam(pcnst) ! names of dme adjusted tracers (FV) character(len=16), public :: sflxnam (pcnst) ! names of surface fluxes of species character(len=16), public :: tottnam (pcnst) ! names for horz + vert + fixer tendencies @@ -496,6 +497,7 @@ subroutine cnst_chk_dim fixcnam (m) = 'DF'//cnst_name(m) tendnam (m) = 'TE'//cnst_name(m) ptendnam (m) = 'PTE'//cnst_name(m) + dmetendnam(m) = 'DME'//cnst_name(m) tottnam (m) = 'TA'//cnst_name(m) sflxnam(m) = 'SF'//cnst_name(m) end do diff --git a/src/physics/cam/physics_types.F90 b/src/physics/cam/physics_types.F90 index 308b88e8d7..a53d6306c5 100644 --- a/src/physics/cam/physics_types.F90 +++ b/src/physics/cam/physics_types.F90 @@ -8,8 +8,7 @@ module physics_types use constituents, only: pcnst, qmin, cnst_name, cnst_get_ind use geopotential, only: geopotential_dse, geopotential_t use physconst, only: zvir, gravit, cpair, rair, cpairv, rairv - use phys_grid, only: get_ncols_p, get_rlon_all_p, get_rlat_all_p, get_gcol_all_p, & - get_area_all_p + use phys_grid, only: get_ncols_p, get_rlon_all_p, get_rlat_all_p, get_gcol_all_p use cam_logfile, only: iulog use cam_abortutils, only: endrun use phys_control, only: waccmx_is @@ -142,6 +141,7 @@ module physics_types integer :: psetcols=0 ! max number of columns set- if subcols = pcols*psubcols, else = pcols character*24 :: name ! name of parameterization which produced tendencies. + logical :: & ls = .false., &! true if dsdt is returned lu = .false., &! true if dudt is returned @@ -439,6 +439,7 @@ subroutine physics_update(state, ptend, dt, tend) end if if (state_debug_checks) call physics_state_check(state, ptend%name) + deallocate(cpairv_loc, rairv_loc) ! Deallocate ptend @@ -1071,7 +1072,6 @@ subroutine physics_state_set_grid(lchnk, phys_state) !----------------------------------------------------------------------- ! Set the grid components of the physics_state object !----------------------------------------------------------------------- - use physconst, only: pi integer, intent(in) :: lchnk type(physics_state), intent(inout) :: phys_state @@ -1080,7 +1080,6 @@ subroutine physics_state_set_grid(lchnk, phys_state) integer :: i, ncol real(r8) :: rlon(pcols) real(r8) :: rlat(pcols) - real(r8) :: area(pcols) !----------------------------------------------------------------------- ! get_ncols_p requires a state which does not have sub-columns @@ -1097,13 +1096,11 @@ subroutine physics_state_set_grid(lchnk, phys_state) call get_rlon_all_p(lchnk, ncol, rlon) call get_rlat_all_p(lchnk, ncol, rlat) - call get_area_all_p(lchnk, ncol, area) phys_state%ncol = ncol phys_state%lchnk = lchnk do i=1,ncol phys_state%lat(i) = rlat(i) phys_state%lon(i) = rlon(i) -!!jt phys_state%area_scale(i,:) = area(i)/4.0_r8*pi end do call init_geo_unique(phys_state,ncol) @@ -1245,7 +1242,7 @@ subroutine physics_dme_adjust(state, tend, qini, dt) ! type(physics_state), intent(inout) :: state type(physics_tend ), intent(inout) :: tend - real(r8), intent(in ) :: fdq3d(pcols,pver) ! water increment + real(r8), intent(in ) :: qini(pcols,pver) ! initial specific humidity real(r8), intent(in ) :: dt ! model physics timestep ! !---------------------------Local workspace----------------------------- @@ -1258,7 +1255,7 @@ subroutine physics_dme_adjust(state, tend, qini, dt) real(r8) :: utmp(pcols) ! temp variable for recalculating the initial u values real(r8) :: vtmp(pcols) ! temp variable for recalculating the initial v values - real(r8) :: zvirv(pcols,pver) ! Local zvir array pointer + real(r8) :: zvirv(pcols,pver) ! Local zvir array pointer real(r8),allocatable :: cpairv_loc(:,:) ! @@ -1278,8 +1275,10 @@ subroutine physics_dme_adjust(state, tend, qini, dt) ! constituents, momentum, and total energy state%ps(:ncol) = state%pint(:ncol,1) do k = 1, pver - ! adjusment factor is change in thermodynamically active water species - fdq(:ncol) = 1._r8 + fdq3d(:ncol,k) + + ! adjusment factor is just change in water vapor + fdq(:ncol) = 1._r8 + state%q(:ncol,k,1) - qini(:ncol,k) + ! adjust constituents to conserve mass in each layer do m = 1, pcnst state%q(:ncol,k,m) = state%q(:ncol,k,m) / fdq(:ncol) diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index f8db3df50b..373f1c6c7f 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -72,8 +72,8 @@ module physpkg integer :: sgh30_idx = 0 integer :: qini_idx = 0 - integer :: liqini_idx = 0 - integer :: iceini_idx = 0 + integer :: cldliqini_idx = 0 + integer :: cldiceini_idx = 0 integer :: prec_str_idx = 0 integer :: snow_str_idx = 0 @@ -98,7 +98,7 @@ module physpkg subroutine phys_register !----------------------------------------------------------------------- ! - ! Purpose: Register budgets, constituents and physics buffer fields. + ! Purpose: Register constituents and physics buffer fields. ! ! Author: CSM Contact: M. Vertenstein, Aug. 1997 ! B.A. Boville, Oct 2001 @@ -232,8 +232,8 @@ subroutine phys_register ! Fields for physics package diagnostics call pbuf_add_field('QINI', 'physpkg', dtype_r8, (/pcols,pver/), qini_idx) - call pbuf_add_field('LIQINI', 'physpkg', dtype_r8, (/pcols,pver/), liqini_idx) - call pbuf_add_field('ICEINI', 'physpkg', dtype_r8, (/pcols,pver/), iceini_idx) + call pbuf_add_field('CLDLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), cldliqini_idx) + call pbuf_add_field('CLDICEINI', 'physpkg', dtype_r8, (/pcols,pver/), cldiceini_idx) ! check energy package call check_energy_register @@ -823,9 +823,6 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) call physics_type_alloc(phys_state, phys_tend, begchunk, endchunk, pcols) - ! Initialize budget variables -!jt call budget_init() - do lchnk = begchunk, endchunk call physics_state_set_grid(lchnk, phys_state(lchnk)) call check_energy_budget_init(phys_state(lchnk)) @@ -1072,12 +1069,6 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) dtcore_idx = pbuf_get_index('DTCORE') dqcore_idx = pbuf_get_index('DQCORE') -!!$ ! addfld calls for budget stages and diffs -!!$ do i=1,budget_num -!!$ call budget_info(i, name=budget_name, longname=budget_longname) -!!$ write(iulog,*)'addfld i,budget_name=',i,budget_name,budget_num -!!$ if (budget_outfld(i)) call addfld(trim(budget_name), horiz_only, 'A', 'W/m2', trim(budget_longname)) -!!$ end do end subroutine phys_init ! @@ -1400,8 +1391,6 @@ subroutine tphysac (ztodt, cam_in, & use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_tend ! WACCM-X use aoa_tracers, only: aoa_tracers_timestep_tend use physconst, only: rhoh2o, latvap,latice - use physconst, only: dry_air_species_num,thermodynamic_active_species_num - use physconst, only: thermodynamic_active_species_idx use dyn_tests_utils, only: vc_dycore use aero_model, only: aero_model_drydep use carma_intr, only: carma_emission_tend, carma_timestep_tend @@ -1453,7 +1442,6 @@ subroutine tphysac (ztodt, cam_in, & integer :: lchnk ! chunk identifier integer :: ncol ! number of atmospheric columns integer i,k,m ! Longitude, level indices - integer :: m_cnst ! tracer index integer :: yr, mon, day, tod ! components of a date integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water. integer :: ixq @@ -1466,11 +1454,12 @@ subroutine tphysac (ztodt, cam_in, & real(r8) obklen(pcols) ! Obukhov length real(r8) :: fh2o(pcols) ! h2o flux to balance source from methane chemistry real(r8) :: flx_heat(pcols) ! Heat flux for check_energy_chng. + real(r8) :: tmp_q (pcols,pver) ! tmp space + real(r8) :: tmp_cldliq(pcols,pver) ! tmp space + real(r8) :: tmp_cldice(pcols,pver) ! tmp space real(r8) :: tmp_trac (pcols,pver,pcnst) ! tmp space real(r8) :: tmp_pdel (pcols,pver) ! tmp space real(r8) :: tmp_ps (pcols) ! tmp space - real(r8) :: tot_water (pcols,pver,2) ! total water (initial, present) - real(r8) :: tot_water_chg(pcols,pver) ! total water change logical :: moist_mixing_ratio_dycore ! physics buffer fields for total energy and mass adjustment @@ -1478,8 +1467,8 @@ subroutine tphysac (ztodt, cam_in, & real(r8), pointer, dimension(:,:) :: cld real(r8), pointer, dimension(:,:) :: qini - real(r8), pointer, dimension(:,:) :: liqini - real(r8), pointer, dimension(:,:) :: iceini + real(r8), pointer, dimension(:,:) :: cldliqini + real(r8), pointer, dimension(:,:) :: cldiceini real(r8), pointer, dimension(:,:) :: dtcore real(r8), pointer, dimension(:,:) :: dqcore real(r8), pointer, dimension(:,:) :: ducore @@ -1512,8 +1501,8 @@ subroutine tphysac (ztodt, cam_in, & call pbuf_get_field(pbuf, dvcore_idx, dvcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, qini_idx, qini) - call pbuf_get_field(pbuf, liqini_idx, liqini) - call pbuf_get_field(pbuf, iceini_idx, iceini) + call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) + call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) ifld = pbuf_get_index('CLD') call pbuf_get_field(pbuf, ifld, cld, start=(/1,1,itim_old/),kount=(/pcols,pver,1/)) @@ -1856,7 +1845,7 @@ subroutine tphysac (ztodt, cam_in, & end if call calc_te_and_aam_budgets(state, 'phAP') - call calc_te_and_aam_budgets(state, 'dyAP', vc=vc_dycore) + call calc_te_and_aam_budgets(state, 'dyAP',vc=vc_dycore) !--------------------------------------------------------------------------------- ! Enforce charge neutrality after O+ change from ionos_tend @@ -1932,26 +1921,7 @@ subroutine tphysac (ztodt, cam_in, & call set_dry_to_wet(state) -#ifdef ALL_WATER_IN_DP - ! - ! initial total water - ! - tot_water(:ncol,:pver,1) = qini(:ncol,:pver)+liqini(:ncol,:pver)+iceini(:ncol,:pver) - ! - ! total water "now" - ! - tot_water(:ncol,:pver,2) = 0.0_r8 - do m_cnst=dry_air_species_num+1,thermodynamic_active_species_num - m = thermodynamic_active_species_idx(m_cnst) - tot_water(:ncol,:pver,2) = tot_water(:ncol,:pver,2)+state%q(:ncol,:pver,m) - end do - tot_water_chg(:ncol,:pver) = tot_water(:ncol,:pver,2) - tot_water(:ncol,:pver,1) -#else - tot_water(:ncol,:pver,1) = qini(:ncol,:pver) - tot_water(:ncol,:pver,2) = state%q(:ncol,:pver,1) - tot_water_chg(:ncol,:pver) = tot_water(:ncol,:pver,2) - tot_water(:ncol,:pver,1) -#endif - call physics_dme_adjust(state, tend, tot_water_chg, ztodt) + call physics_dme_adjust(state, tend, qini, ztodt) call calc_te_and_aam_budgets(state, 'phAM') call calc_te_and_aam_budgets(state, 'dyAM', vc=vc_dycore) @@ -1967,26 +1937,8 @@ subroutine tphysac (ztodt, cam_in, & call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat) end if -#ifdef ALL_WATER_IN_DP - ! - ! initial total water - ! - tot_water(:ncol,:pver,1) = qini(:ncol,:pver)+liqini(:ncol,:pver)+iceini(:ncol,:pver) - ! - ! total water "now" - ! - tot_water(:ncol,:pver,2) = 0.0_r8 - do m_cnst=dry_air_species_num+1,thermodynamic_active_species_num - m = thermodynamic_active_species_idx(m_cnst) - tot_water(:ncol,:pver,2) = tot_water(:ncol,:pver,2)+state%q(:ncol,:pver,m) - end do - tot_water_chg(:ncol,:pver) = tot_water(:ncol,:pver,2) - tot_water(:ncol,:pver,1) -#else - tot_water(:ncol,:pver,1) = qini(:ncol,:pver) - tot_water(:ncol,:pver,2) = state%q(:ncol,:pver,1) - tot_water_chg(:ncol,:pver) = tot_water(:ncol,:pver,2) - tot_water(:ncol,:pver,1) -#endif - call physics_dme_adjust(state, tend, tot_water_chg, ztodt) + + call physics_dme_adjust(state, tend, qini, ztodt) if (trim(cam_take_snapshot_after) == "physics_dme_adjust") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& @@ -2024,14 +1976,15 @@ subroutine tphysac (ztodt, cam_in, & endif endif - call diag_phys_tend_writeout (state, pbuf, tend, ztodt, qini, liqini, iceini) + call diag_phys_tend_writeout (state, pbuf, tend, ztodt, tmp_q, tmp_cldliq, tmp_cldice, & + qini, cldliqini, cldiceini) call clybry_fam_set( ncol, lchnk, map2chm, state%q, pbuf ) end subroutine tphysac subroutine tphysbc (ztodt, state, & - tend, pbuf, & + tend, pbuf, & cam_out, cam_in ) !----------------------------------------------------------------------- ! @@ -2078,8 +2031,6 @@ subroutine tphysbc (ztodt, state, & use cam_diagnostics, only: diag_clip_tend_writeout use cam_history, only: outfld use physconst, only: cpair, latvap - use physconst, only: thermodynamic_active_species_liq_num,thermodynamic_active_species_liq_idx - use physconst, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_ice_idx use constituents, only: pcnst, qmin, cnst_get_ind use convect_deep, only: convect_deep_tend, convect_deep_tend_2, deep_scheme_does_scav_trans use time_manager, only: is_first_step, get_nstep @@ -2155,7 +2106,6 @@ subroutine tphysbc (ztodt, state, & integer :: i ! column indicex integer :: ixcldice, ixcldliq, ixq ! constituent indices for cloud liquid and ice water. - integer :: m, m_cnst ! for macro/micro co-substepping integer :: macmic_it ! iteration variables real(r8) :: cld_macmic_ztodt ! modified timestep @@ -2167,8 +2117,8 @@ subroutine tphysbc (ztodt, state, & ! physics buffer fields for total energy and mass adjustment real(r8), pointer, dimension(: ) :: teout real(r8), pointer, dimension(:,:) :: qini - real(r8), pointer, dimension(:,:) :: liqini - real(r8), pointer, dimension(:,:) :: iceini + real(r8), pointer, dimension(:,:) :: cldliqini + real(r8), pointer, dimension(:,:) :: cldiceini real(r8), pointer, dimension(:,:) :: dtcore real(r8), pointer, dimension(:,:) :: dqcore real(r8), pointer, dimension(:,:) :: ducore @@ -2242,8 +2192,8 @@ subroutine tphysbc (ztodt, state, & call pbuf_get_field(pbuf, teout_idx, teout, (/1,itim_old/), (/pcols,1/)) call pbuf_get_field(pbuf, qini_idx, qini) - call pbuf_get_field(pbuf, liqini_idx, liqini) - call pbuf_get_field(pbuf, iceini_idx, iceini) + call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) + call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) call pbuf_get_field(pbuf, dtcore_idx, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, dqcore_idx, dqcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) @@ -2289,44 +2239,26 @@ subroutine tphysbc (ztodt, state, & !=================================================== call t_startf('energy_fixer') - call calc_te_and_aam_budgets(state, 'phBF' ) - call calc_te_and_aam_budgets(state, 'dyBF', vc=vc_dycore) - + call calc_te_and_aam_budgets(state, 'phBF') + call calc_te_and_aam_budgets(state, 'dyBF',vc=vc_dycore) if (.not.dycore_is('EUL')) then call check_energy_fix(state, ptend, nstep, flx_heat) call physics_update(state, ptend, ztodt, tend) call check_energy_chng(state, tend, "chkengyfix", nstep, ztodt, zero, zero, zero, flx_heat) call outfld( 'EFIX', flx_heat , pcols, lchnk ) end if - call calc_te_and_aam_budgets(state, 'phBP') - call calc_te_and_aam_budgets(state, 'dyBP', vc=vc_dycore) + call calc_te_and_aam_budgets(state, 'dyBP',vc=vc_dycore) ! Save state for convective tendency calculations. call diag_conv_tend_ini(state, pbuf) -#ifdef ALL_WATER_IN_DP call cnst_get_ind('Q', ixq) call cnst_get_ind('CLDLIQ', ixcldliq) call cnst_get_ind('CLDICE', ixcldice) qini (:ncol,:pver) = state%q(:ncol,:pver, 1) - liqini(:ncol,:pver) = 0.0_r8 - do m_cnst=1,thermodynamic_active_species_liq_num - m = thermodynamic_active_species_liq_idx(m_cnst) - liqini(:ncol,:pver) = liqini(:ncol,:pver)+state%q(:ncol,:pver,m) - end do - iceini(:ncol,:pver) = 0.0_r8 - do m_cnst=1,thermodynamic_active_species_ice_num - m = thermodynamic_active_species_ice_idx(m_cnst) - iceini(:ncol,:pver) = iceini(:ncol,:pver)+state%q(:ncol,:pver,m) - end do -#else - call cnst_get_ind('Q', ixq) - call cnst_get_ind('CLDLIQ', ixcldliq) - call cnst_get_ind('CLDICE', ixcldice) - qini (:ncol,:pver) = state%q(:ncol,:pver, 1) - liqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) - iceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) -#endif + cldliqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) + cldiceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) + call outfld('TEOUT', teout , pcols, lchnk ) call outfld('TEINP', state%te_ini(:,dyn_te_idx), pcols, lchnk ) call outfld('TEFIX', state%te_cur(:,dyn_te_idx), pcols, lchnk ) diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index 7d0bbbab5b..66839344a8 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -69,8 +69,8 @@ module physpkg integer :: sgh30_idx = 0 integer :: qini_idx = 0 - integer :: liqini_idx = 0 - integer :: iceini_idx = 0 + integer :: cldliqini_idx = 0 + integer :: cldiceini_idx = 0 integer :: prec_str_idx = 0 integer :: snow_str_idx = 0 @@ -191,8 +191,8 @@ subroutine phys_register ! Fields for physics package diagnostics call pbuf_add_field('QINI', 'physpkg', dtype_r8, (/pcols,pver/), qini_idx) - call pbuf_add_field('LIQINI', 'physpkg', dtype_r8, (/pcols,pver/), liqini_idx) - call pbuf_add_field('ICEINI', 'physpkg', dtype_r8, (/pcols,pver/), iceini_idx) + call pbuf_add_field('CLDLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), cldliqini_idx) + call pbuf_add_field('CLDICEINI', 'physpkg', dtype_r8, (/pcols,pver/), cldiceini_idx) ! check energy package call check_energy_register @@ -1302,9 +1302,6 @@ subroutine tphysac (ztodt, cam_in, & use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_tend ! WACCM-X use aoa_tracers, only: aoa_tracers_timestep_tend use physconst, only: rhoh2o - use physconst, only: dry_air_species_num,thermodynamic_active_species_num - use physconst, only: thermodynamic_active_species_liq_num,thermodynamic_active_species_liq_idx - use physconst, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_ice_idx use aero_model, only: aero_model_drydep use check_energy, only: check_energy_chng, calc_te_and_aam_budgets use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng @@ -1434,11 +1431,12 @@ subroutine tphysac (ztodt, cam_in, & real(r8) obklen(pcols) ! Obukhov length real(r8) :: fh2o(pcols) ! h2o flux to balance source from methane chemistry real(r8) :: flx_heat(pcols) ! Heat flux for check_energy_chng. + real(r8) :: tmp_q (pcols,pver) ! tmp space + real(r8) :: tmp_cldliq(pcols,pver) ! tmp space + real(r8) :: tmp_cldice(pcols,pver) ! tmp space real(r8) :: tmp_trac (pcols,pver,pcnst) ! tmp space real(r8) :: tmp_pdel (pcols,pver) ! tmp space real(r8) :: tmp_ps (pcols) ! tmp space - real(r8) :: tot_water (pcols,pver,2) ! total water (initial, present) - real(r8) :: tot_water_chg(pcols,pver) ! total water change logical :: moist_mixing_ratio_dycore ! physics buffer fields for total energy and mass adjustment @@ -1446,8 +1444,8 @@ subroutine tphysac (ztodt, cam_in, & real(r8), pointer, dimension(:,:) :: cld real(r8), pointer, dimension(:,:) :: qini - real(r8), pointer, dimension(:,:) :: liqini - real(r8), pointer, dimension(:,:) :: iceini + real(r8), pointer, dimension(:,:) :: cldliqini + real(r8), pointer, dimension(:,:) :: cldiceini real(r8), pointer, dimension(:,:) :: dtcore real(r8), pointer, dimension(:,:) :: dqcore real(r8), pointer, dimension(:,:) :: ducore @@ -2285,6 +2283,11 @@ subroutine tphysac (ztodt, cam_in, & moist_mixing_ratio_dycore = dycore_is('LR').or. dycore_is('FV3') if (moist_mixing_ratio_dycore) call set_dry_to_wet(state) ! Physics had dry, dynamics wants moist + ! Scale dry mass and energy (does nothing if dycore is EUL or SLD) + tmp_q (:ncol,:pver) = state%q(:ncol,:pver,ixq) + tmp_cldliq(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) + tmp_cldice(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) + ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. ! So, save off tracers if (.not.moist_mixing_ratio_dycore.and.& @@ -2297,26 +2300,8 @@ subroutine tphysac (ztodt, cam_in, & call set_dry_to_wet(state) -#ifdef ALL_WATER_IN_DP - ! - ! initial total water - ! - tot_water(:ncol,:pver,1) = qini(:ncol,:pver)+liqini(:ncol,:pver)+iceini(:ncol,:pver) - ! - ! total water "now" - ! - tot_water(:ncol,:pver,2) = 0.0_r8 - do m_cnst=dry_air_species_num+1,thermodynamic_active_species_num - m = thermodynamic_active_species_idx(m_cnst) - tot_water(:ncol,:pver,2) = tot_water(:ncol,:pver,2)+state%q(:ncol,:pver,m) - end do - tot_water_chg(:ncol,:pver) = tot_water(:ncol,:pver,2) - tot_water(:ncol,:pver,1) -#else - tot_water(:ncol,:pver,1) = qini(:ncol,:pver) - tot_water(:ncol,:pver,2) = state%q(:ncol,:pver,1) - tot_water_chg(:ncol,:pver) = tot_water(:ncol,:pver,2) - tot_water(:ncol,:pver,1) -#endif - call physics_dme_adjust(state, tend, tot_water_chg, ztodt) + + call physics_dme_adjust(state, tend, qini, ztodt) call calc_te_and_aam_budgets(state, 'phAM') call calc_te_and_aam_budgets(state, 'dyAM',vc=vc_dycore) @@ -2332,26 +2317,8 @@ subroutine tphysac (ztodt, cam_in, & call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) end if -#ifdef ALL_WATER_IN_DP - ! - ! initial total water - ! - tot_water(:ncol,:pver,1) = qini(:ncol,:pver)+liqini(:ncol,:pver)+iceini(:ncol,:pver) - ! - ! total water "now" - ! - tot_water(:ncol,:pver,2) = 0.0_r8 - do m_cnst=dry_air_species_num+1,thermodynamic_active_species_num - m = thermodynamic_active_species_idx(m_cnst) - tot_water(:ncol,:pver,2) = tot_water(:ncol,:pver,2)+state%q(:ncol,:pver,m) - end do - tot_water_chg(:ncol,:pver) = tot_water(:ncol,:pver,2) - tot_water(:ncol,:pver,1) -#else - tot_water(:ncol,:pver,1) = qini(:ncol,:pver) - tot_water(:ncol,:pver,2) = state%q(:ncol,:pver,1) - tot_water_chg(:ncol,:pver) = tot_water(:ncol,:pver,2) - tot_water(:ncol,:pver,1) -#endif - call physics_dme_adjust(state, tend, tot_water_chg, ztodt) + + call physics_dme_adjust(state, tend, qini, ztodt) if (trim(cam_take_snapshot_after) == "physics_dme_adjust") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& @@ -2388,7 +2355,8 @@ subroutine tphysac (ztodt, cam_in, & endif endif - call diag_phys_tend_writeout (state, pbuf, tend, ztodt, qini, liqini, iceini) + call diag_phys_tend_writeout (state, pbuf, tend, ztodt, tmp_q, tmp_cldliq, tmp_cldice, & + qini, cldliqini, cldiceini) call clybry_fam_set( ncol, lchnk, map2chm, state%q, pbuf ) @@ -2495,8 +2463,8 @@ subroutine tphysbc (ztodt, state, & ! physics buffer fields for total energy and mass adjustment real(r8), pointer, dimension(: ) :: teout real(r8), pointer, dimension(:,:) :: qini - real(r8), pointer, dimension(:,:) :: liqini - real(r8), pointer, dimension(:,:) :: iceini + real(r8), pointer, dimension(:,:) :: cldliqini + real(r8), pointer, dimension(:,:) :: cldiceini real(r8), pointer, dimension(:,:) :: dtcore real(r8), pointer, dimension(:,:) :: dqcore real(r8), pointer, dimension(:,:) :: ducore @@ -2559,8 +2527,8 @@ subroutine tphysbc (ztodt, state, & call pbuf_get_field(pbuf, teout_idx, teout, (/1,itim_old/), (/pcols,1/)) call pbuf_get_field(pbuf, qini_idx, qini) - call pbuf_get_field(pbuf, liqini_idx, liqini) - call pbuf_get_field(pbuf, iceini_idx, iceini) + call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) + call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) call pbuf_get_field(pbuf, dtcore_idx, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, dqcore_idx, dqcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) @@ -2622,29 +2590,12 @@ subroutine tphysbc (ztodt, state, & ! Save state for convective tendency calculations. call diag_conv_tend_ini(state, pbuf) -#ifdef ALL_WATER_IN_DP - call cnst_get_ind('Q', ixq) - call cnst_get_ind('CLDLIQ', ixcldliq) - call cnst_get_ind('CLDICE', ixcldice) - qini (:ncol,:pver) = state%q(:ncol,:pver, 1) - liqini(:ncol,:pver) = 0.0_r8 - do m_cnst=1,thermodynamic_active_species_liq_num - m = thermodynamic_active_species_liq_idx(m_cnst) - liqini(:ncol,:pver) = liqini(:ncol,:pver)+state%q(:ncol,:pver,m) - end do - iceini(:ncol,:pver) = 0.0_r8 - do m_cnst=1,thermodynamic_active_species_ice_num - m = thermodynamic_active_species_ice_idx(m_cnst) - iceini(:ncol,:pver) = iceini(:ncol,:pver)+state%q(:ncol,:pver,m) - end do -#else call cnst_get_ind('Q', ixq) call cnst_get_ind('CLDLIQ', ixcldliq) call cnst_get_ind('CLDICE', ixcldice) - qini (:ncol,:pver) = state%q(:ncol,:pver, 1) - liqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) - iceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) -#endif + qini (:ncol,:pver) = state%q(:ncol,:pver, ixq) + cldliqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) + cldiceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) call outfld('TEOUT', teout , pcols, lchnk ) call outfld('TEINP', state%te_ini(:,dyn_te_idx), pcols, lchnk ) From f4647a8c509f765bad089effad294d7d4060bddf Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 8 Sep 2022 10:09:27 -0600 Subject: [PATCH 010/140] updates to get MPAS budgets working, next step to refactor to make consistent with se changes --- Externals.cfg | 4 +- src/control/budgets.F90 | 36 ++++- src/dynamics/mpas/dp_coupling.F90 | 61 ++++++++- src/dynamics/mpas/dyn_comp.F90 | 214 +++++++++++++++++++++++++++++- 4 files changed, 298 insertions(+), 17 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index b29291a7da..da2f21f661 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -79,9 +79,9 @@ externals = Externals_CISM.cfg required = True [clm] -tag = ctsm5.1.dev103 +branch = ctsm5.1.dev103addmpasagrids protocol = git -repo_url = https://github.com/ESCOMP/CTSM +repo_url = https://github.com/jtruesdal/ctsm local_path = components/clm externals = Externals_CLM.cfg required = True diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index cb650e9d55..f82cfc6366 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -57,6 +57,7 @@ module budgets character(len=32), public, protected :: budget_stg2name(budget_array_max) integer, public, protected :: budget_stg1stateidx(budget_array_max) integer, public, protected :: budget_stg2stateidx(budget_array_max) +real(r8), public, protected :: budget_globals(budget_array_max) ! ! Constants for each budget @@ -105,7 +106,7 @@ subroutine budget_readnl(nlfile) end subroutine budget_readnl -subroutine budget_stage_add (name, pkgtype, longname, outfld) +subroutine budget_stage_add (name, pkgtype, longname, outfld, subcycle) ! Register a budget. @@ -118,6 +119,8 @@ subroutine budget_stage_add (name, pkgtype, longname, outfld) longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) logical, intent(in), optional :: & outfld ! true => default CAM output of budget in kg/kg + logical, intent(in), optional :: & + subcycle ! true => This budget is subcycled integer :: state_idx ! dyn/phy state budget index (in q array) character(len=*), parameter :: sub='budget_stage_add' character(len=128) :: errmsg @@ -158,11 +161,16 @@ subroutine budget_stage_add (name, pkgtype, longname, outfld) budget_optype(budget_num)='stg' budget_pkgtype(budget_num)=pkgtype budget_state_ind(budget_num)=state_idx + if (present(subcycle)) then + budget_subcycle(budget_num)=subcycle + else + budget_subcycle(budget_num)=.false. + end if end subroutine budget_stage_add !!$!============================================================================== -subroutine budget_diff_add (name, stg1name, stg2name, pkgtype, optype, longname, outfld) +subroutine budget_diff_add (name, stg1name, stg2name, pkgtype, optype, longname, outfld, subcycle) ! Register a budget. @@ -181,6 +189,9 @@ subroutine budget_diff_add (name, stg1name, stg2name, pkgtype, optype, longname, logical, intent(in), optional :: & outfld ! true => default CAM output of budget in kg/kg + logical, intent(in), optional :: & + subcycle ! true => if this budget is subcycled + character(len=*), parameter :: sub='budget_diff_add' character(len=128) :: errmsg integer :: state_idx @@ -216,7 +227,6 @@ subroutine budget_diff_add (name, stg1name, stg2name, pkgtype, optype, longname, budget_stg2index(budget_num) = budget_ind_byname(trim(stg2name)) budget_stg1stateidx(budget_num) = budget_state_ind(budget_stg1index(budget_num)) budget_stg2stateidx(budget_num) = budget_state_ind(budget_stg2index(budget_num)) - ! set outfld type ! (false: the module declaring the budget is responsible for outfld calls) if (present(outfld)) then @@ -227,6 +237,11 @@ subroutine budget_diff_add (name, stg1name, stg2name, pkgtype, optype, longname, budget_optype(budget_num)=optype budget_state_ind(budget_num)=state_idx + if (present(subcycle)) then + budget_subcycle(budget_num)=subcycle + else + budget_subcycle(budget_num)=.false. + end if end subroutine budget_diff_add !============================================================================== @@ -266,7 +281,7 @@ end function budget_type_byind !============================================================================================== -subroutine budget_info_byname(name, budget_ind, longname, stg1name, stg1stateidx, stg1index, stg2name, stg2stateidx, stg2index, optype, pkgtype,state_ind) +subroutine budget_info_byname(name, budget_ind, longname, stg1name, stg1stateidx, stg1index, stg2name, stg2stateidx, stg2index, optype, pkgtype,state_ind,subcycle,outfld) ! Return the mixing ratio name of a budget @@ -286,6 +301,9 @@ subroutine budget_info_byname(name, budget_ind, longname, stg1name, stg1stateidx character(len=3), intent(out), optional :: & optype, &! budget type difference or stage pkgtype ! physics or dynamics budget + logical, intent(out), optional :: & + subcycle, &! + outfld !---------------------------Local workspace----------------------------- character(len=*), parameter :: sub='budget_info_byname' @@ -299,6 +317,8 @@ subroutine budget_info_byname(name, budget_ind, longname, stg1name, stg1stateidx if (present(optype)) optype=budget_optype(b_ind) if (present(pkgtype)) pkgtype=budget_pkgtype(b_ind) if (present(state_ind)) state_ind=budget_state_ind(b_ind) + if (present(subcycle)) subcycle=budget_subcycle(b_ind) + if (present(outfld)) outfld=budget_out(b_ind) if (budget_optype(b_ind)=='dif' .or. budget_optype(b_ind)=='sum') then if (present(stg1name))stg1name=budget_stg1name(b_ind) if (present(stg2name))stg2name=budget_stg2name(b_ind) @@ -318,7 +338,7 @@ subroutine budget_info_byname(name, budget_ind, longname, stg1name, stg1stateidx end if end subroutine budget_info_byname - subroutine budget_info_byind(budget_ind, name, longname, stg1name, stg1stateidx, stg1index, stg2name, stg2stateidx, stg2index, optype, pkgtype,state_ind) + subroutine budget_info_byind(budget_ind, name, longname, stg1name, stg1stateidx, stg1index, stg2name, stg2stateidx, stg2index, optype, pkgtype,state_ind,subcycle,outfld) ! Return the mixing ratio name of a budget @@ -338,17 +358,22 @@ subroutine budget_info_byind(budget_ind, name, longname, stg1name, stg1stateidx, character(len=3), intent(out), optional :: & optype, &! budget type difference or stage pkgtype ! physics or dynamics budget + logical, intent(out), optional :: & + subcycle, &! + outfld !---------------------------Local workspace----------------------------- character(len=*), parameter :: sub='budget_info_byind' character(len=128) :: errmsg !----------------------------------------------------------------------- if (budget_ind > 0 .and. budget_ind <= budget_array_max) then + if (present(outfld)) outfld=budget_out(budget_ind) if (present(name)) name=budget_name(budget_ind) if (present(longname)) longname=budget_longname(budget_ind) if (present(optype)) optype=budget_optype(budget_ind) if (present(pkgtype)) pkgtype=budget_pkgtype(budget_ind) if (present(state_ind)) state_ind=budget_state_ind(budget_ind) + if (present(subcycle)) subcycle=budget_subcycle(budget_ind) if (budget_optype(budget_ind)=='dif' .or. budget_optype(budget_ind)=='sum') then if (present(stg1name))stg1name=budget_stg1name(budget_ind) if (present(stg2name))stg2name=budget_stg2name(budget_ind) @@ -415,6 +440,7 @@ subroutine budget_init() budget_stg2index(:) = 0 budget_stg1name(:)= 'UNSET' budget_stg2name(:)= 'UNSET' + budget_subcycle(:)= .false. end subroutine budget_init !============================================================================================== diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index b7a1996798..e908728ca7 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -69,8 +69,9 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) real(r8), pointer :: w(:,:) real(r8), pointer :: theta_m(:,:) real(r8), pointer :: tracers(:,:,:) - - + real(r8), pointer :: budgets(:,:,:)! energy/mass budgets se,ke,wv,liq,ice + integer, pointer :: budgets_cnt(:)! energy/mass budgets se,ke,wv,liq,ice + integer, pointer :: budgets_subcycle_cnt(:)! energy/mass budgets se,ke,wv,liq,ice integer :: lchnk, icol, icol_p, k, kk ! indices over chunks, columns, physics columns and layers integer :: i, m, ncols, blockid integer :: block_index @@ -107,11 +108,15 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) theta_m => dyn_out % theta_m exner => dyn_out % exner tracers => dyn_out % tracers + budgets => dyn_out % te_budgets + budgets_cnt => dyn_out % budgets_cnt + budgets_subcycle_cnt => dyn_out % budgets_subcycle_cnt if (compute_energy_diags) then call tot_energy(nCellsSolve, plev,size(tracers, 1), index_qv, zz(:,1:nCellsSolve), zint(:,1:nCellsSolve), & rho_zz(:,1:nCellsSolve), theta_m(:,1:nCellsSolve), tracers(:,:,1:nCellsSolve),& - ux(:,1:nCellsSolve),uy(:,1:nCellsSolve),'dBF') + ux(:,1:nCellsSolve),uy(:,1:nCellsSolve),'dBF', & + budgets,budgets_cnt,budgets_subcycle_cnt) end if ! ! diagnose pintdry, pmiddry, pmid @@ -531,6 +536,9 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn integer :: iCell,k character(len=*), parameter :: subname = 'dp_coupling:derived_tend' + real(r8), pointer :: budgets(:,:,:)! energy/mass budgets se,ke,wv,liq,ice + integer, pointer :: budgets_cnt(:)! energy/mass budgets se,ke,wv,liq,ice + integer, pointer :: budgets_subcycle_cnt(:)! energy/mass budgets se,ke,wv,liq,ice !---------------------------------------------------------------------------- nEdges = dyn_in % nEdges @@ -548,6 +556,9 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn rho_zz => dyn_in % rho_zz tracers => dyn_in % tracers index_qv = dyn_in % index_qv + budgets => dyn_in % te_budgets + budgets_cnt => dyn_in % budgets_cnt + budgets_subcycle_cnt => dyn_in % budgets_subcycle_cnt !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Momentum tendency @@ -633,7 +644,8 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn nCellsSolve, plev, size(tracers, 1), index_qv, zz(:,1:nCellsSolve), zint(:,1:nCellsSolve), rho_zz(:,1:nCellsSolve), & theta_m_new, tracers(:,:,1:nCellsSolve), & ux(:,1:nCellsSolve)+dtime*u_tend(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve), & - uy(:,1:nCellsSolve)+dtime*v_tend(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve),'dAP') + uy(:,1:nCellsSolve)+dtime*v_tend(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve),'dAP', & + budgets,budgets_cnt,budgets_subcycle_cnt) ! revert do m=1,thermodynamic_active_species_num idx_dycore = thermodynamic_active_species_idx_dycore(m) @@ -647,7 +659,8 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn nCellsSolve, plev, size(tracers, 1), index_qv, zz(:,1:nCellsSolve), zint(:,1:nCellsSolve), & rho_zz(:,1:nCellsSolve), theta_m_new, tracers(:,:,1:nCellsSolve), & ux(:,1:nCellsSolve)+dtime*u_tend(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve), & - uy(:,1:nCellsSolve)+dtime*v_tend(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve),'dAM') + uy(:,1:nCellsSolve)+dtime*v_tend(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve),'dAM', & + budgets,budgets_cnt,budgets_subcycle_cnt) end if ! ! Update halo for rtheta_m tendency @@ -736,7 +749,7 @@ subroutine hydrostatic_pressure(nCells, nVertLevels, zz, zgrid, rho_zz, theta_m, end subroutine hydrostatic_pressure -subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, theta_m, q, ux,uy,outfld_name_suffix) +subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, theta_m, q, ux,uy,outfld_name_suffix,te_budgets,budgets_cnt,budgets_subcycle_cnt) use physconst, only: rair, cpair, gravit,cappa!=R/cp (dry air) use physconst, only: thermodynamic_active_species_liq_num use mpas_constants, only: p0,cv,rv,rgas,cp @@ -744,6 +757,7 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t use mpas_constants, only: Rv_over_Rd => rvord use physconst, only: thermodynamic_active_species_ice_idx_dycore,thermodynamic_active_species_liq_idx_dycore use physconst, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_liq_num + use budgets, only: budget_array_max,budget_info ! Arguments integer, intent(in) :: nCells integer, intent(in) :: nVertLevels @@ -756,10 +770,15 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t real(r8), dimension(qsize,nVertLevels, nCells), intent(in) :: q ! tracer array real(r8), dimension(nVertLevels, nCells), intent(in) :: ux ! A-grid zonal velocity component real(r8), dimension(nVertLevels, nCells), intent(in) :: uy ! A-grid meridional velocity component + real(r8), dimension(budget_array_max, 9, nCells), intent(inout) :: te_budgets ! energy/mass budget arrays + integer, dimension(budget_array_max), intent(inout) :: budgets_cnt ! budget counts for normalization + integer, dimension(budget_array_max), intent(inout) :: budgets_subcycle_cnt ! budget counts for normalization character*(*), intent(in) :: outfld_name_suffix ! suffix for "outfld" names ! Local variables integer :: iCell, k, idx + integer :: s_ind,b_ind + logical :: b_subcycle real(r8) :: rho_dz,zcell,temperature,theta,pk,ptop,exner real(r8), dimension(nVertLevels, nCells) :: rhod, dz real(r8), dimension(nCells) :: kinetic_energy,potential_energy,internal_energy,water_vapor,water_liq,water_ice @@ -805,6 +824,34 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t call outfld(name_out1,internal_energy,ncells,1) call outfld(name_out2,kinetic_energy ,ncells,1) call outfld(name_out3,water_vapor ,ncells,1) + + call budget_info(trim(outfld_name_suffix),budget_ind=b_ind,state_ind=s_ind,subcycle=b_subcycle) + ! reset all when cnt is 0 + write(iulog,*)'dpc calc se,ke ',s_ind,',1:3,1 is ',internal_energy(1),' ',kinetic_energy(1) + write(iulog,*)'dpc budgets initial ',s_ind,',1:3,1 is ',te_budgets(s_ind,1,1),' ',te_budgets(s_ind,2,1),' ',te_budgets(s_ind,3,1) + if (budgets_cnt(s_ind) == 0) then + budgets_subcycle_cnt(s_ind) = 0 + te_budgets(s_ind,:,:)=0.0_r8 + end if + if (b_subcycle) then + budgets_subcycle_cnt(s_ind) = budgets_subcycle_cnt(s_ind) + 1 + if (budgets_subcycle_cnt(s_ind) == 1) then + budgets_cnt(s_ind) = budgets_cnt(s_ind) + 1 + end if + else + budgets_cnt(s_ind) = budgets_cnt(s_ind) + 1 + budgets_subcycle_cnt(s_ind) = 1 + !not subcycling so don't sum just replace previous budget values + te_budgets(s_ind,:,:)=0._r8 + end if + + te_budgets(s_ind,1,:)=te_budgets(s_ind,1,:)+(internal_energy+kinetic_energy) + te_budgets(s_ind,2,:)=te_budgets(s_ind,2,:)+internal_energy + te_budgets(s_ind,3,:)=te_budgets(s_ind,3,:)+kinetic_energy + write(iulog,*)'tot_e te_budget for this proc ',s_ind,',1:3,1 is ',te_budgets(s_ind,1,1),' ',te_budgets(s_ind,2,1),' ',te_budgets(s_ind,3,1) + + te_budgets(s_ind,4,:)=te_budgets(s_ind,4,:)+water_vapor + ! ! vertical integral of total liquid water ! @@ -819,6 +866,7 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t end do end do call outfld(name_out4,liq,ncells,1) + te_budgets(s_ind,5,:)=te_budgets(s_ind,5,:)+liq end if ! ! vertical integral of total frozen (ice) water @@ -834,6 +882,7 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t end do end do call outfld(name_out5,ice,ncells,1) + te_budgets(s_ind,6,:)=te_budgets(s_ind,6,:)+ice end if end if end subroutine tot_energy diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index 49f02a2e79..19290f2bb3 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -150,6 +150,14 @@ module dyn_comp ! from physics [kg K/m^3/s] (nver,ncol) real(r8), dimension(:,:), pointer :: rho_tend ! Dry air density tendency ! from physics [kg/m^3/s] (nver,ncol) + ! + ! Energy Budgets + ! + real(r8), dimension(:,:), pointer :: budgets_global ! global averages (budget_array_max,9) + real(r8), dimension(:,:,:),pointer :: te_budgets ! Energy budgets (budget_array_max,9,ncells) + integer, dimension(:), pointer :: budgets_cnt ! budget counts (budget_array_max) + integer, dimension(:), pointer :: budgets_subcycle_cnt ! subcycle count (budget_array_max) + end type dyn_import_t type dyn_export_t @@ -196,6 +204,8 @@ module dyn_comp real(r8), dimension(:), pointer :: fzm ! Interp weight from k layer midpoint to k layer ! interface [dimensionless] (nver) real(r8), dimension(:), pointer :: fzp ! Interp weight from k-1 layer midpoint to k + + real(r8), dimension(:), pointer :: areaCell ! cell area (m^2) ! layer interface [dimensionless] (nver) ! @@ -214,6 +224,14 @@ module dyn_comp ! (nver,nvtx) real(r8), dimension(:,:), pointer :: divergence ! Horizontal velocity divergence [s^-1] ! (nver,ncol) + ! + ! Energy Budgets + ! + real(r8), dimension(:,:), pointer :: budgets_global ! global averages (budget_array_max,9) + real(r8), dimension(:,:,:),pointer :: te_budgets ! Energy budgets (budget_array_max,9,ncells) + integer, dimension(:), pointer :: budgets_cnt ! budget counts (budget_array_max) + integer, dimension(:), pointer :: budgets_subcycle_cnt ! subcycle count (budget_array_max) + end type dyn_export_t real(r8), parameter :: rad2deg = 180.0_r8 / pi @@ -316,6 +334,7 @@ subroutine dyn_init(dyn_in, dyn_out) use mpas_constants, only : mpas_constants_compute_derived use dyn_tests_utils, only : vc_dycore, vc_height, string_vc, vc_str_lgth use constituents, only : cnst_get_ind + use budgets, only : budget_array_max, budget_info, budget_add, budget_num ! arguments: type(dyn_import_t), intent(inout) :: dyn_in type(dyn_export_t), intent(inout) :: dyn_out @@ -347,14 +366,20 @@ subroutine dyn_init(dyn_in, dyn_out) character(len=*), parameter :: subname = 'dyn_comp::dyn_init' ! variables for initializing energy and axial angular momentum diagnostics - integer, parameter :: num_stages = 3, num_vars = 5 - character (len = 3), dimension(num_stages) :: stage = (/"dBF","dAP","dAM"/) + integer, parameter :: num_stages = 6, num_vars = 5 + character (len = 16), dimension(num_stages) :: stage = (/"dBF","dAP","dAM","BD_dparm","BD_DMEA","BD_phys"/) character (len = 55),dimension(num_stages) :: stage_txt = (/& " dynamics state before physics (d_p_coupling) ",& " dynamics state with T,u,V increment but not q ",& - " dynamics state with full physics increment (incl.q)" & + " dynamics state with full physics increment (incl.q)",& + "dE/dt params+efix in dycore (dparam)(dAP-dBF) ",& + "dE/dt dry mass adjustment in dycore (dAM-dAP)",& + "dE/dt physics total in dycore (phys) (dAM-dBF)" & /) + + + character (len = 2) , dimension(num_vars) :: vars = (/"WV" ,"WL" ,"WI" ,"SE" ,"KE"/) character (len = 45) , dimension(num_vars) :: vars_descriptor = (/& "Total column water vapor ",& @@ -370,6 +395,12 @@ subroutine dyn_init(dyn_in, dyn_out) integer :: istage, ivars, m character (len=108) :: str1, str2, str3 character (len=vc_str_lgth) :: vc_str + character(len=64) :: budget_name + character(len=128) :: budget_longname + character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn + logical :: budget_outfld + + !------------------------------------------------------- vc_dycore = vc_height if (masterproc) then @@ -479,6 +510,7 @@ subroutine dyn_init(dyn_in, dyn_out) dyn_out % rho => dyn_in % rho dyn_out % ux => dyn_in % ux dyn_out % uy => dyn_in % uy + dyn_out % areaCell => dyn_in % areaCell allocate(dyn_out % pmiddry(nVertLevels, nCells), stat=ierr) if( ierr /= 0 ) call endrun(subname//': failed to allocate dyn_out%pmiddry array') @@ -486,6 +518,23 @@ subroutine dyn_init(dyn_in, dyn_out) allocate(dyn_out % pintdry(nVertLevels+1, nCells), stat=ierr) if( ierr /= 0 ) call endrun(subname//': failed to allocate dyn_out%pintdry array') + allocate(dyn_out % te_budgets(budget_array_max, 9, nCellsSolve), stat=ierr) + if( ierr /= 0 ) call endrun(subname//': failed to allocate dyn_out%budgets') + + allocate(dyn_out % budgets_cnt(budget_array_max), stat=ierr) + if( ierr /= 0 ) call endrun(subname//': failed to allocate dyn_out%budgets') + + allocate(dyn_out % budgets_subcycle_cnt(budget_array_max), stat=ierr) + if( ierr /= 0 ) call endrun(subname//': failed to allocate dyn_out%budgets') + + allocate(dyn_out % budgets_global(budget_array_max,9), stat=ierr) + if( ierr /= 0 ) call endrun(subname//': failed to allocate dyn_out%budgets') + + dyn_in % te_budgets => dyn_out % te_budgets + dyn_in % budgets_global => dyn_out % budgets_global + dyn_in % budgets_cnt => dyn_out % budgets_cnt + dyn_in % budgets_subcycle_cnt => dyn_out % budgets_subcycle_cnt + call mpas_pool_get_array(diag_pool, 'vorticity', dyn_out % vorticity) call mpas_pool_get_array(diag_pool, 'divergence', dyn_out % divergence) @@ -568,7 +617,37 @@ subroutine dyn_init(dyn_in, dyn_out) end if end do -end subroutine dyn_init + ! + ! initialize MPAS energy budgets + ! + ! add budget snapshots (stages) + istage=1 + call budget_add('dBF', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true., subcycle=.false.) + istage=istage+1 + call budget_add('dAP', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true., subcycle=.false.) + istage=istage+1 + call budget_add('dAM', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true., subcycle=.false.) + ! + ! add budgets that are derived from stages + ! + + call budget_add('BD_dparm','dAP','dBF',pkgtype='dyn',optype='dif',longname="dE/dt parameterizations+efix in dycore (dparam)(dAP-dBF)",outfld=.true.) + call budget_add('BD_DMEA' ,'dAM','dAP',pkgtype='dyn',optype='dif',longname="dE/dt dry mass adjustment in dycore (dAM-dAP)",outfld=.true.) + call budget_add('BD_phys' ,'dAM','dBF',pkgtype='dyn',optype='dif',longname="dE/dt physics total in dycore (phys) (dAM-dBF)",outfld=.true.) + +!!$ ! add all dynamic budget outfld calls +!!$ do m=1,budget_num +!!$ call budget_info(m,name=budget_name,longname=budget_longname,pkgtype=budget_pkgtype,outfld=budget_outfld) +!!$ write(iulog,*)'budget_info for ',budget_name,' pkg:',budget_pkgtype,' outfld:',budget_outfld +!!$ if (budget_outfld) then +!!$ if (trim(budget_pkgtype)=='dyn') then +!!$ write(iulog,*)'calling addfld for ',trim(budget_name) +!!$ call addfld(trim(budget_name), horiz_only, 'A', 'W/m2', trim(budget_longname)) +!!$ endif +!!$ end if +!!$ end do + + end subroutine dyn_init !========================================================================================= @@ -607,8 +686,134 @@ subroutine dyn_run(dyn_in, dyn_out) dyn_out % rho_zz => dyn_in % rho_zz dyn_out % tracers => dyn_in % tracers + ! update energy budgets calculated from snapshots (stages) + + call budget_update(dyn_in%nCellsSolve,dyn_out) + call budget_globals(dyn_in%nCellsSolve,dyn_out) + end subroutine dyn_run +subroutine budget_globals(nCells,dyn_out) + + use budgets, only : budget_num, budget_info, budget_ind_byname + + ! arguments + integer, intent(in) :: nCells ! Number of cells, including halo cells + type (dyn_export_t), intent(inout) :: dyn_out + + ! Local variables + integer :: b_ind,s_ind,is1,is2 + logical :: budget_outfld + character(len=64) :: name_out1,name_out2,name_out3,name_out4,name_out5,budget_name + character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn + real(r8),allocatable :: tmp(:,:) + real(r8) :: dtime + real(r8), pointer :: te_budgets(:,:,:)! energy/mass budgets se,ke,wv,liq,ice + real(r8), pointer :: budgets_global(:,:) + integer, pointer :: budgets_cnt(:) ! budget counts for normalizating sum + integer :: i + real(r8) :: sphere_surface_area + real(r8), dimension(:) :: glob(nCells,9) + real(r8), pointer :: areaCell(:) ! cell area (m^2) + character(len=*), parameter :: subname = 'dyn_comp:budget_globals' + + !-------------------------------------------------------------------------------------- + areaCell => dyn_out % areaCell + te_budgets => dyn_out % te_budgets + budgets_cnt => dyn_out % budgets_cnt + budgets_global => dyn_out % budgets_global + + ! Get CAM time step + dtime = get_step_size() + + do b_ind=1,budget_num + call budget_info(b_ind,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=s_ind) + if (budget_pkgtype=='dyn') then + name_out1 = 'SE_' //trim(budget_name) + name_out2 = 'KE_' //trim(budget_name) + name_out3 = 'WV_' //trim(budget_name) + name_out4 = 'WL_' //trim(budget_name) + name_out5 = 'WI_' //trim(budget_name) + ! Normalize energy sums and convert to W/s + ! (3) compute average global integrals of budgets + sphere_surface_area = cam_mpas_global_sum_real(areaCell(1:nCells)) + do i=1,6 + glob(1:nCells,i) = te_budgets(s_ind,i,1:nCells)*areaCell(1:nCells)/sphere_surface_area + budgets_global(s_ind,i) = cam_mpas_global_sum_real(glob(1:nCells,i))/budgets_cnt(s_ind)/dtime + end do + write(iulog,*)trim(budget_name),' total energy:',budgets_global(s_ind,1) + if (.true.) budgets_cnt(s_ind)=0 + end if + end do + +end subroutine budget_globals + +subroutine budget_update(nCells,dyn_out) + + use budgets, only : budget_num, budget_info + use physconst, only : thermodynamic_active_species_liq_num, thermodynamic_active_species_ice_num + + ! arguments + integer, intent(in) :: nCells ! Number of cells, including halo cells + type (dyn_export_t), intent(in) :: dyn_out + + ! Local variables + real(r8), pointer :: te_budgets(:,:,:) ! energy/mass budgets se,ke,wv,liq,ice + integer, pointer :: budgets_cnt(:) ! budget counts for normalizating sum + integer :: b_ind,s_ind,is1,is2 + logical :: budget_outfld + character(len=64) :: name_out1,name_out2,name_out3,name_out4,name_out5,budget_name + character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn + real(r8) :: tmp(9,nCells) + + !-------------------------------------------------------------------------------------- + + te_budgets => dyn_out % te_budgets + budgets_cnt => dyn_out % budgets_cnt + + + do b_ind=1,budget_num + call budget_info(b_ind,optype=budget_optype, pkgtype=budget_pkgtype,state_ind=s_ind,outfld=budget_outfld,name=budget_name) + if (budget_pkgtype=='dyn') then + if (budget_optype=='stg') then + tmp(:,:)=te_budgets(s_ind,:,:) + else + call budget_info(b_ind,stg1stateidx=is1, stg2stateidx=is2) + if (budget_optype=='dif') then + tmp(:,:)=(te_budgets(is1,:,:)-te_budgets(is2,:,:)) + else if (budget_optype=='sum') then + tmp(:,:)=(te_budgets(is1,:,:)+te_budgets(is2,:,:)) + end if + budgets_cnt(s_ind)=budgets_cnt(s_ind)+1 + te_budgets(s_ind,:,:)=tmp(:,:) + ! + ! Output energy diagnostics + ! + if (budget_outfld) then + name_out1 = 'SE_' //trim(budget_name) + name_out2 = 'KE_' //trim(budget_name) + name_out3 = 'WV_' //trim(budget_name) + name_out4 = 'WL_' //trim(budget_name) + name_out5 = 'WI_' //trim(budget_name) + call outfld(name_out1, te_budgets(s_ind,2,:), nCells, 1) + call outfld(name_out2, te_budgets(s_ind,3,:), nCells, 1) + ! + ! sum over vapor + call outfld(name_out3, te_budgets(s_ind,4,:), nCells, 1) + ! + ! sum over liquid water + if (thermodynamic_active_species_liq_num>0) & + call outfld(name_out4, te_budgets(s_ind,5,:), nCells, 1) + ! + ! sum over ice water + if (thermodynamic_active_species_ice_num>0) & + call outfld(name_out5, te_budgets(s_ind,6,:), nCells, 1) + end if + end if + end if + end do + +end subroutine budget_update !========================================================================================= subroutine dyn_final(dyn_in, dyn_out) @@ -687,6 +892,7 @@ subroutine dyn_final(dyn_in, dyn_out) nullify(dyn_out % uy) deallocate(dyn_out % pmiddry) deallocate(dyn_out % pintdry) + deallocate(dyn_out % te_budgets) nullify(dyn_out % vorticity) nullify(dyn_out % divergence) From 88fc6e26a7bb40eb9ab37d842adcc41b0d90125e Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 15 Sep 2022 02:23:42 -0600 Subject: [PATCH 011/140] some refactor for mpas budgets --- src/control/budgets.F90 | 113 ++++++++++++-- src/dynamics/mpas/dycore_budget.F90 | 156 +++++++++++++++++++ src/dynamics/mpas/dyn_comp.F90 | 232 +++++++++++++++++++++------- src/dynamics/se/dycore_budget.F90 | 147 ++++++++++++++++++ src/physics/cam/check_energy.F90 | 134 ++++++++++------ src/physics/cam/physics_types.F90 | 4 +- src/physics/cam/physpkg.F90 | 4 +- 7 files changed, 678 insertions(+), 112 deletions(-) create mode 100644 src/dynamics/mpas/dycore_budget.F90 create mode 100644 src/dynamics/se/dycore_budget.F90 diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index f82cfc6366..4f0fb60c8c 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -36,11 +36,14 @@ module budgets budget_info, &! return budget info by ind budget_cnt_adjust, &! advance or reset budget count budget_count, &! return budget count + budget_get_global, &! return budget count + budget_put_global, &! return budget count budget_outfld ! Returns true if default CAM output was specified in the budget_stage_add calls. ! Public data integer, parameter, public :: budget_array_max = 60 ! number of budget diffs +integer, parameter, public :: budget_me_varnum = 7 ! tot,se,ke,wv,wl,wi integer, public :: budget_cnt(budget_array_max) ! budget counts for normalization integer, public :: budget_subcycle(budget_array_max) ! budget_subcycle counts @@ -51,13 +54,15 @@ module budgets logical, public, protected :: budget_out(budget_array_max) ! outfld this stage character(len=64), public, protected :: budget_name(budget_array_max) ! budget names character(len=128),public, protected :: budget_longname(budget_array_max) ! long name of budgets +character(len=128),public, protected :: budget_stagename(budget_array_max) ! long name of budgets integer, public, protected :: budget_stg1index(budget_array_max) integer, public, protected :: budget_stg2index(budget_array_max) character(len=64), public, protected :: budget_stg1name(budget_array_max) -character(len=32), public, protected :: budget_stg2name(budget_array_max) +character(len=64), public, protected :: budget_stg2name(budget_array_max) +character(len=64), public, protected :: budget_me_names(budget_me_varnum) integer, public, protected :: budget_stg1stateidx(budget_array_max) integer, public, protected :: budget_stg2stateidx(budget_array_max) -real(r8), public, protected :: budget_globals(budget_array_max) +real(r8), public, protected :: budget_globals(budget_array_max,budget_me_varnum) ! ! Constants for each budget @@ -166,6 +171,8 @@ subroutine budget_stage_add (name, pkgtype, longname, outfld, subcycle) else budget_subcycle(budget_num)=.false. end if + budget_stagename(budget_num)= trim(name) + end subroutine budget_stage_add !!$!============================================================================== @@ -194,6 +201,7 @@ subroutine budget_diff_add (name, stg1name, stg2name, pkgtype, optype, longname, character(len=*), parameter :: sub='budget_diff_add' character(len=128) :: errmsg + character(len=1) :: opchar integer :: state_idx !----------------------------------------------------------------------- ! set budget index and check validity @@ -220,9 +228,15 @@ subroutine budget_diff_add (name, stg1name, stg2name, pkgtype, optype, longname, else budget_longname(budget_num) = name end if - - budget_stg1name(budget_num) = stg1name - budget_stg2name(budget_num) = stg2name + if (optype=='dif') opchar='-' + if (optype=='sum') opchar='+' + if (optype=='stg') then + write(errmsg,*) sub//': FATAL: bad value optype should be sum of dif:', optype + call endrun(errmsg) + end if + budget_stg1name(budget_num) = trim(stg1name) + budget_stg2name(budget_num) = trim(stg2name) + budget_stagename(budget_num)= trim(stg1name)//opchar//trim(stg2name) budget_stg1index(budget_num) = budget_ind_byname(trim(stg1name)) budget_stg2index(budget_num) = budget_ind_byname(trim(stg2name)) budget_stg1stateidx(budget_num) = budget_state_ind(budget_stg1index(budget_num)) @@ -493,6 +507,86 @@ end function budget_longname_byind !============================================================================== +subroutine budget_get_global (name, me_idx, global, abort) + + ! Get the global integral of a budget. Optional abort argument allows returning + ! control to caller when budget name is not found. Default behavior is + ! to call endrun when name is not found. + + !-----------------------------Arguments--------------------------------- + character(len=*), intent(in) :: name ! budget name + integer, intent(in) :: me_idx ! mass energy variable index + real(r8), intent(out) :: global ! global budget index (in q array) + logical, optional, intent(in) :: abort ! optional flag controlling abort + + !---------------------------Local workspace----------------------------- + integer :: m ! budget index + logical :: abort_on_error + character(len=*), parameter :: sub='budget_get_global' + !----------------------------------------------------------------------- + + ! Find budget name in list + do m = 1, budget_array_max + if (trim(name) == trim(budget_stagename(m)).or.trim(name)==trim(budget_name(m))) then + global = budget_globals(m,me_idx) + if (me_idx==1) write(iulog,*)'found global for ',trim(name),'=',global + return + end if + end do + + ! Unrecognized name + abort_on_error = .true. + if (present(abort)) abort_on_error = abort + + if (abort_on_error) then + write(iulog, *) sub//': FATAL: name:', name, ' not found in list:', budget_name(:) + write(iulog, *) sub//': FATAL: name:', name, ' not found in list:', budget_stagename(:) + call endrun(sub//': FATAL: name not found') + end if + + end subroutine budget_get_global +!============================================================================== +!============================================================================== +subroutine budget_put_global (name, me_idx, global, abort) + + ! store the global integral of a budget. Optional abort argument allows returning + ! control to caller when budget name is not found. Default behavior is + ! to call endrun when name is not found. + + !-----------------------------Arguments--------------------------------- + character(len=*), intent(in) :: name ! budget name + integer, intent(in) :: me_idx! mass energy variable index + real(r8), intent(out) :: global ! global budget index (in q array) + logical, optional, intent(in) :: abort ! optional flag controlling abort + + !---------------------------Local workspace----------------------------- + integer :: m ! budget index + logical :: abort_on_error + character(len=*), parameter :: sub='budget_put_ind' + !----------------------------------------------------------------------- + + ! Find budget name in list + do m = 1, budget_array_max + if (trim(name) == trim(budget_stagename(m)).or.trim(name)==trim(budget_name(m))) then + budget_globals(m,me_idx) = global + if (me_idx==1) write(iulog,*)'putting global for ',trim(name),'=',global + return + end if + end do + + ! Unrecognized name + abort_on_error = .true. + if (present(abort)) abort_on_error = abort + + if (abort_on_error) then + write(iulog, *) sub//': FATAL: name:', name, ' not found in list:', budget_name(:) + write(iulog, *) sub//': FATAL: name:', name, ' not found in list:', budget_stagename(:) + call endrun(sub//': FATAL: name not found') + end if + + end subroutine budget_put_global +!============================================================================== + subroutine budget_get_ind (name, budget_ind, abort) ! Get the index of a budget. Optional abort argument allows returning @@ -512,7 +606,7 @@ subroutine budget_get_ind (name, budget_ind, abort) ! Find budget name in list do m = 1, budget_array_max - if (name == budget_name(m)) then + if (trim(name) == trim(budget_name(m)).or.trim(name)==trim(budget_stagename(m))) then budget_ind = m return end if @@ -524,6 +618,7 @@ subroutine budget_get_ind (name, budget_ind, abort) if (abort_on_error) then write(iulog, *) sub//': FATAL: name:', name, ' not found in list:', budget_name(:) + write(iulog, *) sub//': FATAL: name:', name, ' not found in list:', budget_stagename(:) call endrun(sub//': FATAL: name not found') end if @@ -549,7 +644,7 @@ function budget_ind_byname (name) budget_ind_byname = -1 do m = 1, budget_array_max - if (trim(name) == trim(budget_name(m))) then + if (trim(name) == trim(budget_name(m)).or.trim(name) == trim(budget_stagename(m))) then budget_ind_byname = m return end if @@ -557,7 +652,7 @@ function budget_ind_byname (name) if (budget_ind_byname == -1) then write(iulog,*)'ind_byname failed, name=',trim(name),'budget_name=' do m = 1, budget_array_max - write(iulog,*)'budget_name(',m,')=',budget_name(m) + write(iulog,*)'budget_name(',m,')=',trim(budget_name(m)) end do end if @@ -577,7 +672,7 @@ subroutine budget_chk_dim if (masterproc) then write(iulog,*) 'Budgets list:' do i = 1, budget_num - write(iulog,'(2x,i4,2x,a8,2x,a128)') i, budget_name(i), budget_longname(i) + write(iulog,'(2x,i4,2x,a8,2x,a128)') i, trim(budget_name(i)), trim(budget_longname(i)) end do end if diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 new file mode 100644 index 0000000000..6ca300f8ef --- /dev/null +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -0,0 +1,156 @@ +module dycore_budget + +implicit none + +public :: print_budget + + +!========================================================================================= +contains +!========================================================================================= + +subroutine print_budget() + + use budgets, only: budget_num, budget_info, budget_ind_byname, budget_get_global + use shr_kind_mod, only: r8=>shr_kind_r8 + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + + ! Local variables + integer :: b_ind,s_ind,is1,is2 + logical :: budget_outfld + character(len=64) :: name_out1,name_out2,name_out3,name_out4,name_out5,budget_name,name_out(9) + character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn + real(r8),allocatable :: tmp(:,:) + real(r8), pointer :: te_budgets(:,:,:)! energy/mass budgets se,ke,wv,liq,ice + integer, pointer :: budgets_cnt(:) ! budget counts for normalizating sum + integer :: i + character(len=*), parameter :: subname = 'check_energy:print_budgets' + + real(r8) :: ph_param,ph_EFIX,ph_DMEA,ph_param_and_efix,ph_phys_total + real(r8) :: dy_param,dy_EFIX,dy_DMEA,dy_param_and_efix,dy_phys_total + real(r8) :: mpas_param,mpas_dmea,mpas_phys_total, dycore, err, param, pefix, pdmea, param_mpas, phys_total + integer :: m_cnst + !-------------------------------------------------------------------------------------- + + if (masterproc) then + call budget_get_global('phAP-phBP',1,ph_param) + call budget_get_global('phBP-phBF',1,ph_EFIX) + call budget_get_global('phAM-phAP',1,ph_DMEA) + call budget_get_global('phAP-phBF',1,ph_param_and_efix) + call budget_get_global('phAM-phBF',1,ph_phys_total) + + call budget_get_global('dyAP-dyBP',1,dy_param) + call budget_get_global('dyBP-dyBF',1,dy_EFIX) + call budget_get_global('dyAM-dyAP',1,dy_DMEA) + call budget_get_global('dyAP-dyBF',1,dy_param_and_efix) + call budget_get_global('dyAM-dyBF',1,dy_phys_total) + + call budget_get_global('dAP-dBF',1,mpas_param) + call budget_get_global('dAM-dAP',1,mpas_dmea) + call budget_get_global('dAM-dBF',1,mpas_phys_total) + + + write(iulog,*)" " + write(iulog,*)"=======================================================" + write(iulog,*)"| |" + write(iulog,*)"| ANALYSIS OF ENERGY DIAGNOSTICS IN PHYSICS |" + write(iulog,*)"| |" + write(iulog,*)"=======================================================" + write(iulog,*)" " + write(iulog,*)"-------------------------------------------------------" + write(iulog,*)" CAM physics energy increments (in pressure coordinate)" + write(iulog,*)"-------------------------------------------------------" + write(iulog,*)" " + write(iulog,*)"dE/dt params no efix (param) (pAP-pBP) ",ph_param," W/M^2" + write(iulog,*)"dE/dt energy fixer (efix) (pBP-pBF) ",ph_EFIX," W/M^2" + write(iulog,*)"NOTE: energy fixer uses energy formula consistent with dycore (so this is not p-based for MPAS) " + write(iulog,*)"dE/dt params + efix (pAP-pBF) ",ph_param_and_efix," W/M^2" + write(iulog,*)" " + write(iulog,*)"dE/dt dry mass adj (pwork) (pAM-pAP) ",ph_DMEA," W/M^2" + write(iulog,*)"dE/dt physics total (phys) (pAM-pBF) ",ph_phys_total," W/M^2" + write(iulog,*)" " + dycore = -ph_EFIX-ph_DMEA + write(iulog,*)"Dycore TE dissipation estimated from physics in pressure coordinate ",dycore," W/M^2" + write(iulog,*)"(assuming no physics-dynamics coupling errors) " + write(iulog,*)" " + write(iulog,*)"---------------------------------------------------------------------------" + write(iulog,*)" CAM physics dycore consistent energy increments (for MPAS in z coordinate)" + write(iulog,*)"---------------------------------------------------------------------------" + write(iulog,*)" " + write(iulog,*)"dE/dt params no efix (param) (dyAP-dyBP) ",dy_param," W/M^2" + write(iulog,*)"dE/dt energy fixer (efix) (dyBP-dyBF) ",dy_EFIX," W/M^2" + write(iulog,*)"dE/dt parameterizations + efix (dyAP-dyBF) ",dy_param_and_efix," W/M^2" + write(iulog,*)" " + write(iulog,*)"dE/dt dry mass adjustment (pwork) (dyAM-dyAP) ",dy_DMEA," W/M^2" + write(iulog,*)"dE/dt physics total (phys) (dyAM-dyBF) ",dy_phys_total," W/M^2" + write(iulog,*)" " + dycore = -dy_EFIX-dy_DMEA + write(iulog,*)"Dycore TE dissipation estimated from physics with dycore energy ",dycore," W/M^2" + write(iulog,*)"(assuming no physics-dynamics coupling errors; -efix-dme_adjust) " + write(iulog,*)" " + + + write(iulog,*)"==========================================================================" + write(iulog,*)"| |" + write(iulog,*)"| ANALYSIS OF ENERGY DIAGNOSTICS IN PHYSICS dp_coupling (MPAS) |" + write(iulog,*)"| |" + write(iulog,*)"==========================================================================" + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)"dE/dt parameterizations + efix (total physics increment) in MPAS " + write(iulog,*)"when adding as one increment - no dribbling (dAP-dBF) ",mpas_param," W/M^2" + err = ph_param_and_efix-mpas_param + write(iulog,*)"compare to same tendency in physics (MUST BE SMALL!) ",err," W/M^2" + write(iulog,*)" " + write(iulog,*)"dE/dt dry mass adjustment in MPAS (dAM-dAP) ",mpas_dmea," W/M^2" + err = dy_DMEA-mpas_dmea + write(iulog,*)"compare to same tendency in physics (MUST BE SMALL!) ",err," W/M^2" + + write(iulog,*)"==========================================================================" + write(iulog,*)"| |" + write(iulog,*)"| ANALYSIS OF MASS diagnostics in (MPAS) |" + write(iulog,*)"| |" + write(iulog,*)"==========================================================================" + + do m_cnst=4,6 + + if (m_cnst.eq.4) then + + write(iulog,*)"Water vapor budget" + write(iulog,*)"------------------" + end if + if (m_cnst.eq.5) then + write(iulog,*)"Cloud liquid budget" + write(iulog,*)"------------------" + end if + if (m_cnst.eq.6) then + write(iulog,*)"Cloud ice budget" + write(iulog,*)"------------------" + end if + write(iulog,*)"" + + call budget_get_global('phAP-phBP',m_cnst,param) + call budget_get_global('phBP-phBF',m_cnst,pEFIX) + call budget_get_global('phAM-phAP',m_cnst,pDMEA) + + call budget_get_global('dAM-dBF',m_cnst,param_mpas) + call budget_get_global('phAM-phBF',m_cnst,phys_total) + + write(iulog,*)"dMASS/dt energy fixer (pBP-pBF) ",pEFIX," Pa" + write(iulog,*)"dMASS/dt parameterizations (pAP-pBP) ",param," Pa" + write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",pDMEA," Pa" + write(iulog,*)"" + write(iulog,*)"" + write(iulog,*)"dMass/dt physics total in MPAS (dAM-dBF) ",param_mpas," Pa" + err = (param_mpas-param) + write(iulog,*)"Is mass budget closed? (pAP-pBP)-(dAM-dBF) ",err + write(iulog,*)"---------------------------------------------------------------------------------------------------" + write(iulog,*)" " + end do + end if +end subroutine print_budget +!========================================================================================= + +end module dycore_budget + diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index 19290f2bb3..e0f047c9a2 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -39,9 +39,9 @@ module dyn_comp use cam_abortutils, only: endrun use mpas_timekeeping, only : MPAS_TimeInterval_type - use cam_mpas_subdriver, only: cam_mpas_global_sum_real + implicit none private save @@ -622,18 +622,21 @@ subroutine dyn_init(dyn_in, dyn_out) ! ! add budget snapshots (stages) istage=1 - call budget_add('dBF', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true., subcycle=.false.) + call budget_add('dBF', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.false., subcycle=.false.) istage=istage+1 - call budget_add('dAP', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true., subcycle=.false.) + call budget_add('dAP', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.false., subcycle=.false.) istage=istage+1 - call budget_add('dAM', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true., subcycle=.false.) + call budget_add('dAM', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.false., subcycle=.false.) ! ! add budgets that are derived from stages ! +!!$ call budget_add('BD_dparm','dAP','dBF',pkgtype='dyn',optype='dif',longname="dE/dt parameterizations+efix in dycore (dparam)(dAP-dBF)",outfld=.true.) +!!$ call budget_add('BD_DMEA' ,'dAM','dAP',pkgtype='dyn',optype='dif',longname="dE/dt dry mass adjustment in dycore (dAM-dAP)",outfld=.true.) +!!$ call budget_add('param_mpas' ,'dAM','dBF',pkgtype='dyn',optype='dif',longname="dE/dt physics total in dycore (phys) (dAM-dBF)",outfld=.true.) - call budget_add('BD_dparm','dAP','dBF',pkgtype='dyn',optype='dif',longname="dE/dt parameterizations+efix in dycore (dparam)(dAP-dBF)",outfld=.true.) - call budget_add('BD_DMEA' ,'dAM','dAP',pkgtype='dyn',optype='dif',longname="dE/dt dry mass adjustment in dycore (dAM-dAP)",outfld=.true.) - call budget_add('BD_phys' ,'dAM','dBF',pkgtype='dyn',optype='dif',longname="dE/dt physics total in dycore (phys) (dAM-dBF)",outfld=.true.) + call budget_add('mpas_param','dAP','dBF',pkgtype='dyn',optype='dif',longname="dE/dt parameterizations+efix in dycore (dparam)(dAP-dBF)",outfld=.false.) + call budget_add('mpas_dmea' ,'dAM','dAP',pkgtype='dyn',optype='dif',longname="dE/dt dry mass adjustment in dycore (dAM-dAP)",outfld=.false.) + call budget_add('mpas_phys_total' ,'dAM','dBF',pkgtype='dyn',optype='dif',longname="dE/dt physics total in dycore (phys) (dAM-dBF)",outfld=.false.) !!$ ! add all dynamic budget outfld calls !!$ do m=1,budget_num @@ -689,13 +692,13 @@ subroutine dyn_run(dyn_in, dyn_out) ! update energy budgets calculated from snapshots (stages) call budget_update(dyn_in%nCellsSolve,dyn_out) - call budget_globals(dyn_in%nCellsSolve,dyn_out) +!jt call print_budgets(dyn_in%nCellsSolve,dyn_out) end subroutine dyn_run -subroutine budget_globals(nCells,dyn_out) +subroutine print_budgets(nCells,dyn_out) - use budgets, only : budget_num, budget_info, budget_ind_byname + use budgets, only : budget_num, budget_info, budget_ind_byname, budget_get_global ! arguments integer, intent(in) :: nCells ! Number of cells, including halo cells @@ -704,53 +707,135 @@ subroutine budget_globals(nCells,dyn_out) ! Local variables integer :: b_ind,s_ind,is1,is2 logical :: budget_outfld - character(len=64) :: name_out1,name_out2,name_out3,name_out4,name_out5,budget_name + character(len=64) :: name_out1,name_out2,name_out3,name_out4,name_out5,budget_name,name_out(9) character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn real(r8),allocatable :: tmp(:,:) - real(r8) :: dtime real(r8), pointer :: te_budgets(:,:,:)! energy/mass budgets se,ke,wv,liq,ice - real(r8), pointer :: budgets_global(:,:) integer, pointer :: budgets_cnt(:) ! budget counts for normalizating sum integer :: i - real(r8) :: sphere_surface_area - real(r8), dimension(:) :: glob(nCells,9) - real(r8), pointer :: areaCell(:) ! cell area (m^2) - character(len=*), parameter :: subname = 'dyn_comp:budget_globals' + character(len=*), parameter :: subname = 'dyn_comp:print_budgets' + real(r8) :: ph_param,ph_EFIX,ph_DMEA,ph_param_and_efix,ph_phys_total + real(r8) :: dy_param,dy_EFIX,dy_DMEA,dy_param_and_efix,dy_phys_total + real(r8) :: mpas_param,mpas_dmea,mpas_phys_total, dycore, err, param, pefix, pdmea, param_mpas, phys_total + integer :: m_cnst !-------------------------------------------------------------------------------------- - areaCell => dyn_out % areaCell - te_budgets => dyn_out % te_budgets - budgets_cnt => dyn_out % budgets_cnt - budgets_global => dyn_out % budgets_global - - ! Get CAM time step - dtime = get_step_size() - - do b_ind=1,budget_num - call budget_info(b_ind,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=s_ind) - if (budget_pkgtype=='dyn') then - name_out1 = 'SE_' //trim(budget_name) - name_out2 = 'KE_' //trim(budget_name) - name_out3 = 'WV_' //trim(budget_name) - name_out4 = 'WL_' //trim(budget_name) - name_out5 = 'WI_' //trim(budget_name) - ! Normalize energy sums and convert to W/s - ! (3) compute average global integrals of budgets - sphere_surface_area = cam_mpas_global_sum_real(areaCell(1:nCells)) - do i=1,6 - glob(1:nCells,i) = te_budgets(s_ind,i,1:nCells)*areaCell(1:nCells)/sphere_surface_area - budgets_global(s_ind,i) = cam_mpas_global_sum_real(glob(1:nCells,i))/budgets_cnt(s_ind)/dtime - end do - write(iulog,*)trim(budget_name),' total energy:',budgets_global(s_ind,1) - if (.true.) budgets_cnt(s_ind)=0 - end if - end do - -end subroutine budget_globals + if (masterproc) then + call budget_get_global('phAP-phBP',1,ph_param) + call budget_get_global('phBP-phBF',1,ph_EFIX) + call budget_get_global('phAM-phAP',1,ph_DMEA) + call budget_get_global('phAP-phBF',1,ph_param_and_efix) + call budget_get_global('phAM-phBF',1,ph_phys_total) + + call budget_get_global('dyAP-dyBP',1,dy_param) + call budget_get_global('dyBP-dyBF',1,dy_EFIX) + call budget_get_global('dyAM-dyAP',1,dy_DMEA) + call budget_get_global('dyAP-dyBF',1,dy_param_and_efix) + call budget_get_global('dyAM-dyBF',1,dy_phys_total) + + call budget_get_global('dAP-dBF',1,mpas_param) + call budget_get_global('dAM-dAP',1,mpas_dmea) + call budget_get_global('dAM-dBF',1,mpas_phys_total) + + + write(iulog,*)" " + write(iulog,*)"=================================================================================" + write(iulog,*)"| |" + write(iulog,*)"| ANALYSIS OF ENERGY DIAGNOSTICS IN PHYSICS |" + write(iulog,*)"| |" + write(iulog,*)"=================================================================================" + write(iulog,*)" " + write(iulog,*)"-------------------------------------------------------" + write(iulog,*)" CAM physics energy increments (in pressure coordinate)" + write(iulog,*)"-------------------------------------------------------" + write(iulog,*)" " + write(iulog,*)"dE/dt parameterizations no efix (param) (pAP-pBP) ",ph_param," W/M^2" + write(iulog,*)"dE/dt energy fixer (efix) (pBP-pBF) ",ph_EFIX," W/M^2" + write(iulog,*)"NOTE: energy fixer uses energy formula consistent with dycore (so this is not p-based for MPAS) " + write(iulog,*)"dE/dt parameterizations + efix (pAP-pBF) ",ph_param_and_efix," W/M^2" + write(iulog,*)" " + write(iulog,*)"dE/dt dry mass adjustment (pwork) (pAM-pAP) ",ph_DMEA," W/M^2" + write(iulog,*)"dE/dt physics total (phys) (pAM-pBF) ",ph_phys_total," W/M^2" + write(iulog,*)" " + dycore = -ph_EFIX-ph_DMEA + write(iulog,*)"Dycore TE dissipation estimated from physics in pressure coordinate ",dycore," W/M^2" + write(iulog,*)"(assuming no physics-dynamics coupling errors) " + write(iulog,*)" " + write(iulog,*)"-----------------------------------------------------------------------------------" + write(iulog,*)" CAM physics dynamical core consistent energy increments (for MPAS in z coordinate)" + write(iulog,*)"-----------------------------------------------------------------------------------" + write(iulog,*)" " + write(iulog,*)"dE/dt parameterizations no efix (param) (dyAP-dyBP) ",dy_param," W/M^2" + write(iulog,*)"dE/dt energy fixer (efix) (dyBP-dyBF) ",dy_EFIX," W/M^2" + write(iulog,*)"dE/dt parameterizations + efix (dyAP-dyBF) ",dy_param_and_efix," W/M^2" + write(iulog,*)" " + write(iulog,*)"dE/dt dry mass adjustment (pwork) (dyAM-dyAP) ",dy_DMEA," W/M^2" + write(iulog,*)"dE/dt physics total (phys) (dyAM-dyBF) ",dy_phys_total," W/M^2" + write(iulog,*)" " + dycore = -dy_EFIX-dy_DMEA + write(iulog,*)"Dycore TE dissipation estimated from physics with dycore energy ",dycore," W/M^2" + write(iulog,*)"(assuming no physics-dynamics coupling errors; -efix-dme_adjust) " + write(iulog,*)" " + + + write(iulog,*)"=================================================================================" + write(iulog,*)"| |" + write(iulog,*)"| ANALYSIS OF ENERGY DIAGNOSTICS IN PHYSICS dp_coupling (MPAS) |" + write(iulog,*)"| |" + write(iulog,*)"=================================================================================" + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)"dE/dt parameterizations + efix (total physics increment) in MPAS " + write(iulog,*)"when adding as one increment - no dribbling (dAP-dBF) ",mpas_param," W/M^2" + err = ph_param_and_efix-mpas_param + write(iulog,*)"compare to same tendency in physics (MUST BE SMALL!) ",err," W/M^2" + write(iulog,*)" " + write(iulog,*)"dE/dt dry mass adjustment in MPAS (dAM-dAP) ",mpas_dmea," W/M^2" + err = dy_DMEA-mpas_dmea + write(iulog,*)"compare to same tendency in physics (MUST BE SMALL!) ",err," W/M^2" + + do m_cnst=4,6 + + if (m_cnst.eq.4) then + + write(iulog,*)"Water vapor budget" + write(iulog,*)"------------------" + end if + if (m_cnst.eq.5) then + write(iulog,*)"Cloud liquid budget" + write(iulog,*)"------------------" + end if + if (m_cnst.eq.6) then + write(iulog,*)"Cloud ice budget" + write(iulog,*)"------------------" + end if + write(iulog,*)"" + + call budget_get_global('phAP-phBP',m_cnst,param) + call budget_get_global('phBP-phBF',m_cnst,pEFIX) + call budget_get_global('phAM-phAP',m_cnst,pDMEA) + + call budget_get_global('dAM-dBF',m_cnst,param_mpas) + call budget_get_global('phAM-phBF',m_cnst,phys_total) + + write(iulog,*)"dMASS/dt energy fixer (pBP-pBF) ",pEFIX," Pa" + write(iulog,*)"dMASS/dt parameterizations (pAP-pBP) ",param," Pa" + write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",pDMEA," Pa" + write(iulog,*)"" + write(iulog,*)"" + write(iulog,*)"dMass/dt physics total in MPAS (dAM-dBF) ",param_mpas," Pa" + err = (param_mpas-param) + write(iulog,*)"Is mass budget closed? (pAP-pBP)- (dAM-dBF) ",err + write(iulog,*)"---------------------------------------------------------------------------------------------------" + write(iulog,*)" " + end do + end if +end subroutine print_budgets + subroutine budget_update(nCells,dyn_out) - - use budgets, only : budget_num, budget_info + + use budgets, only : budget_num, budget_info, budget_me_varnum,budget_put_global use physconst, only : thermodynamic_active_species_liq_num, thermodynamic_active_species_ice_num ! arguments @@ -760,18 +845,23 @@ subroutine budget_update(nCells,dyn_out) ! Local variables real(r8), pointer :: te_budgets(:,:,:) ! energy/mass budgets se,ke,wv,liq,ice integer, pointer :: budgets_cnt(:) ! budget counts for normalizating sum - integer :: b_ind,s_ind,is1,is2 + integer :: b_ind,s_ind,is1,is2,i logical :: budget_outfld character(len=64) :: name_out1,name_out2,name_out3,name_out4,name_out5,budget_name character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn real(r8) :: tmp(9,nCells) + real(r8), pointer :: areaCell(:) ! cell area (m^2) + real(r8), pointer :: budgets_global(:,:) + real(r8) :: dtime + real(r8) :: sphere_surface_area + real(r8), dimension(:) :: glob(nCells,9) !-------------------------------------------------------------------------------------- - + te_budgets => dyn_out % te_budgets budgets_cnt => dyn_out % budgets_cnt - - + + do b_ind=1,budget_num call budget_info(b_ind,optype=budget_optype, pkgtype=budget_pkgtype,state_ind=s_ind,outfld=budget_outfld,name=budget_name) if (budget_pkgtype=='dyn') then @@ -784,7 +874,7 @@ subroutine budget_update(nCells,dyn_out) else if (budget_optype=='sum') then tmp(:,:)=(te_budgets(is1,:,:)+te_budgets(is2,:,:)) end if - budgets_cnt(s_ind)=budgets_cnt(s_ind)+1 + write(iulog,*)'update calculating te_budgets diff/sum for ',budget_name,' cnt=',budgets_cnt(b_ind),' b_ind=',b_ind,' s_ind=',s_ind te_budgets(s_ind,:,:)=tmp(:,:) ! ! Output energy diagnostics @@ -810,6 +900,36 @@ subroutine budget_update(nCells,dyn_out) call outfld(name_out5, te_budgets(s_ind,6,:), nCells, 1) end if end if + budgets_cnt(b_ind)=budgets_cnt(b_ind)+1 + end if + end do + + + areaCell => dyn_out % areaCell +!jt te_budgets => dyn_out % te_budgets +!jt budgets_cnt => dyn_out % budgets_cnt + budgets_global => dyn_out % budgets_global + + ! Get CAM time step + dtime = get_step_size() + + do b_ind=1,budget_num + call budget_info(b_ind,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=s_ind) + if (budget_pkgtype=='dyn') then + ! Normalize energy sums and convert to W/s + ! (3) compute average global integrals of budgets + sphere_surface_area = cam_mpas_global_sum_real(areaCell(1:nCells)) + write(iulog,*)'calculating area for ',budget_name,' cnts=',budgets_cnt(b_ind),' b_ind=',b_ind,' s_ind=',s_ind + do i=1,budget_me_varnum + glob(1:nCells,i) = te_budgets(s_ind,i,1:nCells)*areaCell(1:nCells)/sphere_surface_area + budgets_global(b_ind,i) = cam_mpas_global_sum_real(glob(1:nCells,i))/budgets_cnt(b_ind) + ! divide by time for proper units if not a mass budget. + if (i.le.3) budgets_global(b_ind,i)=budgets_global(b_ind,i)/dtime + if (masterproc) & + call budget_put_global(trim(budget_name),i,budgets_global(b_ind,i)) + end do + if (.true.) budgets_cnt(b_ind)=0 + write(iulog,*)'setting budgets_cnt(b_ind) to zero for ',budget_name,' b_ind=',b_ind end if end do @@ -817,8 +937,8 @@ end subroutine budget_update !========================================================================================= subroutine dyn_final(dyn_in, dyn_out) - - use cam_mpas_subdriver, only : cam_mpas_finalize + + use cam_mpas_subdriver, only : cam_mpas_finalize ! Deallocates the dynamics import and export states, and finalizes ! the MPAS dycore. @@ -981,7 +1101,7 @@ subroutine read_inidat(dyn_in) real(r8), pointer :: uReconstructZ(:,:) integer :: mpas_idx, cam_idx, ierr - character(len=16) :: trac_name + character(len=32) :: trac_name character(len=*), parameter :: subname = 'dyn_comp:read_inidat' !-------------------------------------------------------------------------------------- diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 new file mode 100644 index 0000000000..062289b152 --- /dev/null +++ b/src/dynamics/se/dycore_budget.F90 @@ -0,0 +1,147 @@ +module dycore_budget + +implicit none + +public :: print_budget + + +!========================================================================================= +contains +!========================================================================================= + +subroutine print_budget() + +!!$ use budgets, only : budget_num, budget_info, budget_ind_byname, budget_get_global +!!$ +!!$ ! Local variables +!!$ integer :: b_ind,s_ind,is1,is2 +!!$ logical :: budget_outfld +!!$ character(len=64) :: name_out1,name_out2,name_out3,name_out4,name_out5,budget_name,name_out(9) +!!$ character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn +!!$ real(r8),allocatable :: tmp(:,:) +!!$ real(r8), pointer :: te_budgets(:,:,:)! energy/mass budgets se,ke,wv,liq,ice +!!$ integer, pointer :: budgets_cnt(:) ! budget counts for normalizating sum +!!$ integer :: i +!!$ character(len=*), parameter :: subname = 'check_energy:print_budgets' +!!$ +!!$ real(r8) :: ph_param,ph_EFIX,ph_DMEA,ph_param_and_efix,ph_phys_total +!!$ real(r8) :: dy_param,dy_EFIX,dy_DMEA,dy_param_and_efix,dy_phys_total +!!$ real(r8) :: mpas_param,mpas_dmea,mpas_phys_total, dycore, err, param, pefix, pdmea, param_mpas, phys_total +!!$ integer :: m_cnst +!!$ !-------------------------------------------------------------------------------------- +!!$ +!!$ if (masterproc) then +!!$ call budget_get_global('phAP-phBP',1,ph_param) +!!$ call budget_get_global('phBP-phBF',1,ph_EFIX) +!!$ call budget_get_global('phAM-phAP',1,ph_DMEA) +!!$ call budget_get_global('phAP-phBF',1,ph_param_and_efix) +!!$ call budget_get_global('phAM-phBF',1,ph_phys_total) +!!$ +!!$ call budget_get_global('dyAP-dyBP',1,dy_param) +!!$ call budget_get_global('dyBP-dyBF',1,dy_EFIX) +!!$ call budget_get_global('dyAM-dyAP',1,dy_DMEA) +!!$ call budget_get_global('dyAP-dyBF',1,dy_param_and_efix) +!!$ call budget_get_global('dyAM-dyBF',1,dy_phys_total) +!!$ +!!$ call budget_get_global('dAP-dBF',1,mpas_param) +!!$ call budget_get_global('dAM-dAP',1,mpas_dmea) +!!$ call budget_get_global('dAM-dBF',1,mpas_phys_total) +!!$ +!!$ +!!$ write(iulog,*)" " +!!$ write(iulog,*)"=================================================================================" +!!$ write(iulog,*)"| |" +!!$ write(iulog,*)"| ANALYSIS OF ENERGY DIAGNOSTICS IN PHYSICS |" +!!$ write(iulog,*)"| |" +!!$ write(iulog,*)"=================================================================================" +!!$ write(iulog,*)" " +!!$ write(iulog,*)"-------------------------------------------------------" +!!$ write(iulog,*)" CAM physics energy increments (in pressure coordinate)" +!!$ write(iulog,*)"-------------------------------------------------------" +!!$ write(iulog,*)" " +!!$ write(iulog,*)"dE/dt parameterizations no efix (param) (pAP-pBP) ",ph_param," W/M^2" +!!$ write(iulog,*)"dE/dt energy fixer (efix) (pBP-pBF) ",ph_EFIX," W/M^2" +!!$ write(iulog,*)"NOTE: energy fixer uses energy formula consistent with dycore (so this is not p-based for MPAS) " +!!$ write(iulog,*)"dE/dt parameterizations + efix (pAP-pBF) ",ph_param_and_efix," W/M^2" +!!$ write(iulog,*)" " +!!$ write(iulog,*)"dE/dt dry mass adjustment (pwork) (pAM-pAP) ",ph_DMEA," W/M^2" +!!$ write(iulog,*)"dE/dt physics total (phys) (pAM-pBF) ",ph_phys_total," W/M^2" +!!$ write(iulog,*)" " +!!$ dycore = -ph_EFIX-ph_DMEA +!!$ write(iulog,*)"Dycore TE dissipation estimated from physics in pressure coordinate ",dycore," W/M^2" +!!$ write(iulog,*)"(assuming no physics-dynamics coupling errors) " +!!$ write(iulog,*)" " +!!$ write(iulog,*)"-----------------------------------------------------------------------------------" +!!$ write(iulog,*)" CAM physics dynamical core consistent energy increments (for MPAS in z coordinate)" +!!$ write(iulog,*)"-----------------------------------------------------------------------------------" +!!$ write(iulog,*)" " +!!$ write(iulog,*)"dE/dt parameterizations no efix (param) (dyAP-dyBP) ",dy_param," W/M^2" +!!$ write(iulog,*)"dE/dt energy fixer (efix) (dyBP-dyBF) ",dy_EFIX," W/M^2" +!!$ write(iulog,*)"dE/dt parameterizations + efix (dyAP-dyBF) ",dy_param_and_efix," W/M^2" +!!$ write(iulog,*)" " +!!$ write(iulog,*)"dE/dt dry mass adjustment (pwork) (dyAM-dyAP) ",dy_DMEA," W/M^2" +!!$ write(iulog,*)"dE/dt physics total (phys) (dyAM-dyBF) ",dy_phys_total," W/M^2" +!!$ write(iulog,*)" " +!!$ dycore = -dy_EFIX-dy_DMEA +!!$ write(iulog,*)"Dycore TE dissipation estimated from physics with dycore energy ",dycore," W/M^2" +!!$ write(iulog,*)"(assuming no physics-dynamics coupling errors; -efix-dme_adjust) " +!!$ write(iulog,*)" " +!!$ +!!$ +!!$ write(iulog,*)"=================================================================================" +!!$ write(iulog,*)"| |" +!!$ write(iulog,*)"| ANALYSIS OF ENERGY DIAGNOSTICS IN PHYSICS dp_coupling (MPAS) |" +!!$ write(iulog,*)"| |" +!!$ write(iulog,*)"=================================================================================" +!!$ write(iulog,*)" " +!!$ write(iulog,*)" " +!!$ write(iulog,*)"dE/dt parameterizations + efix (total physics increment) in MPAS " +!!$ write(iulog,*)"when adding as one increment - no dribbling (dAP-dBF) ",mpas_param," W/M^2" +!!$ err = ph_param_and_efix-mpas_param +!!$ write(iulog,*)"compare to same tendency in physics (MUST BE SMALL!) ",err," W/M^2" +!!$ write(iulog,*)" " +!!$ write(iulog,*)"dE/dt dry mass adjustment in MPAS (dAM-dAP) ",mpas_dmea," W/M^2" +!!$ err = dy_DMEA-mpas_dmea +!!$ write(iulog,*)"compare to same tendency in physics (MUST BE SMALL!) ",err," W/M^2" +!!$ +!!$ do m_cnst=4,6 +!!$ +!!$ if (m_cnst.eq.4) then +!!$ +!!$ write(iulog,*)"Water vapor budget" +!!$ write(iulog,*)"------------------" +!!$ end if +!!$ if (m_cnst.eq.5) then +!!$ write(iulog,*)"Cloud liquid budget" +!!$ write(iulog,*)"------------------" +!!$ end if +!!$ if (m_cnst.eq.6) then +!!$ write(iulog,*)"Cloud ice budget" +!!$ write(iulog,*)"------------------" +!!$ end if +!!$ write(iulog,*)"" +!!$ +!!$ call budget_get_global('phAP-phBP',m_cnst,param) +!!$ call budget_get_global('phBP-phBF',m_cnst,pEFIX) +!!$ call budget_get_global('phAM-phAP',m_cnst,pDMEA) +!!$ +!!$ call budget_get_global('dAM-dBF',m_cnst,param_mpas) +!!$ call budget_get_global('phAM-phBF',m_cnst,phys_total) +!!$ +!!$ write(iulog,*)"dMASS/dt energy fixer (pBP-pBF) ",pEFIX," Pa" +!!$ write(iulog,*)"dMASS/dt parameterizations (pAP-pBP) ",param," Pa" +!!$ write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",pDMEA," Pa" +!!$ write(iulog,*)"" +!!$ write(iulog,*)"" +!!$ write(iulog,*)"dMass/dt physics total in MPAS (dAM-dBF) ",param_mpas," Pa" +!!$ err = (param_mpas-param) +!!$ write(iulog,*)"Is mass budget closed? (pAP-pBP)- (dAM-dBF) ",err +!!$ write(iulog,*)"---------------------------------------------------------------------------------------------------" +!!$ write(iulog,*)" " +!!$ end do +!!$ end if +end subroutine print_budget +!========================================================================================= + +end module dycore_budget + diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 657b0b1952..6225779c6b 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -1,4 +1,3 @@ - module check_energy !--------------------------------------------------------------------------------- @@ -187,14 +186,14 @@ subroutine check_energy_init() !----------------------------------------------------------------------- use cam_history, only: addfld, add_default, horiz_only use phys_control, only: phys_getopts - use budgets, only: budget_num, budget_outfld, budget_info + use budgets, only: budget_num, budget_outfld, budget_info, budget_me_varnum implicit none logical :: history_budget, history_waccm integer :: history_budget_histfile_num ! output history file number for budget fields integer :: m ! budget array index into te_budgets - character(len=16):: budget_name ! budget names + character(len=32):: budget_name ! budget names character(len=3) :: budget_pkgtype ! budget type phy or dyn character(len=128):: budget_longname ! long name of budgets !----------------------------------------------------------------------- @@ -592,8 +591,9 @@ subroutine check_energy_budget(state, dtime, nstep) use physics_types, only: phys_te_idx, dyn_te_idx use budgets, only: budget_num, budget_info, & budget_type_byind, budget_outfld, budget_num_phy, & - budget_cnt_adjust + budget_cnt_adjust, budget_me_varnum, budget_put_global, budget_get_global use cam_abortutils, only: endrun + use dycore_budget, only: print_budget !----------------------------------------------------------------------- ! Compute global mean total energy of physics input and output states ! computed consistently with dynamical core vertical coordinate @@ -611,20 +611,20 @@ subroutine check_energy_budget(state, dtime, nstep) integer :: lchnk ! chunk index !jt real(r8),allocatable :: te(pcols,begchunk:endchunk,budget_num_phy) - real(r8),allocatable :: te(:,:,:) ! total energy of input/output states (copy) + real(r8),allocatable :: te(:,:,:,:) ! total energy of input/output states (copy) !jt real(r8),allocatable :: te_glob(budget_num_phy) ! global means of total energy - real(r8),allocatable :: te_glob(:) ! global means of total energy + real(r8),allocatable :: te_glob(:,:) ! global means of total energy real(r8) :: phparam,dyparam,phpwork,dypwork,phefix,dyefix,phphys,dyphys integer :: i,ii,ind,is1,is2,is1b,is2b - character*16 :: budget_name ! parameterization name for fluxes + character*32 :: budget_name ! parameterization name for fluxes character*3 :: budget_pkgtype ! parameterization type phy or dyn character*3 :: budget_optype ! dif or stg !----------------------------------------------------------------------- if (.not.allocated (te)) then - allocate( te(pcols,begchunk:endchunk,budget_num_phy)) + allocate( te(pcols,begchunk:endchunk,budget_num_phy,budget_me_varnum)) end if if (.not.allocated (te_glob)) then - allocate( te_glob(budget_num_phy)) + allocate( te_glob(budget_num_phy,budget_me_varnum)) else write(iulog,*)'no alloc call shape te_glob=',shape(te_glob) end if @@ -644,9 +644,12 @@ subroutine check_energy_budget(state, dtime, nstep) call endrun() end if if (state(lchnk)%budget_cnt(is1b)==0.or.state(lchnk)%budget_cnt(is2b)==0) then - te(:,lchnk,i)=0._r8 + write(iulog,*)'zeroing because one of counts is zero ',trim(budget_name),state(lchnk)%budget_cnt(is1b),state(lchnk)%budget_cnt(is2b) +!jt te(:,lchnk,i,:)=0._r8 + te(:,lchnk,i,:) = (state(lchnk)%te_budgets(:,:,is1)-state(lchnk)%te_budgets(:,:,is2)) else - te(:,lchnk,i) = (state(lchnk)%te_budgets(:,1,is1)-state(lchnk)%te_budgets(:,1,is2))/state(lchnk)%budget_cnt(is1b)/dtime + write(iulog,*)'calculating diff for ',trim(budget_name),' cnt=',state(lchnk)%budget_cnt(is1b) + te(:,lchnk,i,:) = (state(lchnk)%te_budgets(:,:,is1)-state(lchnk)%te_budgets(:,:,is2))/state(lchnk)%budget_cnt(is1b) end if else if (budget_optype=='sum') then call budget_info(ii,stg1stateidx=is1, stg2stateidx=is2,stg1index=is1b,stg2index=is2b) @@ -655,21 +658,24 @@ subroutine check_energy_budget(state, dtime, nstep) call endrun() end if if (state(lchnk)%budget_cnt(is1b)==0.or.state(lchnk)%budget_cnt(is2b)==0) then - te(:,lchnk,i)=0._r8 +!jt te(:,lchnk,i,:)=0._r8 + te(:,lchnk,i,:) = (state(lchnk)%te_budgets(:,:,is1)+state(lchnk)%te_budgets(:,:,is2)) else - te(:,lchnk,i) = (state(lchnk)%te_budgets(:,1,is1)+state(lchnk)%te_budgets(:,1,is2))/state(lchnk)%budget_cnt(is1b)/dtime + te(:,lchnk,i,:) = (state(lchnk)%te_budgets(:,:,is1)+state(lchnk)%te_budgets(:,:,is2))/state(lchnk)%budget_cnt(is1b) end if else - te(:,lchnk,i)=state(lchnk)%te_budgets(:,1,i) + te(:,lchnk,i,:)=state(lchnk)%te_budgets(:,:,i) end if - if (budget_outfld(i).and.budget_pkgtype=='phy') call outfld(trim(budget_name), te(:ncol,lchnk,i), pcols, lchnk) + if (budget_outfld(i).and.budget_pkgtype=='phy') call outfld(trim(budget_name), te(:ncol,lchnk,i,1), pcols, lchnk) end if end do end do - ! Compute global means of input and output energies and of - ! surface pressure for heating rate (assume uniform ptop) - call gmean(te, te_glob, budget_num_phy) - + ! Compute global means of budgets + do i=1,budget_me_varnum + call gmean(te(:,:,:,i), te_glob(:,i), budget_num_phy) + !divide by time to get flux if not a mass budget + if (i.le.3) te_glob(:,i)=te_glob(:,i)/dtime + end do do ii=1,budget_num call budget_info(ii,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=i) if (budget_pkgtype=='phy') then @@ -679,29 +685,70 @@ subroutine check_energy_budget(state, dtime, nstep) end if end do - if (begchunk .le. endchunk) then - call budget_info('BD_phy_params',state_ind=ind) - dyparam = te_glob(ind) - call budget_info('BP_phy_params',state_ind=ind) - phparam = te_glob(ind) - call budget_info('BD_pwork',state_ind=ind) - dypwork = te_glob(ind) - call budget_info('BP_pwork',state_ind=ind) - phpwork = te_glob(ind) - call budget_info('BD_efix',state_ind=ind) - dyefix = te_glob(ind) - call budget_info('BP_efix',state_ind=ind) - phefix = te_glob(ind) - call budget_info('BD_phys_tot',state_ind=ind) - dyphys = te_glob(ind) - call budget_info('BP_phys_tot',state_ind=ind) - phphys = te_glob(ind) - if (masterproc) then - write(iulog,'(1x,a,1x,4(1x,e25.17))') "nstep, phys param,pwork,efix,phys", phparam, phpwork, phefix, phphys - write(iulog,'(1x,a,1x,4(1x,e25.17))') "nstep, dyn param,pwork,efix,phys", dyparam, dypwork, dyefix, dyphys - end if - end if ! (begchunk .le. endchunk) - + if (masterproc) then + do ii=1,budget_num + call budget_info(ii,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=ind) +!jt if (budget_pkgtype=='phy'.and.budget_optype=='dif') then + if (budget_pkgtype=='phy') then + do i=1,budget_me_varnum + call budget_put_global(trim(budget_name),i,te_glob(ind,i)) + end do + end if + end do +!!$ call budget_get_global('BD_phy_params',1,dyparam) +!!$ call budget_get_global('BP_phy_params',1,phparam) +!!$ call budget_get_global('BD_pwork',1,dypwork) +!!$ call budget_get_global('BP_pwork',1,phpwork) +!!$ call budget_get_global('BD_efix',1,dyefix) +!!$ call budget_get_global('BP_efix',1,phefix) +!!$ call budget_get_global('BD_phys_tot',1,dyphys) +!!$ call budget_get_global('BP_efix',1,phphys) + +!!$ call budget_info('BD_phy_params',state_ind=ind) +!!$ do i=1,budget_me_varnum +!!$ call budget_put_global('BD_phy_params',i,te_glob(ind,i)) +!!$ end do +!!$ dyparam = te_glob(ind,1) +!!$ call budget_info('BP_phy_params',state_ind=ind) +!!$ do i=1,budget_me_varnum +!!$ call budget_put_global('BP_phy_params',i,te_glob(ind,i)) +!!$ end do +!!$ phparam = te_glob(ind,1) +!!$ call budget_info('BD_pwork',state_ind=ind) +!!$ do i=1,budget_me_varnum +!!$ call budget_put_global('BD_pwork',i,te_glob(ind,i)) +!!$ end do +!!$ dypwork = te_glob(ind,1) +!!$ call budget_info('BP_pwork',state_ind=ind) +!!$ do i=1,budget_me_varnum +!!$ call budget_put_global('BP_pwork',i,te_glob(ind,i)) +!!$ end do +!!$ phpwork = te_glob(ind,1) +!!$ call budget_info('BD_efix',state_ind=ind) +!!$ do i=1,budget_me_varnum +!!$ call budget_put_global('BD_efix',i,te_glob(ind,i)) +!!$ end do +!!$ dyefix = te_glob(ind,1) +!!$ call budget_info('BP_efix',state_ind=ind) +!!$ do i=1,budget_me_varnum +!!$ call budget_put_global('BP_efix',i,te_glob(ind,i)) +!!$ end do +!!$ phefix = te_glob(ind,1) +!!$ call budget_info('BD_phys_tot',state_ind=ind) +!!$ do i=1,budget_me_varnum +!!$ call budget_put_global('BD_phys_tot',i,te_glob(ind,i)) +!!$ end do +!!$ dyphys = te_glob(ind,1) +!!$ call budget_info('BP_phys_tot',state_ind=ind) +!!$ do i=1,budget_me_varnum +!!$ call budget_put_global('BP_phys_tot',i,te_glob(ind,i)) +!!$ end do +!!$ phphys = te_glob(ind,1) +!!$ !jt if (masterproc) then +!!$ write(iulog,'(1x,a,1x,4(1x,e25.17))') "nstep, phys param,pwork,efix,phys", phparam, phpwork, phefix, phphys +!!$ write(iulog,'(1x,a,1x,4(1x,e25.17))') "nstep, dyn param,pwork,efix,phys", dyparam, dypwork, dyefix, dyphys + end if + call print_budget() end subroutine check_energy_budget !=============================================================================== @@ -987,7 +1034,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix, vc) integer :: vc_loc ! local vertical coordinate variable integer :: ind,budget_ind ! budget array index integer :: ixtt ! test tracer index - character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 + character(len=32) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 !----------------------------------------------------------------------- name_out1 = 'SE_' //trim(outfld_name_suffix) @@ -1119,5 +1166,4 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix, vc) !!jt end if end subroutine calc_te_and_aam_budgets - end module check_energy diff --git a/src/physics/cam/physics_types.F90 b/src/physics/cam/physics_types.F90 index a53d6306c5..44fdf09f8b 100644 --- a/src/physics/cam/physics_types.F90 +++ b/src/physics/cam/physics_types.F90 @@ -13,7 +13,7 @@ module physics_types use cam_abortutils, only: endrun use phys_control, only: waccmx_is use shr_const_mod, only: shr_const_rwv - use budgets, only: budget_array_max,budget_name + use budgets, only: budget_array_max,budget_name,budget_me_varnum implicit none private ! Make default type private to the module @@ -1441,7 +1441,7 @@ subroutine physics_state_copy(state_in, state_out) end do do m = 1, budget_array_max - do k = 1, 7 + do k = 1, budget_me_varnum do i = 1, ncol state_out%te_budgets(i,k,m) = state_in%te_budgets(i,k,m) end do diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 373f1c6c7f..908ae10447 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -213,6 +213,8 @@ subroutine phys_register call budget_add('BD_efix','dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E (dyBP-dyBF)',outfld=.true.) call budget_add('BP_phys_tot','phAM','phBF','phy','dif',longname='dE/dt physics total (phAM-phBF)',outfld=.true.) call budget_add('BD_phys_tot','dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)',outfld=.true.) + call budget_add('BP_param_and_efix','phAP','phBF','phy','dif',longname='dE/dt parameterizations + efix (phAP-phBF)',outfld=.true.) + call budget_add('BD_param_and_efix','dyAP','dyBF','phy','dif',longname='dE/dt parameterizations + efix dycore E (dyAP-dyBF)',outfld=.true.) ! Register water vapor. ! ***** N.B. ***** This must be the first call to cnst_add so that @@ -816,7 +818,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! temperature, water vapor, cloud ! ice, cloud liquid, U, V integer :: history_budget_histfile_num ! output history file number for budget fields - character*16 :: budget_name ! parameterization name for fluxes + character*32 :: budget_name ! parameterization name for fluxes character*128 :: budget_longname ! parameterization name for fluxes !----------------------------------------------------------------------- From 4bf1777078072eb86cd9ac6b6afe3a7916661e6f Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 15 Sep 2022 02:33:59 -0600 Subject: [PATCH 012/140] remove some debug printout --- src/control/budgets.F90 | 29 +------ src/dynamics/mpas/dyn_comp.F90 | 144 ------------------------------- src/physics/cam/check_energy.F90 | 52 +---------- 3 files changed, 3 insertions(+), 222 deletions(-) diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index 4f0fb60c8c..851561a944 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -90,23 +90,6 @@ subroutine budget_readnl(nlfile) !----------------------------------------------------------------------------- -!!$ if (masterproc) then -!!$ unitn = getunit() -!!$ open( unitn, file=trim(nlfile), status='old' ) -!!$ call find_group_name(unitn, 'budgets_nl', status=ierr) -!!$ if (ierr == 0) then -!!$ read(unitn, budgets_nl, iostat=ierr) -!!$ if (ierr /= 0) then -!!$ call endrun(sub//': FATAL: reading namelist') -!!$ end if -!!$ end if -!!$ close(unitn) -!!$ call freeunit(unitn) -!!$ end if - -!!$ if (masterproc) then -!!$ write(iulog,*)'Summary of budget module options:' -!!$ end if end subroutine budget_readnl @@ -529,7 +512,6 @@ subroutine budget_get_global (name, me_idx, global, abort) do m = 1, budget_array_max if (trim(name) == trim(budget_stagename(m)).or.trim(name)==trim(budget_name(m))) then global = budget_globals(m,me_idx) - if (me_idx==1) write(iulog,*)'found global for ',trim(name),'=',global return end if end do @@ -539,8 +521,6 @@ subroutine budget_get_global (name, me_idx, global, abort) if (present(abort)) abort_on_error = abort if (abort_on_error) then - write(iulog, *) sub//': FATAL: name:', name, ' not found in list:', budget_name(:) - write(iulog, *) sub//': FATAL: name:', name, ' not found in list:', budget_stagename(:) call endrun(sub//': FATAL: name not found') end if @@ -569,7 +549,6 @@ subroutine budget_put_global (name, me_idx, global, abort) do m = 1, budget_array_max if (trim(name) == trim(budget_stagename(m)).or.trim(name)==trim(budget_name(m))) then budget_globals(m,me_idx) = global - if (me_idx==1) write(iulog,*)'putting global for ',trim(name),'=',global return end if end do @@ -579,8 +558,6 @@ subroutine budget_put_global (name, me_idx, global, abort) if (present(abort)) abort_on_error = abort if (abort_on_error) then - write(iulog, *) sub//': FATAL: name:', name, ' not found in list:', budget_name(:) - write(iulog, *) sub//': FATAL: name:', name, ' not found in list:', budget_stagename(:) call endrun(sub//': FATAL: name not found') end if @@ -617,8 +594,6 @@ subroutine budget_get_ind (name, budget_ind, abort) if (present(abort)) abort_on_error = abort if (abort_on_error) then - write(iulog, *) sub//': FATAL: name:', name, ' not found in list:', budget_name(:) - write(iulog, *) sub//': FATAL: name:', name, ' not found in list:', budget_stagename(:) call endrun(sub//': FATAL: name not found') end if @@ -651,9 +626,7 @@ function budget_ind_byname (name) end do if (budget_ind_byname == -1) then write(iulog,*)'ind_byname failed, name=',trim(name),'budget_name=' - do m = 1, budget_array_max - write(iulog,*)'budget_name(',m,')=',trim(budget_name(m)) - end do + call endrun() end if !============================================================================== diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index e0f047c9a2..8d652d928f 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -630,9 +630,6 @@ subroutine dyn_init(dyn_in, dyn_out) ! ! add budgets that are derived from stages ! -!!$ call budget_add('BD_dparm','dAP','dBF',pkgtype='dyn',optype='dif',longname="dE/dt parameterizations+efix in dycore (dparam)(dAP-dBF)",outfld=.true.) -!!$ call budget_add('BD_DMEA' ,'dAM','dAP',pkgtype='dyn',optype='dif',longname="dE/dt dry mass adjustment in dycore (dAM-dAP)",outfld=.true.) -!!$ call budget_add('param_mpas' ,'dAM','dBF',pkgtype='dyn',optype='dif',longname="dE/dt physics total in dycore (phys) (dAM-dBF)",outfld=.true.) call budget_add('mpas_param','dAP','dBF',pkgtype='dyn',optype='dif',longname="dE/dt parameterizations+efix in dycore (dparam)(dAP-dBF)",outfld=.false.) call budget_add('mpas_dmea' ,'dAM','dAP',pkgtype='dyn',optype='dif',longname="dE/dt dry mass adjustment in dycore (dAM-dAP)",outfld=.false.) @@ -692,147 +689,9 @@ subroutine dyn_run(dyn_in, dyn_out) ! update energy budgets calculated from snapshots (stages) call budget_update(dyn_in%nCellsSolve,dyn_out) -!jt call print_budgets(dyn_in%nCellsSolve,dyn_out) end subroutine dyn_run -subroutine print_budgets(nCells,dyn_out) - - use budgets, only : budget_num, budget_info, budget_ind_byname, budget_get_global - - ! arguments - integer, intent(in) :: nCells ! Number of cells, including halo cells - type (dyn_export_t), intent(inout) :: dyn_out - - ! Local variables - integer :: b_ind,s_ind,is1,is2 - logical :: budget_outfld - character(len=64) :: name_out1,name_out2,name_out3,name_out4,name_out5,budget_name,name_out(9) - character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn - real(r8),allocatable :: tmp(:,:) - real(r8), pointer :: te_budgets(:,:,:)! energy/mass budgets se,ke,wv,liq,ice - integer, pointer :: budgets_cnt(:) ! budget counts for normalizating sum - integer :: i - character(len=*), parameter :: subname = 'dyn_comp:print_budgets' - - real(r8) :: ph_param,ph_EFIX,ph_DMEA,ph_param_and_efix,ph_phys_total - real(r8) :: dy_param,dy_EFIX,dy_DMEA,dy_param_and_efix,dy_phys_total - real(r8) :: mpas_param,mpas_dmea,mpas_phys_total, dycore, err, param, pefix, pdmea, param_mpas, phys_total - integer :: m_cnst - !-------------------------------------------------------------------------------------- - - if (masterproc) then - call budget_get_global('phAP-phBP',1,ph_param) - call budget_get_global('phBP-phBF',1,ph_EFIX) - call budget_get_global('phAM-phAP',1,ph_DMEA) - call budget_get_global('phAP-phBF',1,ph_param_and_efix) - call budget_get_global('phAM-phBF',1,ph_phys_total) - - call budget_get_global('dyAP-dyBP',1,dy_param) - call budget_get_global('dyBP-dyBF',1,dy_EFIX) - call budget_get_global('dyAM-dyAP',1,dy_DMEA) - call budget_get_global('dyAP-dyBF',1,dy_param_and_efix) - call budget_get_global('dyAM-dyBF',1,dy_phys_total) - - call budget_get_global('dAP-dBF',1,mpas_param) - call budget_get_global('dAM-dAP',1,mpas_dmea) - call budget_get_global('dAM-dBF',1,mpas_phys_total) - - - write(iulog,*)" " - write(iulog,*)"=================================================================================" - write(iulog,*)"| |" - write(iulog,*)"| ANALYSIS OF ENERGY DIAGNOSTICS IN PHYSICS |" - write(iulog,*)"| |" - write(iulog,*)"=================================================================================" - write(iulog,*)" " - write(iulog,*)"-------------------------------------------------------" - write(iulog,*)" CAM physics energy increments (in pressure coordinate)" - write(iulog,*)"-------------------------------------------------------" - write(iulog,*)" " - write(iulog,*)"dE/dt parameterizations no efix (param) (pAP-pBP) ",ph_param," W/M^2" - write(iulog,*)"dE/dt energy fixer (efix) (pBP-pBF) ",ph_EFIX," W/M^2" - write(iulog,*)"NOTE: energy fixer uses energy formula consistent with dycore (so this is not p-based for MPAS) " - write(iulog,*)"dE/dt parameterizations + efix (pAP-pBF) ",ph_param_and_efix," W/M^2" - write(iulog,*)" " - write(iulog,*)"dE/dt dry mass adjustment (pwork) (pAM-pAP) ",ph_DMEA," W/M^2" - write(iulog,*)"dE/dt physics total (phys) (pAM-pBF) ",ph_phys_total," W/M^2" - write(iulog,*)" " - dycore = -ph_EFIX-ph_DMEA - write(iulog,*)"Dycore TE dissipation estimated from physics in pressure coordinate ",dycore," W/M^2" - write(iulog,*)"(assuming no physics-dynamics coupling errors) " - write(iulog,*)" " - write(iulog,*)"-----------------------------------------------------------------------------------" - write(iulog,*)" CAM physics dynamical core consistent energy increments (for MPAS in z coordinate)" - write(iulog,*)"-----------------------------------------------------------------------------------" - write(iulog,*)" " - write(iulog,*)"dE/dt parameterizations no efix (param) (dyAP-dyBP) ",dy_param," W/M^2" - write(iulog,*)"dE/dt energy fixer (efix) (dyBP-dyBF) ",dy_EFIX," W/M^2" - write(iulog,*)"dE/dt parameterizations + efix (dyAP-dyBF) ",dy_param_and_efix," W/M^2" - write(iulog,*)" " - write(iulog,*)"dE/dt dry mass adjustment (pwork) (dyAM-dyAP) ",dy_DMEA," W/M^2" - write(iulog,*)"dE/dt physics total (phys) (dyAM-dyBF) ",dy_phys_total," W/M^2" - write(iulog,*)" " - dycore = -dy_EFIX-dy_DMEA - write(iulog,*)"Dycore TE dissipation estimated from physics with dycore energy ",dycore," W/M^2" - write(iulog,*)"(assuming no physics-dynamics coupling errors; -efix-dme_adjust) " - write(iulog,*)" " - - - write(iulog,*)"=================================================================================" - write(iulog,*)"| |" - write(iulog,*)"| ANALYSIS OF ENERGY DIAGNOSTICS IN PHYSICS dp_coupling (MPAS) |" - write(iulog,*)"| |" - write(iulog,*)"=================================================================================" - write(iulog,*)" " - write(iulog,*)" " - write(iulog,*)"dE/dt parameterizations + efix (total physics increment) in MPAS " - write(iulog,*)"when adding as one increment - no dribbling (dAP-dBF) ",mpas_param," W/M^2" - err = ph_param_and_efix-mpas_param - write(iulog,*)"compare to same tendency in physics (MUST BE SMALL!) ",err," W/M^2" - write(iulog,*)" " - write(iulog,*)"dE/dt dry mass adjustment in MPAS (dAM-dAP) ",mpas_dmea," W/M^2" - err = dy_DMEA-mpas_dmea - write(iulog,*)"compare to same tendency in physics (MUST BE SMALL!) ",err," W/M^2" - - do m_cnst=4,6 - - if (m_cnst.eq.4) then - - write(iulog,*)"Water vapor budget" - write(iulog,*)"------------------" - end if - if (m_cnst.eq.5) then - write(iulog,*)"Cloud liquid budget" - write(iulog,*)"------------------" - end if - if (m_cnst.eq.6) then - write(iulog,*)"Cloud ice budget" - write(iulog,*)"------------------" - end if - write(iulog,*)"" - - call budget_get_global('phAP-phBP',m_cnst,param) - call budget_get_global('phBP-phBF',m_cnst,pEFIX) - call budget_get_global('phAM-phAP',m_cnst,pDMEA) - - call budget_get_global('dAM-dBF',m_cnst,param_mpas) - call budget_get_global('phAM-phBF',m_cnst,phys_total) - - write(iulog,*)"dMASS/dt energy fixer (pBP-pBF) ",pEFIX," Pa" - write(iulog,*)"dMASS/dt parameterizations (pAP-pBP) ",param," Pa" - write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",pDMEA," Pa" - write(iulog,*)"" - write(iulog,*)"" - write(iulog,*)"dMass/dt physics total in MPAS (dAM-dBF) ",param_mpas," Pa" - err = (param_mpas-param) - write(iulog,*)"Is mass budget closed? (pAP-pBP)- (dAM-dBF) ",err - write(iulog,*)"---------------------------------------------------------------------------------------------------" - write(iulog,*)" " - end do - end if -end subroutine print_budgets - subroutine budget_update(nCells,dyn_out) use budgets, only : budget_num, budget_info, budget_me_varnum,budget_put_global @@ -874,7 +733,6 @@ subroutine budget_update(nCells,dyn_out) else if (budget_optype=='sum') then tmp(:,:)=(te_budgets(is1,:,:)+te_budgets(is2,:,:)) end if - write(iulog,*)'update calculating te_budgets diff/sum for ',budget_name,' cnt=',budgets_cnt(b_ind),' b_ind=',b_ind,' s_ind=',s_ind te_budgets(s_ind,:,:)=tmp(:,:) ! ! Output energy diagnostics @@ -919,7 +777,6 @@ subroutine budget_update(nCells,dyn_out) ! Normalize energy sums and convert to W/s ! (3) compute average global integrals of budgets sphere_surface_area = cam_mpas_global_sum_real(areaCell(1:nCells)) - write(iulog,*)'calculating area for ',budget_name,' cnts=',budgets_cnt(b_ind),' b_ind=',b_ind,' s_ind=',s_ind do i=1,budget_me_varnum glob(1:nCells,i) = te_budgets(s_ind,i,1:nCells)*areaCell(1:nCells)/sphere_surface_area budgets_global(b_ind,i) = cam_mpas_global_sum_real(glob(1:nCells,i))/budgets_cnt(b_ind) @@ -929,7 +786,6 @@ subroutine budget_update(nCells,dyn_out) call budget_put_global(trim(budget_name),i,budgets_global(b_ind,i)) end do if (.true.) budgets_cnt(b_ind)=0 - write(iulog,*)'setting budgets_cnt(b_ind) to zero for ',budget_name,' b_ind=',b_ind end if end do diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 6225779c6b..ff86048cab 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -644,11 +644,8 @@ subroutine check_energy_budget(state, dtime, nstep) call endrun() end if if (state(lchnk)%budget_cnt(is1b)==0.or.state(lchnk)%budget_cnt(is2b)==0) then - write(iulog,*)'zeroing because one of counts is zero ',trim(budget_name),state(lchnk)%budget_cnt(is1b),state(lchnk)%budget_cnt(is2b) -!jt te(:,lchnk,i,:)=0._r8 - te(:,lchnk,i,:) = (state(lchnk)%te_budgets(:,:,is1)-state(lchnk)%te_budgets(:,:,is2)) + te(:,lchnk,i,:)=0._r8 else - write(iulog,*)'calculating diff for ',trim(budget_name),' cnt=',state(lchnk)%budget_cnt(is1b) te(:,lchnk,i,:) = (state(lchnk)%te_budgets(:,:,is1)-state(lchnk)%te_budgets(:,:,is2))/state(lchnk)%budget_cnt(is1b) end if else if (budget_optype=='sum') then @@ -658,8 +655,7 @@ subroutine check_energy_budget(state, dtime, nstep) call endrun() end if if (state(lchnk)%budget_cnt(is1b)==0.or.state(lchnk)%budget_cnt(is2b)==0) then -!jt te(:,lchnk,i,:)=0._r8 - te(:,lchnk,i,:) = (state(lchnk)%te_budgets(:,:,is1)+state(lchnk)%te_budgets(:,:,is2)) + te(:,lchnk,i,:)=0._r8 else te(:,lchnk,i,:) = (state(lchnk)%te_budgets(:,:,is1)+state(lchnk)%te_budgets(:,:,is2))/state(lchnk)%budget_cnt(is1b) end if @@ -688,7 +684,6 @@ subroutine check_energy_budget(state, dtime, nstep) if (masterproc) then do ii=1,budget_num call budget_info(ii,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=ind) -!jt if (budget_pkgtype=='phy'.and.budget_optype=='dif') then if (budget_pkgtype=='phy') then do i=1,budget_me_varnum call budget_put_global(trim(budget_name),i,te_glob(ind,i)) @@ -704,47 +699,6 @@ subroutine check_energy_budget(state, dtime, nstep) !!$ call budget_get_global('BD_phys_tot',1,dyphys) !!$ call budget_get_global('BP_efix',1,phphys) -!!$ call budget_info('BD_phy_params',state_ind=ind) -!!$ do i=1,budget_me_varnum -!!$ call budget_put_global('BD_phy_params',i,te_glob(ind,i)) -!!$ end do -!!$ dyparam = te_glob(ind,1) -!!$ call budget_info('BP_phy_params',state_ind=ind) -!!$ do i=1,budget_me_varnum -!!$ call budget_put_global('BP_phy_params',i,te_glob(ind,i)) -!!$ end do -!!$ phparam = te_glob(ind,1) -!!$ call budget_info('BD_pwork',state_ind=ind) -!!$ do i=1,budget_me_varnum -!!$ call budget_put_global('BD_pwork',i,te_glob(ind,i)) -!!$ end do -!!$ dypwork = te_glob(ind,1) -!!$ call budget_info('BP_pwork',state_ind=ind) -!!$ do i=1,budget_me_varnum -!!$ call budget_put_global('BP_pwork',i,te_glob(ind,i)) -!!$ end do -!!$ phpwork = te_glob(ind,1) -!!$ call budget_info('BD_efix',state_ind=ind) -!!$ do i=1,budget_me_varnum -!!$ call budget_put_global('BD_efix',i,te_glob(ind,i)) -!!$ end do -!!$ dyefix = te_glob(ind,1) -!!$ call budget_info('BP_efix',state_ind=ind) -!!$ do i=1,budget_me_varnum -!!$ call budget_put_global('BP_efix',i,te_glob(ind,i)) -!!$ end do -!!$ phefix = te_glob(ind,1) -!!$ call budget_info('BD_phys_tot',state_ind=ind) -!!$ do i=1,budget_me_varnum -!!$ call budget_put_global('BD_phys_tot',i,te_glob(ind,i)) -!!$ end do -!!$ dyphys = te_glob(ind,1) -!!$ call budget_info('BP_phys_tot',state_ind=ind) -!!$ do i=1,budget_me_varnum -!!$ call budget_put_global('BP_phys_tot',i,te_glob(ind,i)) -!!$ end do -!!$ phphys = te_glob(ind,1) -!!$ !jt if (masterproc) then !!$ write(iulog,'(1x,a,1x,4(1x,e25.17))') "nstep, phys param,pwork,efix,phys", phparam, phpwork, phefix, phphys !!$ write(iulog,'(1x,a,1x,4(1x,e25.17))') "nstep, dyn param,pwork,efix,phys", dyparam, dypwork, dyefix, dyphys end if @@ -779,13 +733,11 @@ subroutine check_energy_fix(state, ptend, nstep, eshflx) #endif ! add (-) global mean total energy difference as heating ptend%s(:ncol,:pver) = heat_glob -!!$ write(iulog,*) "chk_fix: heat", state%lchnk, ncol, heat_glob ! compute effective sensible heat flux do i = 1, ncol eshflx(i) = heat_glob * (state%pint(i,pver+1) - state%pint(i,1)) / gravit end do -!!! if (nstep > 0) write(iulog,*) "heat", heat_glob, eshflx(1) return end subroutine check_energy_fix From b3b97aaca7f7bb0c3e5c06d0619464d42c8a19ad Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 6 Oct 2022 17:02:34 -0600 Subject: [PATCH 013/140] mass fixes for se dycore --- src/control/budgets.F90 | 31 +- src/dynamics/se/dycore/prim_advance_mod.F90 | 13 +- src/dynamics/se/dycore_budget.F90 | 463 ++++++++++++++------ src/dynamics/se/dyn_comp.F90 | 167 ++++--- src/physics/cam/check_energy.F90 | 12 +- 5 files changed, 468 insertions(+), 218 deletions(-) diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index 851561a944..7b614ded09 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -36,6 +36,7 @@ module budgets budget_info, &! return budget info by ind budget_cnt_adjust, &! advance or reset budget count budget_count, &! return budget count + is_budget, &! return budget count budget_get_global, &! return budget count budget_put_global, &! return budget count budget_outfld ! Returns true if default CAM output was specified in the budget_stage_add calls. @@ -506,6 +507,7 @@ subroutine budget_get_global (name, me_idx, global, abort) integer :: m ! budget index logical :: abort_on_error character(len=*), parameter :: sub='budget_get_global' + character(len=128) :: errmsg !----------------------------------------------------------------------- ! Find budget name in list @@ -521,7 +523,8 @@ subroutine budget_get_global (name, me_idx, global, abort) if (present(abort)) abort_on_error = abort if (abort_on_error) then - call endrun(sub//': FATAL: name not found') + write(errmsg,*) sub//': FATAL: name not found: ', trim(name) + call endrun(errmsg) end if end subroutine budget_get_global @@ -674,6 +677,32 @@ function budget_outfld(m) end function budget_outfld +function is_budget(name) + + ! Get the index of a budget. Optional abort argument allows returning + ! control to caller when budget name is not found. Default behavior is + ! to call endrun when name is not found. + + !-----------------------------Arguments--------------------------------- + character(len=*), intent(in) :: name ! budget name + + !---------------------------Local workspace----------------------------- + logical :: is_budget ! function return + integer :: m ! budget index + character(len=*), parameter :: sub='is_budget' + !----------------------------------------------------------------------- + + ! Find budget name in list of defined budgets + + is_budget = .false. + do m = 1, budget_array_max + if (trim(name) == trim(budget_name(m)).or.trim(name) == trim(budget_stagename(m))) then + is_budget = .true. + return + end if + end do + end function is_budget +!============================================================================== function budget_count(ind) ! Query whether default CAM outfld calls should be made. diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index c796da140b..1075c3e617 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -1649,36 +1649,32 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf call util_function(elem(ie)%state%qdp(:,:,:,1,tl_qdp),np,nlev,name_out3,ie) do j = 1, np do i = 1, np - elem(ie)%derived%budget(i,j,4,state_ind) = elem(ie)%derived%budget(i,j,4,state_ind) + sum(elem(ie)%state%qdp(i,j,:,1,tl_qdp)) + elem(ie)%derived%budget(i,j,4,state_ind) = elem(ie)%derived%budget(i,j,4,state_ind) + sum(elem(ie)%state%qdp(i,j,:,1,tl_qdp)/gravit) end do end do - elem(ie)%derived%budget(1:np,1:np,4,state_ind)=elem(ie)%derived%budget(1:np,1:np,4,state_ind)/gravit if (ixcldliq>0) then call util_function(elem(ie)%state%qdp(:,:,:,ixcldliq,tl_qdp),np,nlev,name_out4,ie) do j = 1, np do i = 1, np - elem(ie)%derived%budget(i,j,4,state_ind) = elem(ie)%derived%budget(i,j,4,state_ind) + sum(elem(ie)%state%qdp(i,j,:,1,tl_qdp)) + elem(ie)%derived%budget(i,j,5,state_ind) = elem(ie)%derived%budget(i,j,5,state_ind) + sum(elem(ie)%state%qdp(i,j,:,ixcldliq,tl_qdp)/gravit) end do end do - elem(ie)%derived%budget(1:np,1:np,4,state_ind)=elem(ie)%derived%budget(1:np,1:np,4,state_ind)/gravit end if if (ixcldice>0) then call util_function(elem(ie)%state%qdp(:,:,:,ixcldice,tl_qdp),np,nlev,name_out5,ie) do j = 1, np do i = 1, np - elem(ie)%derived%budget(i,j,6,state_ind) = elem(ie)%derived%budget(i,j,6,state_ind) + sum(elem(ie)%state%qdp(i,j,:,ixcldice,tl_qdp)) + elem(ie)%derived%budget(i,j,6,state_ind) = elem(ie)%derived%budget(i,j,6,state_ind) + sum(elem(ie)%state%qdp(i,j,:,ixcldice,tl_qdp)/gravit) end do end do - elem(ie)%derived%budget(1:np,1:np,6,state_ind)=elem(ie)%derived%budget(1:np,1:np,6,state_ind)/gravit end if if (ixtt>0) then call util_function(elem(ie)%state%qdp(:,:,:,ixtt ,tl_qdp),np,nlev,name_out6,ie) do j = 1, np do i = 1, np - elem(ie)%derived%budget(i,j,7,state_ind) = elem(ie)%derived%budget(i,j,7,state_ind) + sum(elem(ie)%state%qdp(i,j,:,ixtt,tl_qdp)) + elem(ie)%derived%budget(i,j,7,state_ind) = elem(ie)%derived%budget(i,j,7,state_ind) + sum(elem(ie)%state%qdp(i,j,:,ixtt,tl_qdp)/gravit) end do end do - elem(ie)%derived%budget(1:np,1:np,7,state_ind)=elem(ie)%derived%budget(1:np,1:np,7,state_ind)/gravit end if end if end do @@ -1749,7 +1745,6 @@ subroutine calc_tot_energy_dynamics_diff(elem,fvm,nets,nete,tl,tl_qdp,outfld_nam use physconst, only: thermodynamic_active_species_ice_idx use budgets, only: budget_info,budget_ind_byname - use cam_logfile, only: iulog !------------------------------Arguments-------------------------------- type (element_t) , intent(inout) :: elem(:) diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index 062289b152..3c69b907b7 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -11,135 +11,340 @@ module dycore_budget subroutine print_budget() -!!$ use budgets, only : budget_num, budget_info, budget_ind_byname, budget_get_global -!!$ -!!$ ! Local variables -!!$ integer :: b_ind,s_ind,is1,is2 -!!$ logical :: budget_outfld -!!$ character(len=64) :: name_out1,name_out2,name_out3,name_out4,name_out5,budget_name,name_out(9) -!!$ character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn -!!$ real(r8),allocatable :: tmp(:,:) -!!$ real(r8), pointer :: te_budgets(:,:,:)! energy/mass budgets se,ke,wv,liq,ice -!!$ integer, pointer :: budgets_cnt(:) ! budget counts for normalizating sum -!!$ integer :: i -!!$ character(len=*), parameter :: subname = 'check_energy:print_budgets' -!!$ -!!$ real(r8) :: ph_param,ph_EFIX,ph_DMEA,ph_param_and_efix,ph_phys_total -!!$ real(r8) :: dy_param,dy_EFIX,dy_DMEA,dy_param_and_efix,dy_phys_total -!!$ real(r8) :: mpas_param,mpas_dmea,mpas_phys_total, dycore, err, param, pefix, pdmea, param_mpas, phys_total -!!$ integer :: m_cnst -!!$ !-------------------------------------------------------------------------------------- -!!$ -!!$ if (masterproc) then -!!$ call budget_get_global('phAP-phBP',1,ph_param) -!!$ call budget_get_global('phBP-phBF',1,ph_EFIX) -!!$ call budget_get_global('phAM-phAP',1,ph_DMEA) -!!$ call budget_get_global('phAP-phBF',1,ph_param_and_efix) -!!$ call budget_get_global('phAM-phBF',1,ph_phys_total) -!!$ -!!$ call budget_get_global('dyAP-dyBP',1,dy_param) -!!$ call budget_get_global('dyBP-dyBF',1,dy_EFIX) -!!$ call budget_get_global('dyAM-dyAP',1,dy_DMEA) -!!$ call budget_get_global('dyAP-dyBF',1,dy_param_and_efix) -!!$ call budget_get_global('dyAM-dyBF',1,dy_phys_total) -!!$ -!!$ call budget_get_global('dAP-dBF',1,mpas_param) -!!$ call budget_get_global('dAM-dAP',1,mpas_dmea) -!!$ call budget_get_global('dAM-dBF',1,mpas_phys_total) -!!$ -!!$ -!!$ write(iulog,*)" " -!!$ write(iulog,*)"=================================================================================" -!!$ write(iulog,*)"| |" -!!$ write(iulog,*)"| ANALYSIS OF ENERGY DIAGNOSTICS IN PHYSICS |" -!!$ write(iulog,*)"| |" -!!$ write(iulog,*)"=================================================================================" -!!$ write(iulog,*)" " -!!$ write(iulog,*)"-------------------------------------------------------" -!!$ write(iulog,*)" CAM physics energy increments (in pressure coordinate)" -!!$ write(iulog,*)"-------------------------------------------------------" -!!$ write(iulog,*)" " -!!$ write(iulog,*)"dE/dt parameterizations no efix (param) (pAP-pBP) ",ph_param," W/M^2" -!!$ write(iulog,*)"dE/dt energy fixer (efix) (pBP-pBF) ",ph_EFIX," W/M^2" -!!$ write(iulog,*)"NOTE: energy fixer uses energy formula consistent with dycore (so this is not p-based for MPAS) " -!!$ write(iulog,*)"dE/dt parameterizations + efix (pAP-pBF) ",ph_param_and_efix," W/M^2" -!!$ write(iulog,*)" " -!!$ write(iulog,*)"dE/dt dry mass adjustment (pwork) (pAM-pAP) ",ph_DMEA," W/M^2" -!!$ write(iulog,*)"dE/dt physics total (phys) (pAM-pBF) ",ph_phys_total," W/M^2" -!!$ write(iulog,*)" " -!!$ dycore = -ph_EFIX-ph_DMEA -!!$ write(iulog,*)"Dycore TE dissipation estimated from physics in pressure coordinate ",dycore," W/M^2" -!!$ write(iulog,*)"(assuming no physics-dynamics coupling errors) " -!!$ write(iulog,*)" " -!!$ write(iulog,*)"-----------------------------------------------------------------------------------" -!!$ write(iulog,*)" CAM physics dynamical core consistent energy increments (for MPAS in z coordinate)" -!!$ write(iulog,*)"-----------------------------------------------------------------------------------" -!!$ write(iulog,*)" " -!!$ write(iulog,*)"dE/dt parameterizations no efix (param) (dyAP-dyBP) ",dy_param," W/M^2" -!!$ write(iulog,*)"dE/dt energy fixer (efix) (dyBP-dyBF) ",dy_EFIX," W/M^2" -!!$ write(iulog,*)"dE/dt parameterizations + efix (dyAP-dyBF) ",dy_param_and_efix," W/M^2" -!!$ write(iulog,*)" " -!!$ write(iulog,*)"dE/dt dry mass adjustment (pwork) (dyAM-dyAP) ",dy_DMEA," W/M^2" -!!$ write(iulog,*)"dE/dt physics total (phys) (dyAM-dyBF) ",dy_phys_total," W/M^2" -!!$ write(iulog,*)" " -!!$ dycore = -dy_EFIX-dy_DMEA -!!$ write(iulog,*)"Dycore TE dissipation estimated from physics with dycore energy ",dycore," W/M^2" -!!$ write(iulog,*)"(assuming no physics-dynamics coupling errors; -efix-dme_adjust) " -!!$ write(iulog,*)" " -!!$ -!!$ -!!$ write(iulog,*)"=================================================================================" -!!$ write(iulog,*)"| |" -!!$ write(iulog,*)"| ANALYSIS OF ENERGY DIAGNOSTICS IN PHYSICS dp_coupling (MPAS) |" -!!$ write(iulog,*)"| |" -!!$ write(iulog,*)"=================================================================================" -!!$ write(iulog,*)" " -!!$ write(iulog,*)" " -!!$ write(iulog,*)"dE/dt parameterizations + efix (total physics increment) in MPAS " -!!$ write(iulog,*)"when adding as one increment - no dribbling (dAP-dBF) ",mpas_param," W/M^2" -!!$ err = ph_param_and_efix-mpas_param -!!$ write(iulog,*)"compare to same tendency in physics (MUST BE SMALL!) ",err," W/M^2" -!!$ write(iulog,*)" " -!!$ write(iulog,*)"dE/dt dry mass adjustment in MPAS (dAM-dAP) ",mpas_dmea," W/M^2" -!!$ err = dy_DMEA-mpas_dmea -!!$ write(iulog,*)"compare to same tendency in physics (MUST BE SMALL!) ",err," W/M^2" -!!$ -!!$ do m_cnst=4,6 -!!$ -!!$ if (m_cnst.eq.4) then -!!$ -!!$ write(iulog,*)"Water vapor budget" -!!$ write(iulog,*)"------------------" -!!$ end if -!!$ if (m_cnst.eq.5) then -!!$ write(iulog,*)"Cloud liquid budget" -!!$ write(iulog,*)"------------------" -!!$ end if -!!$ if (m_cnst.eq.6) then -!!$ write(iulog,*)"Cloud ice budget" -!!$ write(iulog,*)"------------------" -!!$ end if -!!$ write(iulog,*)"" -!!$ -!!$ call budget_get_global('phAP-phBP',m_cnst,param) -!!$ call budget_get_global('phBP-phBF',m_cnst,pEFIX) -!!$ call budget_get_global('phAM-phAP',m_cnst,pDMEA) -!!$ -!!$ call budget_get_global('dAM-dBF',m_cnst,param_mpas) -!!$ call budget_get_global('phAM-phBF',m_cnst,phys_total) -!!$ -!!$ write(iulog,*)"dMASS/dt energy fixer (pBP-pBF) ",pEFIX," Pa" -!!$ write(iulog,*)"dMASS/dt parameterizations (pAP-pBP) ",param," Pa" -!!$ write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",pDMEA," Pa" -!!$ write(iulog,*)"" -!!$ write(iulog,*)"" -!!$ write(iulog,*)"dMass/dt physics total in MPAS (dAM-dBF) ",param_mpas," Pa" -!!$ err = (param_mpas-param) -!!$ write(iulog,*)"Is mass budget closed? (pAP-pBP)- (dAM-dBF) ",err -!!$ write(iulog,*)"---------------------------------------------------------------------------------------------------" -!!$ write(iulog,*)" " -!!$ end do -!!$ end if + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + use shr_kind_mod, only: r8=>shr_kind_r8 + use budgets, only: budget_num, budget_info, budget_ind_byname, budget_get_global, is_budget + use dimensions_mod, only: lcp_moist,qsize,ntrac + use control_mod, only: ftype + ! Local variables + integer :: b_ind,s_ind,is1,is2 + logical :: budget_outfld + character(len=64) :: name_out1,name_out2,name_out3,name_out4,name_out5,budget_name,name_out(9) + character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn +!jt character(len=8) :: discr + real(r8),allocatable :: tmp(:,:) + real(r8), pointer :: te_budgets(:,:,:)! energy/mass budgets se,ke,wv,liq,ice + integer, pointer :: budgets_cnt(:) ! budget counts for normalizating sum + integer :: i + character(len=*), parameter :: subname = 'check_energy:print_budgets' + + real(r8) :: ph_param,ph_EFIX,ph_DMEA,ph_param_and_efix,ph_phys_total + real(r8) :: dy_param,dy_EFIX,dy_DMEA,dy_param_and_efix,dy_phys_total + real(r8) :: se_param,se_dmea,se_phys_total, dycore, err, param, pefix, & + pdmea, phys_total, param_se, dyn_total, dyn_phys_total, & + rate_of_change_2D_dyn, rate_of_change_vertical_remapping, dADAI, & + diffusion_del4, diffusion_fric, diffusion_del4_tot, diffusion_sponge, & + diffusion_total, twoDresidual, rate_of_change_physics, & + rate_of_change_heating_term_put_back_in, rate_of_change_hvis_sponge, & + value_pdc, dADIA, pADIA, ttt, fff, & + mass_change__2D_dyn,mass_change__vertical_remapping, & + mass_change__heating_term_put_back_in,mass_change__hypervis_total, & + error, mass_change__physics, dbd, daf, dar, dad, qneg, val,phbf,ded + + + + integer :: m_cnst, qsize_condensate_loading + logical :: te_consistent_version + !-------------------------------------------------------------------------------------- + + qsize_condensate_loading=qsize + te_consistent_version=.false. + if (qsize_condensate_loading.eq."1") then + if (lcp_moist.eq..false.) then + write(iulog,*)"Using total energy consistent version: qsize_condensate_loading=1 and cp=cpdry" + te_consistent_version=.true. + else + write(iulog,*)"WARNING: Total energy formulas for dynamics and physics are different:" + write(iulog,*)" Dynamics (cp includes water vapor; condensates not thermodynamically active)." + write(iulog,*)" Physics (cp=cp_dry in internal energy)." + end if + else + write(iulog,*)"WARNING: Total energy formulaes for dynamics and physics are different" + write(iulog,*)"in dynamics (cp and dp includes all water variables) and physics (cp=cp_dry in internal energy)." + end if + + + if (masterproc) then + call budget_get_global('phAP-phBP',1,ph_param) + call budget_get_global('phBP-phBF',1,ph_EFIX) + call budget_get_global('phAM-phAP',1,ph_DMEA) + call budget_get_global('phAP-phBF',1,ph_param_and_efix) + call budget_get_global('phAM-phBF',1,ph_phys_total) + + call budget_get_global('dyAP-dyBP',1,dy_param) + call budget_get_global('dyBP-dyBF',1,dy_EFIX) + call budget_get_global('dyAM-dyAP',1,dy_DMEA) + call budget_get_global('dyAP-dyBF',1,dy_param_and_efix) + call budget_get_global('dyAM-dyBF',1,dy_phys_total) + +!jt call budget_get_global('dAP-dBP',1,se_param) +!jt call budget_get_global('dAM-dAP',1,se_dmea) +!jt call budget_get_global('dAM-dBF',1,se_phys_total) + + call budget_get_global('dBF-dED',1,dyn_total) +!jt call budget_get_global('dAD-dAF',1,dyn_phys_total) + call budget_get_global('dAD-dBD',1,rate_of_change_2D_dyn) + call budget_get_global('dAR-dAD',1,rate_of_change_vertical_remapping) + dADIA = rate_of_change_2D_dyn+rate_of_change_vertical_remapping + + call budget_get_global('dCH-dBH',1,diffusion_del4) + call budget_get_global('dAH-dCH',1,diffusion_fric) + call budget_get_global('dAH-dBH',1,diffusion_del4_tot) + call budget_get_global('dAS-dBS',1,diffusion_sponge) + diffusion_total = diffusion_del4_tot+diffusion_sponge + + call budget_get_global('dBD-dAF',1,rate_of_change_physics) + + rate_of_change_heating_term_put_back_in = diffusion_fric + rate_of_change_hvis_sponge = diffusion_sponge + + write(iulog,*)" " + write(iulog,*)" " + + write(iulog,*)"suffix (parameterization side)" + write(iulog,*)"pBF: state passed to parameterizations, before energy fixer" + write(iulog,*)"pBP: after energy fixer, before parameterizations" + write(iulog,*)"pAP: after last phys_update in parameterizations and state saved for energy fixer" + write(iulog,*)"pAM: after dry mass correction calculate but not used in SE" + write(iulog,*)" " + write(iulog,*)"history files saved off here" + + write(iulog,*)" " + write(iulog,*)"suffix (dynamics)" + write(iulog,*)"dED: state from end of previous dynamics (= pBF + time sampling)" + write(iulog,*)" loop over vertical remapping and physics dribbling -------- (nsplit) -------" + write(iulog,*)" (dribbling and remapping always done together) |" + write(iulog,*)" dAF: state from previous remapping |" + write(iulog,*)" dBD: state after physics dribble, before dynamics |" + write(iulog,*)" loop over vertical Lagrangian dynamics --------rsplit------------- |" + write(iulog,*)" dynamics here | |" + write(iulog,*)" loop over hyperviscosity ----------hypervis_sub------------ | |" + write(iulog,*)" dBH state before hyperviscosity | | |" + write(iulog,*)" dCH state after hyperviscosity | | |" + write(iulog,*)" dAH state after hyperviscosity momentum heating | | |" + write(iulog,*)" end hyperviscosity loop ----------------------------------- | |" + write(iulog,*)" dBS state before del2 sponge | | |" + write(iulog,*)" dAS state after del2+mom heating sponge | | |" + write(iulog,*)" end of vertical Lagrangian dynamics loop ------------------------- |" + write(iulog,*)" dAD state after dynamics, before vertical remapping |" + write(iulog,*)" dAR state after vertical remapping |" + write(iulog,*)" end of remapping loop ------------------------------------------------------" + write(iulog,*)"dBF state passed to parameterizations = state after last remapping " + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)" " + + write(iulog,*)" " + write(iulog,*)"=================================================================================" + write(iulog,*)"| |" + write(iulog,*)"| ANALYSIS OF ENERGY DIAGNOSTICS IN PHYSICS |" + write(iulog,*)"| |" + write(iulog,*)"=================================================================================" + write(iulog,*)" " + write(iulog,*)"-------------------------------------------------------" + write(iulog,*)" CAM physics energy increments (in pressure coordinate)" + write(iulog,*)"-------------------------------------------------------" + write(iulog,*)" " + write(iulog,*)"dE/dt parameterizations no efix (param) (pAP-pBP) ",ph_param," W/M^2" + write(iulog,*)"dE/dt energy fixer (efix) (pBP-pBF) ",ph_EFIX," W/M^2" + write(iulog,*)"NOTE: energy fixer uses energy formula consistent with dycore (so this is not p-based for SE) " + write(iulog,*)"dE/dt parameterizations + efix (pAP-pBF) ",ph_param_and_efix," W/M^2" + write(iulog,*)" " + write(iulog,*)"dE/dt dry mass adjustment (pwork) (pAM-pAP) ",ph_DMEA," W/M^2" + write(iulog,*)"dE/dt physics total (phys) (pAM-pBF) ",ph_phys_total," W/M^2" + write(iulog,*)" " + dycore = -ph_EFIX-ph_DMEA + write(iulog,*)"Dycore TE dissipation estimated from physics in pressure coordinate ",dycore," W/M^2" + write(iulog,*)"(assuming no physics-dynamics coupling errors) " + + write(iulog,*)"=================================================================================" + write(iulog,*)"| |" + write(iulog,*)"| ANALYSIS OF ENERGY DIAGNOSTICS IN DYNAMICS - specific for SE dycore |" + write(iulog,*)"| |" + write(iulog,*)"=================================================================================" + write(iulog,*)" " + + write(iulog,*)"dE/dt dyn total (dycore+phys tendency (dBF-dED) ",dyn_total," W/M^2" + write(iulog,*)"dE/dt total adiabatic dynamics (adiab) ",dADIA," W/M^2" + write(iulog,*)"dE/dt 2D dynamics (2D) (dAD-dBD) ",rate_of_change_2D_dyn," W/M^2" + write(iulog,*)"dE/dt vertical remapping (remap) (dAR-dAD) ",rate_of_change_vertical_remapping," W/M^2" + write(iulog,*)"dE/dt physics tendency in dynamics (dBD-dAF) ",rate_of_change_physics," W/M^2" + write(iulog,*)" " + write(iulog,*)"Breakdown of 2D dynamics:" + write(iulog,*)" " + + write(iulog,*)" dE/dt hypervis del4 (hvis) (dCH-dBH) ",diffusion_del4," W/M^2" + write(iulog,*)" dE/dt hypervis frictional heating del4 (dAH-dCH) ",diffusion_fric," W/M^2" + write(iulog,*)" dE/dt hypervis del4 total (hvis) (dAH-dBH) ",diffusion_del4_tot," W/M^2" + write(iulog,*)" dE/dt hypervis sponge total (dAS-dBS) ",diffusion_sponge," W/M^2" + write(iulog,*)" dE/dt explicit diffusion total ",diffusion_total," W/M^2" + + twoDresidual = rate_of_change_2D_dyn-diffusion_total + write(iulog,*)" dE/dt residual (res) ",twoDresidual," W/M^2" + write(iulog,*)"" + write(iulog,*)"=================================================================================" + write(iulog,*)"| |" + write(iulog,*)"| ANALYSIS OF ENERGY DIAGNOSTICS IN DYNAMICS-PHYSICS COMBINED |" + write(iulog,*)"| |" + write(iulog,*)"=================================================================================" + write(iulog,*)"" + value_pdc = ph_phys_total-rate_of_change_physics + if (te_consistent_version.eq..true.) then + write(iulog,*)"Your model is energy consistent (qsize_condensate_loading=1 and cpdry)" + if (ftype .eq. 1) then + write(iulog,*)"" + write(iulog,*)"You are using ftype=1 so PDC errors should be zero:" + write(iulog,*)"" + + + write(iulog,*)" dE/dt physics tendency in dynamics (dBD-dAF) should exactly match dE/dt physics total (pAM-pBF): ",value_pdc + write(iulog,*)"" + else + write(iulog,*)"" + write(iulog,*)"You are using ftype=0 or 2 so there are PDC errors (dribbling errors):" + write(iulog,*)"" + write(iulog,*)" Dribbling errors (pAM-pBF-(dBD-dAF))/dt: ",value_pdc + end if +!jt discr = "0 " +!jt str_pdc = sprintf("%6.3g",10*value_pdc) + else + write(iulog,*)"Your model is energy inconsistent (qsize_condensate_loading<>1 and/or cp<>cpdry)" + write(iulog,*)"" + write(iulog,*)"PDC errors can not be assesed trhough " + write(iulog,*)"" + write(iulog,*)" dE/dt physics tendency in dynamics (dBD-dAF) does not match dE/dt physics total (pAM-pBF) due to energy discrepancy:",value_pdc + write(iulog,*)ph_phys_total," ",rate_of_change_physics +!jt str_pdc = "undef" + end if + write(iulog,*)"" + write(iulog,*)"Some more consisitency/budget terms" + write(iulog,*)"===================================" + write(iulog,*)"" + write(iulog,*)"Energy fixer fixes dme_adjust (pDMEA), lack of energy conservation in adiabatic" + write(iulog,*)"dynamical core (dADIA), energy discrepancy (EDIFF) and energy lost/gained in physics-dynamics coupling" + write(iulog,*)"" + write(iulog,*)"dADIA ",dADIA," W/M^2" + write(iulog,*)"pDMEA ",ph_DMEA," W/M^2" + write(iulog,*)"physics-dynamics coupling ",value_pdc," W/M^2" + write(iulog,*)"" +!jt str="dPDC+EDIFF" + write(iulog,*)"" + write(iulog,*)" -energy fixer = DME_adjust+adaib dycore+phys-dyn errors+discr" + write(iulog,*)" " + ttt = -ph_DMEA-dADIA-value_pdc +!jt discr = -99.0 + write(iulog,*)" DME_adjust+adaib dycore+phys-dyn errors+discr = ",ttt + write(iulog,*)" Energy fixer = ",ph_EFIX + write(iulog,*)"" + fff = ttt-ph_EFIX + write(iulog,*)" Difference = ",fff + + + + call budget_get_global('phBF',1,phbf) + call budget_get_global('dED',1,ded) + qneg=phbf-ded + write(iulog,*)"" + write(iulog,*)" qneg: ",qneg + write(iulog,*)"" + + if (qsize.gt.0) then + write(iulog,*)"" + write(iulog,*)"" + write(iulog,*)"" + write(iulog,*)"=================================================================================" + write(iulog,*)"| |" + write(iulog,*)"| ANALYSIS OF WATER VAPOR, CLOUD LIQUID AND CLOUD ICE BUDGETS |" + write(iulog,*)"| |" + write(iulog,*)"=================================================================================" + write(iulog,*)"" + end if + +!jt do m_cnst=4,4+qsize-1 + do m_cnst=4,6 + if (m_cnst.eq.4) then + write(iulog,*)"Water vapor" + write(iulog,*)"-----------" + end if + if (m_cnst.eq.5) then + write(iulog,*)"Cloud liquid" + write(iulog,*)"-----------" + end if + if (m_cnst.eq.6) then + write(iulog,*)"Cloud ice" + write(iulog,*)"-----------" + end if + + call budget_get_global('phBP-phBF',m_cnst,pEFIX) + call budget_get_global('phAM-phAP',m_cnst,pDMEA) + call budget_get_global('phAP-phBP',m_cnst,param) +!jt call budget_get_global('dBF-dED',m_cnst,dyn_total) + call budget_get_global('phAM-phBF',m_cnst,phys_total) + + write(iulog,*)"dMASS/dt energy fixer (pBP-pBF) ",pEFIX," Pa" + write(iulog,*)"dMASS/dt parameterizations (pAP-pBP) ",param," Pa" + write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",pDMEA," Pa" + write(iulog,*)" " + val = pEFIX+pDMEA + write(iulog,*)"=> dMASS/dt dynamical core (estimated from physics) " + write(iulog,*)" dMASS/dt energy fixer + dMASS/dt dry mass adjustment ",val," Pa" + + write(iulog,*)"=> dMASS/dt physics total (pAM-pBF)",phys_total," Pa" + + + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)" " + + if (is_budget('dAD').and.is_budget('dBD').and.is_budget('dAR').and.is_budget('dCH')) then + call budget_get_global('dAD-dBD',m_cnst,mass_change__2D_dyn) + call budget_get_global('dAR-dAD',m_cnst,mass_change__vertical_remapping) + dADIA = mass_change__2D_dyn+mass_change__vertical_remapping + write(iulog,*)"dE/dt total adiabatic dynamics ",dADIA," Pa" + write(iulog,*)"dE/dt 2D dynamics (dAD-dBD) ",mass_change__2D_dyn," Pa" + write(iulog,*)" " + write(iulog,*)"Breakdown of 2D dynamics:" + write(iulog,*)" " + call budget_get_global('dAH-dCH',m_cnst,mass_change__heating_term_put_back_in) + call budget_get_global('dAH-dBH',m_cnst,mass_change__hypervis_total) + write(iulog,*)" dE/dt hypervis (dAH-dBH) ",mass_change__hypervis_total," Pa" + write(iulog,*)" dE/dt frictional heating (dAH-dCH) ",mass_change__heating_term_put_back_in," Pa" + error = mass_change__2D_dyn-mass_change__hypervis_total + write(iulog,*)" dE/dt residual (time truncation errors) ",error," Pa" + end if + if (is_budget('dAR').and.is_budget('dAD')) then + call budget_get_global('dAR',m_cnst,dar) + call budget_get_global('dAD',m_cnst,dad) + call budget_get_global('dAR-dAD',m_cnst,mass_change__vertical_remapping) + write(iulog,*)"dE/dt vertical remapping (dAR-dAD) ",mass_change__vertical_remapping," Pa","dar:",dar,"dad:",dad + end if + write(iulog,*)" " + write(iulog,*)" " + + if (is_budget('dBD').and.is_budget('dAF')) then + call budget_get_global('dBD',m_cnst,dbd) + call budget_get_global('dAF',m_cnst,daf) + call budget_get_global('dBD-dAF',m_cnst,mass_change__physics) + write(iulog,*)"dE/dt physics tendency in dynamics (dBD-dAF) ",mass_change__physics," Pa","dbd:",dbd,"daf:",daf + val = phys_total-mass_change__physics + end if + if (is_budget('dBD').and.is_budget('dAF')) then + if (ftype .eq. 1 .or.ftype .eq. 2) then + write(iulog,*)" " + write(iulog,*)" Consistency check:" + write(iulog,*)" " + write(iulog,*)" dE/dt physics tendency in dynamics (dBD-dAF) should exactly match dE/dt physics total (pAM-pBF):",val + write(iulog,*)" " + else + write(iulog,*)"Dribbling errors (pAM-pBF-(dBD-dAF))",val + end if + end if + write(iulog,*)"" + write(iulog,*)"=================================================================================" + write(iulog,*)"" + end do +end if end subroutine print_budget !========================================================================================= diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index cd783b6172..18ea81fc45 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -1206,7 +1206,6 @@ subroutine dyn_run(dyn_state) end do end if - call calc_tot_energy_dynamics(dyn_state%elem,dyn_state%fvm, nets, nete, TimeLevel%n0, n0_qdp,'dBF') !$OMP END PARALLEL @@ -1216,74 +1215,8 @@ subroutine dyn_run(dyn_state) ! output vars on CSLAM fvm grid call write_dyn_vars(dyn_state) - ! update energy budget differences - - do i=1,budget_num - call budget_info(i,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=budget_state_ind) - if (budget_pkgtype=='dyn'.and.(budget_optype=='dif'.or.budget_optype=='sum')) & - call calc_tot_energy_dynamics_diff(dyn_state%elem,dyn_state%fvm, nets, nete, TimeLevel%n0, n0_qdp,trim(budget_name)) - end do + call budget_update(dyn_state%elem,dyn_state%fvm, nets, nete, TimeLevel%n0, n0_qdp, hybrid) -!!$ - allocate(tmp(np,np,nets:nete)) - allocate(tmptot(np,np,nets:nete)) - allocate(tmpse(np,np,nets:nete)) - allocate(tmpke(np,np,nets:nete)) - allocate(tmp1(np,np,nets:nete)) - allocate(tmp2(np,np,nets:nete)) - tmp=0._r8 - tmp1=0._r8 - tmp2=0._r8 - tmptot=0._r8 - tmpse=0._r8 - tmpke=0._r8 - - ! output budget globals - - if (.true.) then - do i=1,budget_num - call budget_info(i,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=budget_state_ind) - if (budget_pkgtype=='dyn') then - ! Normalize energy sums and convert to W/s - do ie=nets,nete - tmp(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,1,budget_state_ind)/dyn_state%elem(ie)%derived%budget_cnt(budget_state_ind)/dtime - if (dyn_state%elem(nets)%derived%budget_subcycle(budget_state_ind).ne.0) then -! tmptot(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,1,budget_state_ind)/dyn_state%elem(ie)%derived%budget_subcycle(budget_state_ind) -! tmpse(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,2,budget_state_ind)/dyn_state%elem(ie)%derived%budget_subcycle(budget_state_ind) -! tmpke(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,3,budget_state_ind)/dyn_state%elem(ie)%derived%budget_subcycle(budget_state_ind) - tmptot(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,1,budget_state_ind) - tmpse(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,2,budget_state_ind) - tmpke(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,3,budget_state_ind) - end if - tmp1(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,2,budget_state_ind)/dyn_state%elem(ie)%derived%budget_cnt(budget_state_ind)/dtime - tmp2(:,:,ie)=dyn_state%elem(ie)%derived%budget(:,:,3,budget_state_ind)/dyn_state%elem(ie)%derived%budget_cnt(budget_state_ind)/dtime - enddo - - global_ave = global_integral(dyn_state%elem, tmp(:,:,nets:nete),hybrid,np,nets,nete) - write(iulog,*)budget_name,' global average normalized cnt dtime=',global_ave,'cnt=',dyn_state%elem(nets)%derived%budget_cnt(budget_state_ind),'sub=',dyn_state%elem(nets)%derived%budget_subcycle(budget_state_ind) - global_ave = global_integral(dyn_state%elem, tmp1(:,:,nets:nete),hybrid,np,nets,nete) - global_ave = global_integral(dyn_state%elem, tmp2(:,:,nets:nete),hybrid,np,nets,nete) - if (dyn_state%elem(nets)%derived%budget_subcycle(budget_state_ind).ne.0) then - global_ave = global_integral(dyn_state%elem, tmptot(:,:,nets:nete),hybrid,np,nets,nete) - global_ave = global_integral(dyn_state%elem, tmpse(:,:,nets:nete),hybrid,np,nets,nete) - global_ave = global_integral(dyn_state%elem, tmpke(:,:,nets:nete),hybrid,np,nets,nete) - end if - ! reset dyn budget states - ! reset budget counts - stage or diff budget will just be i. If difference must reset components of diff - do ie=nets,nete - dyn_state%elem(ie)%derived%budget(:,:,:,budget_state_ind)=0._r8 - dyn_state%elem(ie)%derived%budget_cnt(budget_state_ind)=0 - end do - end if - end do - end if - deallocate(tmp) - deallocate(tmptot) - deallocate(tmpse) - deallocate(tmpke) - deallocate(tmp1) - deallocate(tmp2) - end subroutine dyn_run !=============================================================================== @@ -2468,5 +2401,103 @@ subroutine write_dyn_vars(dyn_out) end subroutine write_dyn_vars +!========================================================================================= +subroutine budget_update(elem,fvm,nets,nete,n0,n0_qdp,hybrid) + + use budgets, only: budget_num, budget_info, budget_me_varnum,budget_put_global + use element_mod, only: element_t + use fvm_control_volume_mod, only: fvm_struct + use global_norms_mod, only: global_integral + use physconst, only: thermodynamic_active_species_liq_num, thermodynamic_active_species_ice_num + use prim_advance_mod, only: calc_tot_energy_dynamics_diff + use time_manager, only: get_step_size + + ! arguments + type (element_t) , intent(inout) :: elem(:) + type(fvm_struct) , intent(in) :: fvm(:) + type(hybrid_t) , intent(in) :: hybrid + integer , intent(in) :: n0, n0_qdp,nets,nete + + ! Local variables + character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn + character(len=64) :: name_out1,name_out2,name_out3,name_out4,name_out5,budget_name + integer :: budget_state_ind,s_ind,b_ind,i,n,ie + logical :: budget_outfld + + real(r8) :: budgets_global(budget_num,budget_me_varnum) + real(r8), allocatable, dimension(:,:,:) :: tmp + real(r8) :: dtime + + !-------------------------------------------------------------------------------------- + + + ! update energy budget differences and outfld + + dtime = get_step_size() + + do b_ind = 1,budget_num + call budget_info(b_ind,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=s_ind,outfld=budget_outfld) + if (budget_pkgtype=='dyn'.and.(budget_optype=='dif'.or.budget_optype=='sum')) & + call calc_tot_energy_dynamics_diff(elem,fvm, nets, nete, n0, n0_qdp,trim(budget_name)) + ! + ! Output energy diagnostics + ! + if (budget_outfld) then + name_out1 = 'SE_' //trim(budget_name) + name_out2 = 'KE_' //trim(budget_name) + name_out3 = 'WV_' //trim(budget_name) + name_out4 = 'WL_' //trim(budget_name) + name_out5 = 'WI_' //trim(budget_name) +!!$ do ie=nets,nete +!!$ call outfld(name_out1, elem(ie)%derived%budget(:,:,2,s_ind), nc*nc, ie) +!!$ call outfld(name_out2, elem(ie)%derived%budget(:,:,3,s_ind), nc*nc, ie) +!!$ ! +!!$ ! sum over vapor +!!$ call outfld(name_out3, elem(ie)%derived%budget(:,:,4,s_ind), nc*nc, ie) +!!$ ! +!!$ ! sum over liquid water +!!$ if (thermodynamic_active_species_liq_num>0) & +!!$ call outfld(name_out4, elem(ie)%derived%budget(:,:,5,s_ind), nc*nc, ie) +!!$ ! +!!$ ! sum over ice water +!!$ if (thermodynamic_active_species_ice_num>0) & +!!$ call outfld(name_out5, elem(ie)%derived%budget(:,:,6,s_ind), nc*nc, ie) +!!$ end do + end if + end do + + ! update energy budget globals + + allocate(tmp(np,np,nets:nete)) + tmp=0._r8 + + do b_ind=1,budget_num + call budget_info(b_ind,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=s_ind) + If (budget_pkgtype=='dyn') then + do n=1,budget_me_varnum + ! Normalize energy sums and convert to W/s + do ie=nets,nete + tmp(:,:,ie)=elem(ie)%derived%budget(:,:,n,s_ind)/elem(ie)%derived%budget_cnt(s_ind) + enddo + budgets_global(b_ind,n) = global_integral(elem, tmp(:,:,nets:nete),hybrid,np,nets,nete) +!jt if (masterproc) write(iulog,*)budget_name,' global average normalized by cnt=',budgets_global(b_ind,n),'cnt=',elem(nets)%derived%budget_cnt(s_ind),'sub=',elem(nets)%derived%budget_subcycle(s_ind) + + ! divide by time for proper units if not a mass budget. + if (n.le.3) & + budgets_global(b_ind,n)=budgets_global(b_ind,n)/dtime + if (masterproc) & + call budget_put_global(trim(budget_name),n,budgets_global(b_ind,n)) + end do + + ! reset dyn budget states + ! reset budget counts - stage or diff budget will just be i. If difference must reset components of diff + do ie=nets,nete + elem(ie)%derived%budget(:,:,:,s_ind)=0._r8 + elem(ie)%derived%budget_cnt(s_ind)=0 + end do + end if + end do + +end subroutine budget_update !========================================================================================= end module dyn_comp diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index ff86048cab..b7be05f32f 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -687,20 +687,10 @@ subroutine check_energy_budget(state, dtime, nstep) if (budget_pkgtype=='phy') then do i=1,budget_me_varnum call budget_put_global(trim(budget_name),i,te_glob(ind,i)) +!jt write(iulog,*)"putting global ",trim(budget_name)," m_cnst=",i," ",te_glob(ind,i) end do end if end do -!!$ call budget_get_global('BD_phy_params',1,dyparam) -!!$ call budget_get_global('BP_phy_params',1,phparam) -!!$ call budget_get_global('BD_pwork',1,dypwork) -!!$ call budget_get_global('BP_pwork',1,phpwork) -!!$ call budget_get_global('BD_efix',1,dyefix) -!!$ call budget_get_global('BP_efix',1,phefix) -!!$ call budget_get_global('BD_phys_tot',1,dyphys) -!!$ call budget_get_global('BP_efix',1,phphys) - -!!$ write(iulog,'(1x,a,1x,4(1x,e25.17))') "nstep, phys param,pwork,efix,phys", phparam, phpwork, phefix, phphys -!!$ write(iulog,'(1x,a,1x,4(1x,e25.17))') "nstep, dyn param,pwork,efix,phys", dyparam, dypwork, dyefix, dyphys end if call print_budget() end subroutine check_energy_budget From 1c287e004c582fde161b1033d4abc013b01f910a Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Wed, 19 Oct 2022 13:15:17 -0600 Subject: [PATCH 014/140] NAG fixes for budgeting --- src/control/budgets.F90 | 21 +++++++++++--------- src/dynamics/mpas/dp_coupling.F90 | 2 +- src/dynamics/mpas/dycore_budget.F90 | 2 +- src/dynamics/se/dycore/prim_advance_mod.F90 | 22 +++++++++++---------- src/dynamics/se/dycore_budget.F90 | 8 ++++---- src/dynamics/se/dyn_comp.F90 | 18 +++++++++-------- src/physics/cam/check_energy.F90 | 4 ++-- 7 files changed, 42 insertions(+), 35 deletions(-) diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index 7b614ded09..d31f6807b3 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -1,4 +1,3 @@ - module budgets ! Metadata manager for the budgets. @@ -18,10 +17,10 @@ module budgets module procedure budget_diff_add end interface budget_add -interface budget_info - module procedure budget_info_byind - module procedure budget_info_byname -end interface budget_info +!interface budget_info +! module procedure abudget_info_byind +! module procedure budget_info_byname +!end interface budget_info ! Public interfaces public :: & @@ -34,6 +33,7 @@ module budgets budget_longname_byind, &! return longnamee of a budget budget_type_byind, &! return stage or difference type of a budget budget_info, &! return budget info by ind + budget_info_byname, &! return budget info by name budget_cnt_adjust, &! advance or reset budget count budget_count, &! return budget count is_budget, &! return budget count @@ -41,13 +41,14 @@ module budgets budget_put_global, &! return budget count budget_outfld ! Returns true if default CAM output was specified in the budget_stage_add calls. + ! Public data integer, parameter, public :: budget_array_max = 60 ! number of budget diffs integer, parameter, public :: budget_me_varnum = 7 ! tot,se,ke,wv,wl,wi integer, public :: budget_cnt(budget_array_max) ! budget counts for normalization -integer, public :: budget_subcycle(budget_array_max) ! budget_subcycle counts +logical, public :: budget_subcycle(budget_array_max) ! budget_subcycle counts integer, public :: budget_num_dyn = 0 ! integer, public :: budget_num_phy = 0 ! integer, public :: budget_num = 0 ! @@ -336,7 +337,8 @@ subroutine budget_info_byname(name, budget_ind, longname, stg1name, stg1stateidx end if end subroutine budget_info_byname - subroutine budget_info_byind(budget_ind, name, longname, stg1name, stg1stateidx, stg1index, stg2name, stg2stateidx, stg2index, optype, pkgtype,state_ind,subcycle,outfld) +!jt subroutine budget_info_byind(budget_ind, name, longname, stg1name, stg1stateidx, stg1index, stg2name, stg2stateidx, stg2index, optype, pkgtype,state_ind,subcycle,outfld) + subroutine budget_info(budget_ind, name, longname, stg1name, stg1stateidx, stg1index, stg2name, stg2stateidx, stg2index, optype, pkgtype,state_ind,subcycle,outfld) ! Return the mixing ratio name of a budget @@ -390,7 +392,8 @@ subroutine budget_info_byind(budget_ind, name, longname, stg1name, stg1stateidx, call endrun(errmsg) end if - end subroutine budget_info_byind +!jt end subroutine abudget_info_byind + end subroutine budget_info !============================================================================================== @@ -426,7 +429,7 @@ subroutine budget_init() ! Initial budget module variables. budget_cnt(:) = 0._r8 - budget_subcycle(:) = 0._r8 + budget_subcycle(:) = .false. budget_num_dyn = 0 budget_num_phy = 0 budget_num = 0 diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index e908728ca7..1daa93f787 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -757,7 +757,7 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t use mpas_constants, only: Rv_over_Rd => rvord use physconst, only: thermodynamic_active_species_ice_idx_dycore,thermodynamic_active_species_liq_idx_dycore use physconst, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_liq_num - use budgets, only: budget_array_max,budget_info + use budgets, only: budget_array_max,budget_info_byname ! Arguments integer, intent(in) :: nCells integer, intent(in) :: nVertLevels diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index 6ca300f8ef..97e3e86d49 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -11,7 +11,7 @@ module dycore_budget subroutine print_budget() - use budgets, only: budget_num, budget_info, budget_ind_byname, budget_get_global + use budgets, only: budget_get_global use shr_kind_mod, only: r8=>shr_kind_r8 use spmd_utils, only: masterproc use cam_logfile, only: iulog diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index 1075c3e617..d63c9414a3 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -1467,8 +1467,9 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf use physconst, only: thermodynamic_active_species_ice_idx use dimensions_mod, only: cnst_name_gll - use budgets, only: budget_info + use budgets, only: budget_info_byname use cam_logfile, only: iulog + use spmd_utils, only: masterproc !------------------------------Arguments-------------------------------- type (element_t) , intent(inout) :: elem(:) @@ -1566,8 +1567,9 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf end do ! could store pointer to dyn/phys state index inside of budget and call budget_state_update pass in se,ke etc. - call budget_info(trim(outfld_name_suffix),budget_ind=budget_ind,state_ind=state_ind) + call budget_info_byname(trim(outfld_name_suffix),budget_ind=budget_ind,state_ind=state_ind) ! reset all when cnt is 0 +!jt if (ie.eq.nets) write(iulog,*)'calc_tot before:',trim(outfld_name_suffix),' cnt/sub=',elem(nets)%derived%budget_cnt(state_ind),'/',elem(nets)%derived%budget_subcycle(state_ind) if (elem(ie)%derived%budget_cnt(state_ind) == 0) then elem(ie)%derived%budget_subcycle(state_ind) = 0 elem(ie)%derived%budget(:,:,:,state_ind)=0.0_r8 @@ -1593,7 +1595,7 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf elem(ie)%derived%budget(i,j,3,state_ind) = elem(ie)%derived%budget(i,j,3,state_ind) + ke(i+(j-1)*np) end do end do - +!jt if (ie.eq.nets) write(iulog,*)'calc_tot after:',trim(outfld_name_suffix),' cnt/sub=',elem(nets)%derived%budget_cnt(state_ind),'/',elem(nets)%derived%budget_subcycle(state_ind) ! ! Output energy diagnostics on GLL grid ! @@ -1804,13 +1806,13 @@ subroutine calc_tot_energy_dynamics_diff(elem,fvm,nets,nete,tl,tl_qdp,outfld_nam else tmp1(:,:,:,ie)=elem(ie)%derived%budget(:,:,:,is1) tmp2(:,:,:,ie)=elem(ie)%derived%budget(:,:,:,is2) - end if - if (budget_optype=='dif') then - tmp(:,:,:,ie)=(tmp1(:,:,:,ie)-tmp2(:,:,:,ie)) - else if (budget_optype=='sum') then - tmp(:,:,:,ie)=(tmp1(:,:,:,ie)+tmp2(:,:,:,ie)) - else - call endrun('dyn_readnl: ERROR: budget_optype unknown:'//budget_optype) + if (budget_optype=='dif') then + tmp(:,:,:,ie)=(tmp1(:,:,:,ie)-tmp2(:,:,:,ie)) + else if (budget_optype=='sum') then + tmp(:,:,:,ie)=(tmp1(:,:,:,ie)+tmp2(:,:,:,ie)) + else + call endrun('dyn_readnl: ERROR: budget_optype unknown:'//budget_optype) + end if end if elem(ie)%derived%budget(:,:,:,s_ind)=tmp(:,:,:,ie) ! diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index 3c69b907b7..6cb5bb23e0 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -14,7 +14,7 @@ subroutine print_budget() use spmd_utils, only: masterproc use cam_logfile, only: iulog use shr_kind_mod, only: r8=>shr_kind_r8 - use budgets, only: budget_num, budget_info, budget_ind_byname, budget_get_global, is_budget + use budgets, only: budget_get_global, is_budget use dimensions_mod, only: lcp_moist,qsize,ntrac use control_mod, only: ftype ! Local variables @@ -50,8 +50,8 @@ subroutine print_budget() qsize_condensate_loading=qsize te_consistent_version=.false. - if (qsize_condensate_loading.eq."1") then - if (lcp_moist.eq..false.) then + if (qsize_condensate_loading.eq.1) then + if (lcp_moist.eqv..false.) then write(iulog,*)"Using total energy consistent version: qsize_condensate_loading=1 and cp=cpdry" te_consistent_version=.true. else @@ -190,7 +190,7 @@ subroutine print_budget() write(iulog,*)"=================================================================================" write(iulog,*)"" value_pdc = ph_phys_total-rate_of_change_physics - if (te_consistent_version.eq..true.) then + if (te_consistent_version.eqv..true.) then write(iulog,*)"Your model is energy consistent (qsize_condensate_loading=1 and cpdry)" if (ftype .eq. 1) then write(iulog,*)"" diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 18ea81fc45..f797c9e771 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -1038,7 +1038,7 @@ subroutine dyn_run(dyn_state) use control_mod, only: qsplit, rsplit, ftype_conserve use thread_mod, only: horz_num_threads use time_mod, only: tevolve - use budgets, only: budget_cnt,budget_num, budget_info, & + use budgets, only: budget_cnt,budget_num,& budget_outfld,budget_count use global_norms_mod, only: global_integral, wrap_repro_sum use parallel_mod, only: global_shared_buf, global_shared_sum @@ -2473,15 +2473,17 @@ subroutine budget_update(elem,fvm,nets,nete,n0,n0_qdp,hybrid) do b_ind=1,budget_num call budget_info(b_ind,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=s_ind) - If (budget_pkgtype=='dyn') then + if (budget_pkgtype=='dyn') then do n=1,budget_me_varnum ! Normalize energy sums and convert to W/s - do ie=nets,nete - tmp(:,:,ie)=elem(ie)%derived%budget(:,:,n,s_ind)/elem(ie)%derived%budget_cnt(s_ind) - enddo - budgets_global(b_ind,n) = global_integral(elem, tmp(:,:,nets:nete),hybrid,np,nets,nete) -!jt if (masterproc) write(iulog,*)budget_name,' global average normalized by cnt=',budgets_global(b_ind,n),'cnt=',elem(nets)%derived%budget_cnt(s_ind),'sub=',elem(nets)%derived%budget_subcycle(s_ind) - + if (elem(nets)%derived%budget_cnt(s_ind).gt.0.) then + do ie=nets,nete + tmp(:,:,ie)=elem(ie)%derived%budget(:,:,n,s_ind)/elem(ie)%derived%budget_cnt(s_ind) + enddo + else + tmp=0._r8 + end if + budgets_global(b_ind,n) = global_integral(elem, tmp(:,:,nets:nete),hybrid,np,nets,nete) ! divide by time for proper units if not a mass budget. if (n.le.3) & budgets_global(b_ind,n)=budgets_global(b_ind,n)/dtime diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index b7be05f32f..57364f457c 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -948,7 +948,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix, vc) use cam_history, only: hist_fld_active, outfld use dyn_tests_utils, only: vc_physics, vc_height use cam_abortutils, only: endrun - use budgets, only: budget_cnt_adjust, budget_info + use budgets, only: budget_cnt_adjust, budget_info_byname !------------------------------Arguments-------------------------------- type(physics_state), intent(inout) :: state @@ -992,7 +992,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix, vc) lchnk = state%lchnk ncol = state%ncol - call budget_info(trim(outfld_name_suffix),budget_ind=budget_ind,state_ind=ind) + call budget_info_byname(trim(outfld_name_suffix),budget_ind=budget_ind,state_ind=ind) if (present(vc)) then vc_loc = vc From 57dce85bc4cd9b5ca42c59123cbdffe8a9309aaa Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Wed, 19 Oct 2022 18:35:54 -0600 Subject: [PATCH 015/140] updates for cam_dev and some cleanup from nag bldlog warnings --- src/control/budgets.F90 | 8 +----- src/dynamics/se/dycore_budget.F90 | 16 +++--------- src/physics/cam/physpkg.F90 | 1 - src/physics/cam_dev/physpkg.F90 | 43 +++++++++++++++++++++++++++++-- 4 files changed, 46 insertions(+), 22 deletions(-) diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index d31f6807b3..7ceea7633e 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -3,7 +3,6 @@ module budgets ! Metadata manager for the budgets. use shr_kind_mod, only: r8 => shr_kind_r8 -use shr_const_mod, only: shr_const_rgas use spmd_utils, only: masterproc use cam_abortutils, only: endrun use cam_logfile, only: iulog @@ -79,15 +78,10 @@ module budgets subroutine budget_readnl(nlfile) - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_logical - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input ! Local variables - integer :: unitn, ierr + integer :: unitn character(len=*), parameter :: sub = 'budget_readnl' !----------------------------------------------------------------------------- diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index 6cb5bb23e0..0ed99f56c3 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -15,29 +15,21 @@ subroutine print_budget() use cam_logfile, only: iulog use shr_kind_mod, only: r8=>shr_kind_r8 use budgets, only: budget_get_global, is_budget - use dimensions_mod, only: lcp_moist,qsize,ntrac + use dimensions_mod, only: lcp_moist,qsize use control_mod, only: ftype ! Local variables - integer :: b_ind,s_ind,is1,is2 - logical :: budget_outfld - character(len=64) :: name_out1,name_out2,name_out3,name_out4,name_out5,budget_name,name_out(9) - character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn -!jt character(len=8) :: discr - real(r8),allocatable :: tmp(:,:) - real(r8), pointer :: te_budgets(:,:,:)! energy/mass budgets se,ke,wv,liq,ice - integer, pointer :: budgets_cnt(:) ! budget counts for normalizating sum integer :: i character(len=*), parameter :: subname = 'check_energy:print_budgets' real(r8) :: ph_param,ph_EFIX,ph_DMEA,ph_param_and_efix,ph_phys_total real(r8) :: dy_param,dy_EFIX,dy_DMEA,dy_param_and_efix,dy_phys_total real(r8) :: se_param,se_dmea,se_phys_total, dycore, err, param, pefix, & - pdmea, phys_total, param_se, dyn_total, dyn_phys_total, & - rate_of_change_2D_dyn, rate_of_change_vertical_remapping, dADAI, & + pdmea, phys_total, dyn_total, dyn_phys_total, & + rate_of_change_2D_dyn, rate_of_change_vertical_remapping, & diffusion_del4, diffusion_fric, diffusion_del4_tot, diffusion_sponge, & diffusion_total, twoDresidual, rate_of_change_physics, & rate_of_change_heating_term_put_back_in, rate_of_change_hvis_sponge, & - value_pdc, dADIA, pADIA, ttt, fff, & + value_pdc, dADIA, ttt, fff, & mass_change__2D_dyn,mass_change__vertical_remapping, & mass_change__heating_term_put_back_in,mass_change__hypervis_total, & error, mass_change__physics, dbd, daf, dar, dad, qneg, val,phbf,ded diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 908ae10447..5c7ac22921 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -799,7 +799,6 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use cam_snapshot, only: cam_snapshot_init use cam_history, only: addfld, register_vector_field, add_default, horiz_only use phys_control, only: phys_getopts - use budgets, only: budget_num, budget_info, budget_outfld, budget_init use check_energy, only: check_energy_budget_init ! Input/output arguments diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index 66839344a8..e67b3c0dd7 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -144,6 +144,7 @@ subroutine phys_register use subcol_utils, only: is_subcol_on, subcol_get_scheme use dyn_comp, only: dyn_register use offline_driver, only: offline_driver_reg + use budgets, only: budget_add !---------------------------Local variables----------------------------- ! @@ -173,6 +174,38 @@ subroutine phys_register ! Register the subcol scheme call subcol_register() + ! Register stages for budgets. + call budget_add('phAP','phy',longname='vertically integrated phys energy after physics',outfld=.true.) + call budget_add('dyAP','phy',longname='vertically integrated dyn energy after physics',outfld=.true.) + call budget_add('phBP','phy',longname='vertically integrated phys energy before physics',outfld=.true.) + call budget_add('dyBP','phy',longname='vertically integrated dyn energy before physics',outfld=.true.) + call budget_add('phBF','phy',longname='vertically integrated phys energy before fixer',outfld=.true.) + call budget_add('dyBF','phy',longname='vertically integrated dyn energy before fixer',outfld=.true.) + call budget_add('phAM','phy',longname='vertically integrated phys energy after dry mass adj',outfld=.true.) + call budget_add('dyAM','phy',longname='vertically integrated dyn energy after dry mass adj',outfld=.true.) + + ! Register budgets. +!!$ call budget_add('BP_phy_params',iphAP,iphBP,'phy','dif',longname='dE/dt CAM physics parameterizations (phAP-phBP)',outfld=.true.) +!!$ call budget_add('BD_phy_params',idyAP,idyBP,'phy','dif',longname='dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)',outfld=.true.) +!!$ call budget_add('BP_pwork',iphAM,iphAP,'phy','dif',longname='dE/dt dry mass adjustment (phAM-phAP)',outfld=.true.) +!!$ call budget_add('BD_pwork',idyAM,idyAP,'phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)',outfld=.true.) +!!$ call budget_add('BP_efix',iphBP,iphBF,'phy','dif',longname='dE/dt energy fixer (phBP-phBF)',outfld=.true.) +!!$ call budget_add('BD_efix',idyBP,idyBF,'phy','dif',longname='dE/dt energy fixer using dycore E (dyBP-dyBF)',outfld=.true.) +!!$ call budget_add('BP_phys_tot',iphAM,iphBF,'phy','dif',longname='dE/dt physics total (phAM-phBF)',outfld=.true.) +!!$ call budget_add('BD_phys_tot',idyAM,idyBF,'phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)',outfld=.true.) + + ! Register budgets. + call budget_add('BP_phy_params','phAP','phBP','phy','dif',longname='dE/dt CAM physics parameterizations (phAP-phBP)',outfld=.true.) + call budget_add('BD_phy_params','dyAP','dyBP','phy','dif',longname='dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)',outfld=.true.) + call budget_add('BP_pwork','phAM','phAP','phy','dif',longname='dE/dt dry mass adjustment (phAM-phAP)',outfld=.true.) + call budget_add('BD_pwork','dyAM','dyAP','phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)',outfld=.true.) + call budget_add('BP_efix','phBP','phBF','phy','dif',longname='dE/dt energy fixer (phBP-phBF)',outfld=.true.) + call budget_add('BD_efix','dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E (dyBP-dyBF)',outfld=.true.) + call budget_add('BP_phys_tot','phAM','phBF','phy','dif',longname='dE/dt physics total (phAM-phBF)',outfld=.true.) + call budget_add('BD_phys_tot','dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)',outfld=.true.) + call budget_add('BP_param_and_efix','phAP','phBF','phy','dif',longname='dE/dt parameterizations + efix (phAP-phBF)',outfld=.true.) + call budget_add('BD_param_and_efix','dyAP','dyBF','phy','dif',longname='dE/dt parameterizations + efix dycore E (dyAP-dyBF)',outfld=.true.) + ! Register water vapor. ! ***** N.B. ***** This must be the first call to cnst_add so that ! water vapor is constituent 1. @@ -746,6 +779,8 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use nudging, only: Nudge_Model, nudging_init use cam_snapshot, only: cam_snapshot_init use cam_history, only: addfld, register_vector_field, add_default + use budgets, only: budget_num, budget_info, budget_outfld, budget_init + use check_energy, only: check_energy_budget_init ! Input/output arguments type(physics_state), pointer :: phys_state(:) @@ -757,12 +792,14 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! local variables integer :: lchnk - integer :: ierr + integer :: i,ierr logical :: history_budget ! output tendencies and state variables for ! temperature, water vapor, cloud ! ice, cloud liquid, U, V integer :: history_budget_histfile_num ! output history file number for budget fields + character*32 :: budget_name ! parameterization name for fluxes + character*128 :: budget_longname ! parameterization name for fluxes !----------------------------------------------------------------------- @@ -770,6 +807,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) do lchnk = begchunk, endchunk call physics_state_set_grid(lchnk, phys_state(lchnk)) + call check_energy_budget_init(phys_state(lchnk)) end do !------------------------------------------------------------------------------------------- @@ -1013,7 +1051,7 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) !----------------------------------------------------------------------- use time_manager, only: get_nstep use cam_diagnostics,only: diag_allocate, diag_physvar_ic - use check_energy, only: check_energy_gmean + use check_energy, only: check_energy_gmean, check_energy_budget use spmd_utils, only: mpicom use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_allocate #if (defined BFB_CAM_SCAM_IOP ) @@ -1063,6 +1101,7 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) ! Compute total energy of input state and previous output state call t_startf ('chk_en_gmean') call check_energy_gmean(phys_state, pbuf2d, ztodt, nstep) + call check_energy_budget(phys_state, ztodt, nstep) call t_stopf ('chk_en_gmean') call pbuf_allocate(pbuf2d, 'physpkg') From b29223928f11705404cd3185f5e6842a127832a3 Mon Sep 17 00:00:00 2001 From: PeterHjortLauritzen Date: Thu, 20 Oct 2022 10:32:17 -0600 Subject: [PATCH 016/140] fix NAG issue with strings --- src/dynamics/mpas/dyn_comp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index 8d652d928f..1fda88fb5a 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -367,7 +367,7 @@ subroutine dyn_init(dyn_in, dyn_out) ! variables for initializing energy and axial angular momentum diagnostics integer, parameter :: num_stages = 6, num_vars = 5 - character (len = 16), dimension(num_stages) :: stage = (/"dBF","dAP","dAM","BD_dparm","BD_DMEA","BD_phys"/) + character (len = 8), dimension(num_stages) :: stage = (/"dBF ","dAP ","dAM ","BD_dparm","BD_DMEA ","BD_phys "/) character (len = 55),dimension(num_stages) :: stage_txt = (/& " dynamics state before physics (d_p_coupling) ",& " dynamics state with T,u,V increment but not q ",& From b93dd39c6b5721825f7521376a35616914e1f220 Mon Sep 17 00:00:00 2001 From: PeterHjortLauritzen Date: Thu, 20 Oct 2022 10:32:38 -0600 Subject: [PATCH 017/140] modify text for logfile --- src/dynamics/se/dycore_budget.F90 | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index 6cb5bb23e0..64f848ff4f 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -100,13 +100,15 @@ subroutine print_budget() rate_of_change_hvis_sponge = diffusion_sponge write(iulog,*)" " + write(iulog,*)" Total energy diagnostics introduced in Lauritzen and Williamson (2019)" + write(iulog,*)" (DOI:10.1029/2018MS001549)" write(iulog,*)" " - + write(iulog,*)"suffix (parameterization side)" - write(iulog,*)"pBF: state passed to parameterizations, before energy fixer" - write(iulog,*)"pBP: after energy fixer, before parameterizations" - write(iulog,*)"pAP: after last phys_update in parameterizations and state saved for energy fixer" - write(iulog,*)"pAM: after dry mass correction calculate but not used in SE" + write(iulog,*)"phBF: state passed to parameterizations, before energy fixer" + write(iulog,*)"phBP: after energy fixer, before parameterizations" + write(iulog,*)"phAP: after last phys_update in parameterizations and state saved for energy fixer" + write(iulog,*)"phAM: after dry mass correction" write(iulog,*)" " write(iulog,*)"history files saved off here" @@ -146,8 +148,8 @@ subroutine print_budget() write(iulog,*)" CAM physics energy increments (in pressure coordinate)" write(iulog,*)"-------------------------------------------------------" write(iulog,*)" " - write(iulog,*)"dE/dt parameterizations no efix (param) (pAP-pBP) ",ph_param," W/M^2" - write(iulog,*)"dE/dt energy fixer (efix) (pBP-pBF) ",ph_EFIX," W/M^2" + write(iulog,*)"dE/dt parameterizations (phAP-pBP) ",ph_param," W/M^2" + write(iulog,*)"dE/dt energy fixer (efix) (phBP-pBF) ",ph_EFIX," W/M^2" write(iulog,*)"NOTE: energy fixer uses energy formula consistent with dycore (so this is not p-based for SE) " write(iulog,*)"dE/dt parameterizations + efix (pAP-pBF) ",ph_param_and_efix," W/M^2" write(iulog,*)" " From 62751baab06fa21b2df52c3400bb92d14b706d22 Mon Sep 17 00:00:00 2001 From: PeterHjortLauritzen Date: Thu, 20 Oct 2022 16:17:05 -0600 Subject: [PATCH 018/140] mods to log file messages and remove unused energy difference --- src/dynamics/se/dycore_budget.F90 | 113 +++++++++++++++++++++--------- src/physics/cam/physpkg.F90 | 1 - src/physics/cam_dev/physpkg.F90 | 1 - 3 files changed, 80 insertions(+), 35 deletions(-) diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index 95953abe44..b98a4ff315 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -1,9 +1,9 @@ module dycore_budget - +use shr_kind_mod, only: r8=>shr_kind_r8 implicit none public :: print_budget - +real(r8), parameter :: eps = 1.0E-12_r8 !========================================================================================= contains @@ -12,6 +12,7 @@ module dycore_budget subroutine print_budget() use spmd_utils, only: masterproc + use cam_abortutils, only: endrun use cam_logfile, only: iulog use shr_kind_mod, only: r8=>shr_kind_r8 use budgets, only: budget_get_global, is_budget @@ -21,7 +22,7 @@ subroutine print_budget() integer :: i character(len=*), parameter :: subname = 'check_energy:print_budgets' - real(r8) :: ph_param,ph_EFIX,ph_DMEA,ph_param_and_efix,ph_phys_total + real(r8) :: ph_param,ph_EFIX,ph_DMEA,ph_phys_total real(r8) :: dy_param,dy_EFIX,dy_DMEA,dy_param_and_efix,dy_phys_total real(r8) :: se_param,se_dmea,se_phys_total, dycore, err, param, pefix, & pdmea, phys_total, dyn_total, dyn_phys_total, & @@ -34,7 +35,8 @@ subroutine print_budget() mass_change__heating_term_put_back_in,mass_change__hypervis_total, & error, mass_change__physics, dbd, daf, dar, dad, qneg, val,phbf,ded - + real(r8) :: E_dBF, E_phBF, diff + integer :: m_cnst, qsize_condensate_loading logical :: te_consistent_version @@ -61,7 +63,6 @@ subroutine print_budget() call budget_get_global('phAP-phBP',1,ph_param) call budget_get_global('phBP-phBF',1,ph_EFIX) call budget_get_global('phAM-phAP',1,ph_DMEA) - call budget_get_global('phAP-phBF',1,ph_param_and_efix) call budget_get_global('phAM-phBF',1,ph_phys_total) call budget_get_global('dyAP-dyBP',1,dy_param) @@ -94,15 +95,7 @@ subroutine print_budget() write(iulog,*)" " write(iulog,*)" Total energy diagnostics introduced in Lauritzen and Williamson (2019)" write(iulog,*)" (DOI:10.1029/2018MS001549)" - write(iulog,*)" " - - write(iulog,*)"suffix (parameterization side)" - write(iulog,*)"phBF: state passed to parameterizations, before energy fixer" - write(iulog,*)"phBP: after energy fixer, before parameterizations" - write(iulog,*)"phAP: after last phys_update in parameterizations and state saved for energy fixer" - write(iulog,*)"phAM: after dry mass correction" - write(iulog,*)" " - write(iulog,*)"history files saved off here" + write(iulog,*)" " write(iulog,*)" " write(iulog,*)"suffix (dynamics)" @@ -130,24 +123,71 @@ subroutine print_budget() write(iulog,*)" " write(iulog,*)" " - write(iulog,*)"=================================================================================" - write(iulog,*)"| |" - write(iulog,*)"| ANALYSIS OF ENERGY DIAGNOSTICS IN PHYSICS |" - write(iulog,*)"| |" - write(iulog,*)"=================================================================================" - write(iulog,*)" " - write(iulog,*)"-------------------------------------------------------" - write(iulog,*)" CAM physics energy increments (in pressure coordinate)" - write(iulog,*)"-------------------------------------------------------" - write(iulog,*)" " - write(iulog,*)"dE/dt parameterizations (phAP-pBP) ",ph_param," W/M^2" - write(iulog,*)"dE/dt energy fixer (efix) (phBP-pBF) ",ph_EFIX," W/M^2" - write(iulog,*)"NOTE: energy fixer uses energy formula consistent with dycore (so this is not p-based for SE) " - write(iulog,*)"dE/dt parameterizations + efix (pAP-pBF) ",ph_param_and_efix," W/M^2" + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)"Physics time loop" + write(iulog,*)"------------------------------------------------------------" write(iulog,*)" " - write(iulog,*)"dE/dt dry mass adjustment (pwork) (pAM-pAP) ",ph_DMEA," W/M^2" - write(iulog,*)"dE/dt physics total (phys) (pAM-pBF) ",ph_phys_total," W/M^2" + write(iulog,*)"phBF: state passed to parameterizations, before energy fixer" + write(iulog,*)"phBP: after energy fixer, before parameterizations" + write(iulog,*)"phAP: after last phys_update in parameterizations and state " + write(iulog,*)" saved for energy fixer" + write(iulog,*)"phAM: after dry mass correction" + write(iulog,*)"history files saved off here" write(iulog,*)" " + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" CAM physics energy tendencies (using pressure coordinate)" + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" " + write(iulog,*)"dE/dt energy fixer (phBP-pBF) ",ph_EFIX," W/M^2" + write(iulog,*)"dE/dt all parameterizations (phAP-pBP) ",ph_param," W/M^2" + write(iulog,*)"dE/dt dry mass adjustment (pAM-pAP) ",ph_DMEA," W/M^2" + write(iulog,*)"dE/dt physics total (pAM-pBF) ",ph_phys_total," W/M^2" + ! + ! consistency check + ! + if (abs(ph_param+ph_EFIX+ph_DMEA-ph_phys_total)>eps) then + write(iulog,*) "Physics energy budget not adding up:" + write(iulog,*) "(phBP-pBF)+(phAP-pBP)+(pAM-pAP) does not add up to (pAM-pBF)",\ + abs(ph_param+ph_EFIX+ph_DMEA-ph_phys_total) + call endrun('dycore_budget module: physics energy budget consistency error') + endif + write(iulog,*) " " + write(iulog,*) "-dE/dt energy fixer = dE/dt dry mass adjustment +" + write(iulog,*) " dE/dt dycore +" + write(iulog,*) " dE/dt physics-dynamics coupling errors +" + write(iulog,*) " dE/dt energy formula differences " + write(iulog,*) " " + write(iulog,*) "(equation 23 in Lauritzen and Williamson (2019))" + write(iulog,*) " " + ! + ! check for energy formula difference + ! + write(iulog,*) "" + write(iulog,*) "Is globally integrated total energy of state at the end of dynamics (dBF)" + write(iulog,*) "and beginning of physics (phBF) the same?" + write(iulog,*) "" + call budget_get_global('dBF',1,E_dBF) !state passed to physics + call budget_get_global('phBF',1,E_phBF)!state beginning physics + if (abs(E_phBF)>eps) then + diff = abs_diff(E_dBF,E_phBF) + if (abs(diff)eps) then + abs_diff = abs((b-a)/b) + else + abs_diff = abs(b-a) + end if +end function abs_diff end module dycore_budget - diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 5c7ac22921..77866f5932 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -213,7 +213,6 @@ subroutine phys_register call budget_add('BD_efix','dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E (dyBP-dyBF)',outfld=.true.) call budget_add('BP_phys_tot','phAM','phBF','phy','dif',longname='dE/dt physics total (phAM-phBF)',outfld=.true.) call budget_add('BD_phys_tot','dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)',outfld=.true.) - call budget_add('BP_param_and_efix','phAP','phBF','phy','dif',longname='dE/dt parameterizations + efix (phAP-phBF)',outfld=.true.) call budget_add('BD_param_and_efix','dyAP','dyBF','phy','dif',longname='dE/dt parameterizations + efix dycore E (dyAP-dyBF)',outfld=.true.) ! Register water vapor. diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index e67b3c0dd7..f649a13e49 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -203,7 +203,6 @@ subroutine phys_register call budget_add('BD_efix','dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E (dyBP-dyBF)',outfld=.true.) call budget_add('BP_phys_tot','phAM','phBF','phy','dif',longname='dE/dt physics total (phAM-phBF)',outfld=.true.) call budget_add('BD_phys_tot','dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)',outfld=.true.) - call budget_add('BP_param_and_efix','phAP','phBF','phy','dif',longname='dE/dt parameterizations + efix (phAP-phBF)',outfld=.true.) call budget_add('BD_param_and_efix','dyAP','dyBF','phy','dif',longname='dE/dt parameterizations + efix dycore E (dyAP-dyBF)',outfld=.true.) ! Register water vapor. From b23a1ae982cc49783904a1d8fa543ea4cb8b05f9 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 20 Oct 2022 17:19:23 -0600 Subject: [PATCH 019/140] fix get_info interface and some NAG cleanup --- src/dynamics/mpas/dp_coupling.F90 | 2 +- src/physics/cam/check_energy.F90 | 31 ++++++++++++++----------------- 2 files changed, 15 insertions(+), 18 deletions(-) diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index 1daa93f787..c2c063319e 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -825,7 +825,7 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t call outfld(name_out2,kinetic_energy ,ncells,1) call outfld(name_out3,water_vapor ,ncells,1) - call budget_info(trim(outfld_name_suffix),budget_ind=b_ind,state_ind=s_ind,subcycle=b_subcycle) + call budget_info_byname(trim(outfld_name_suffix),budget_ind=b_ind,state_ind=s_ind,subcycle=b_subcycle) ! reset all when cnt is 0 write(iulog,*)'dpc calc se,ke ',s_ind,',1:3,1 is ',internal_energy(1),' ',kinetic_energy(1) write(iulog,*)'dpc budgets initial ',s_ind,',1:3,1 is ',te_budgets(s_ind,1,1),' ',te_budgets(s_ind,2,1),' ',te_budgets(s_ind,3,1) diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 57364f457c..7fd5ce32d6 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -186,7 +186,7 @@ subroutine check_energy_init() !----------------------------------------------------------------------- use cam_history, only: addfld, add_default, horiz_only use phys_control, only: phys_getopts - use budgets, only: budget_num, budget_outfld, budget_info, budget_me_varnum + use budgets, only: budget_num, budget_outfld, budget_info implicit none @@ -259,7 +259,7 @@ subroutine check_energy_timestep_init(state, tend, pbuf, col_type) real(r8) :: cp_or_cv(state%psetcols,pver) integer lchnk ! chunk identifier integer ncol ! number of atmospheric columns - integer i,k ! column, level indices +!jt integer i,k ! column, level indices !----------------------------------------------------------------------- lchnk = state%lchnk @@ -333,7 +333,7 @@ subroutine check_energy_budget_init(state) ! Compute initial values of energy and water integrals, ! zero cumulative tendencies !----------------------------------------------------------------------- - use cam_history, only: addfld, add_default, horiz_only + !------------------------------Arguments-------------------------------- type(physics_state), intent(inout) :: state @@ -341,7 +341,7 @@ subroutine check_energy_budget_init(state) integer ncol ! number of atmospheric columns !----------------------------------------------------------------------- - ncol = state%ncol +!jt ncol = state%ncol ! zero cummulative boundary fluxes state%te_budgets(:,:,:) = 0._r8 end subroutine check_energy_budget_init @@ -401,10 +401,8 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & integer lchnk ! chunk identifier integer ncol ! number of atmospheric columns - integer i,k ! column, level indices - integer :: ixcldice, ixcldliq ! CLDICE and CLDLIQ indices - integer :: ixrain, ixsnow ! RAINQM and SNOWQM indices - integer :: ixgrau ! GRAUQM index + !jt integer i,k ! column, level indices + integer i ! column !----------------------------------------------------------------------- lchnk = state%lchnk @@ -520,7 +518,7 @@ end subroutine check_energy_chng subroutine check_energy_gmean(state, pbuf2d, dtime, nstep) use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_chunk - use dyn_tests_utils, only: vc_dycore, vc_height +!jt use dyn_tests_utils, only: vc_dycore, vc_height use physics_types, only: dyn_te_idx !----------------------------------------------------------------------- ! Compute global mean total energy of physics input and output states @@ -586,12 +584,12 @@ end subroutine check_energy_gmean subroutine check_energy_budget(state, dtime, nstep) use cam_history, only: outfld - use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_chunk - use dyn_tests_utils, only: vc_dycore, vc_height - use physics_types, only: phys_te_idx, dyn_te_idx +!jt use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_chunk +!jt use dyn_tests_utils, only: vc_dycore, vc_height +!jt use physics_types, only: phys_te_idx, dyn_te_idx use budgets, only: budget_num, budget_info, & - budget_type_byind, budget_outfld, budget_num_phy, & - budget_cnt_adjust, budget_me_varnum, budget_put_global, budget_get_global + budget_outfld, budget_num_phy, & + budget_me_varnum, budget_put_global use cam_abortutils, only: endrun use dycore_budget, only: print_budget !----------------------------------------------------------------------- @@ -614,7 +612,6 @@ subroutine check_energy_budget(state, dtime, nstep) real(r8),allocatable :: te(:,:,:,:) ! total energy of input/output states (copy) !jt real(r8),allocatable :: te_glob(budget_num_phy) ! global means of total energy real(r8),allocatable :: te_glob(:,:) ! global means of total energy - real(r8) :: phparam,dyparam,phpwork,dypwork,phefix,dyefix,phphys,dyphys integer :: i,ii,ind,is1,is2,is1b,is2b character*32 :: budget_name ! parameterization name for fluxes character*3 :: budget_pkgtype ! parameterization type phy or dyn @@ -944,11 +941,11 @@ end subroutine check_tracers_chng !####################################################################### subroutine calc_te_and_aam_budgets(state, outfld_name_suffix, vc) - use physconst, only: gravit,cpair,pi,rearth,omega,get_hydrostatic_energy + use physconst, only: gravit,cpair,rearth,omega,get_hydrostatic_energy use cam_history, only: hist_fld_active, outfld use dyn_tests_utils, only: vc_physics, vc_height use cam_abortutils, only: endrun - use budgets, only: budget_cnt_adjust, budget_info_byname + use budgets, only: budget_info_byname !------------------------------Arguments-------------------------------- type(physics_state), intent(inout) :: state From f4a224a44eeee9c7b36d470239cf8187dca0edfd Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 21 Oct 2022 09:20:07 -0600 Subject: [PATCH 020/140] bug fix for cam6_3_080 merge --- src/dynamics/mpas/dyn_comp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index 3f84d971bd..424680605f 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -695,7 +695,7 @@ end subroutine dyn_run subroutine budget_update(nCells,dyn_out) use budgets, only : budget_num, budget_info, budget_me_varnum,budget_put_global - use physconst, only : thermodynamic_active_species_liq_num, thermodynamic_active_species_ice_num + use air_composition, only : thermodynamic_active_species_liq_num, thermodynamic_active_species_ice_num ! arguments integer, intent(in) :: nCells ! Number of cells, including halo cells From 0c9375fd51951388f6ef42a2eeadba3bf80d4f9b Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 21 Oct 2022 14:05:26 -0600 Subject: [PATCH 021/140] bug fix for cam_thermo --- src/dynamics/mpas/dp_coupling.F90 | 6 +++--- src/dynamics/se/dycore/prim_advance_mod.F90 | 10 +++++----- src/dynamics/se/dyn_comp.F90 | 2 +- src/utils/cam_thermo.F90 | 7 ++++--- 4 files changed, 13 insertions(+), 12 deletions(-) diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index 3605efaf76..162542a8ba 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -750,7 +750,7 @@ subroutine hydrostatic_pressure(nCells, nVertLevels, zz, zgrid, rho_zz, theta_m, end do end subroutine hydrostatic_pressure -subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, theta_m, q, ux,uy,outfld_name_suffix) +subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, theta_m, q, ux,uy,outfld_name_suffix,te_budgets,budgets_cnt,budgets_subcycle_cnt) use physconst, only: rair, cpair, gravit,cappa!=R/cp (dry air) use mpas_constants, only: p0,cv,rv,rgas,cp use cam_history, only: outfld, hist_fld_active @@ -771,8 +771,8 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t real(r8), dimension(nVertLevels, nCells), intent(in) :: ux ! A-grid zonal velocity component real(r8), dimension(nVertLevels, nCells), intent(in) :: uy ! A-grid meridional velocity component real(r8), dimension(budget_array_max, 9, nCells), intent(inout) :: te_budgets ! energy/mass budget arrays - integer, dimension(budget_array_max), intent(inout) :: budgets_cnt ! budget counts for normalization - integer, dimension(budget_array_max), intent(inout) :: budgets_subcycle_cnt ! budget counts for normalization + integer, dimension(budget_array_max), intent(inout) :: budgets_cnt ! budget counts for normalization + integer, dimension(budget_array_max), intent(inout) :: budgets_subcycle_cnt ! budget counts for normalization character*(*), intent(in) :: outfld_name_suffix ! suffix for "outfld" names ! Local variables diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index 9fc6c0fca8..afc7d87752 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -1733,11 +1733,11 @@ subroutine calc_tot_energy_dynamics_diff(elem,fvm,nets,nete,tl,tl_qdp,outfld_nam use cam_history, only: hist_fld_active,outfld use constituents, only: cnst_get_ind use fvm_control_volume_mod, only: fvm_struct - use physconst, only: thermodynamic_active_species_idx_dycore - use physconst, only: thermodynamic_active_species_ice_num - use physconst, only: thermodynamic_active_species_liq_num - use physconst, only: thermodynamic_active_species_liq_idx - use physconst, only: thermodynamic_active_species_ice_idx + use air_composition, only: thermodynamic_active_species_idx_dycore + use air_composition, only: thermodynamic_active_species_ice_num + use air_composition, only: thermodynamic_active_species_liq_num + use air_composition, only: thermodynamic_active_species_liq_idx + use air_composition, only: thermodynamic_active_species_ice_idx use budgets, only: budget_info,budget_ind_byname !------------------------------Arguments-------------------------------- diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index acd4730d4d..2a5a243b1a 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -2409,7 +2409,7 @@ subroutine budget_update(elem,fvm,nets,nete,n0,n0_qdp,hybrid) use element_mod, only: element_t use fvm_control_volume_mod, only: fvm_struct use global_norms_mod, only: global_integral - use physconst, only: thermodynamic_active_species_liq_num, thermodynamic_active_species_ice_num + use air_composition, only: thermodynamic_active_species_liq_num, thermodynamic_active_species_ice_num use prim_advance_mod, only: calc_tot_energy_dynamics_diff use time_manager, only: get_step_size diff --git a/src/utils/cam_thermo.F90 b/src/utils/cam_thermo.F90 index d9505dc149..6c683cd92d 100644 --- a/src/utils/cam_thermo.F90 +++ b/src/utils/cam_thermo.F90 @@ -597,7 +597,7 @@ subroutine get_dp_1hd(tracer, mixing_ratio, active_species_idx, dp_dry, dp, ps, integer, intent(in) :: active_species_idx(:) ! index for thermodynamic species in tracer array real(r8), intent(in) :: dp_dry(:, :) ! dry pressure level thickness real(r8), intent(out) :: dp(:, :) ! pressure level thickness - real(r8), optional,intent(out) :: ps(:, :) ! surface pressure (if ps present then ptop + real(r8), optional,intent(out) :: ps(:) ! surface pressure (if ps present then ptop ! must be present) real(r8), optional,intent(in) :: ptop ! pressure at model top @@ -632,7 +632,8 @@ subroutine get_dp_1hd(tracer, mixing_ratio, active_species_idx, dp_dry, dp, ps, ps = ptop do kdx = 1, SIZE(tracer, 2) do idx = 1, SIZE(tracer, 1) - ps(idx, kdx) = ps(idx, kdx) + dp(idx, kdx) +!jt ps(idx, kdx) = ps(idx, kdx) + dp(idx, kdx) + ps(idx) = ps(idx) + dp(idx, kdx) end do end do else @@ -656,7 +657,7 @@ subroutine get_dp_2hd(tracer, mixing_ratio, active_species_idx, dp_dry, dp, ps, do jdx = 1, SIZE(tracer, 2) call get_dp(tracer(:, jdx, :, :), mixing_ratio, active_species_idx, & - dp_dry(:, jdx, :), dp(:, jdx, :), ps=ps, ptop=ptop) + dp_dry(:, jdx, :), dp(:, jdx, :), ps=ps(:,jdx), ptop=ptop) end do end subroutine get_dp_2hd From f69fbacf5ec9725684cee42073ea6cc7e5669a9a Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 21 Oct 2022 15:58:17 -0600 Subject: [PATCH 022/140] correct fix for cam_thermo --- src/utils/cam_thermo.F90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/utils/cam_thermo.F90 b/src/utils/cam_thermo.F90 index 6c683cd92d..43dad7e48c 100644 --- a/src/utils/cam_thermo.F90 +++ b/src/utils/cam_thermo.F90 @@ -656,8 +656,13 @@ subroutine get_dp_2hd(tracer, mixing_ratio, active_species_idx, dp_dry, dp, ps, integer :: jdx do jdx = 1, SIZE(tracer, 2) - call get_dp(tracer(:, jdx, :, :), mixing_ratio, active_species_idx, & + if (present(ps).and.present(ptop)) then + call get_dp(tracer(:, jdx, :, :), mixing_ratio, active_species_idx, & dp_dry(:, jdx, :), dp(:, jdx, :), ps=ps(:,jdx), ptop=ptop) + else + call get_dp(tracer(:, jdx, :, :), mixing_ratio, active_species_idx, & + dp_dry(:, jdx, :), dp(:, jdx, :)) + end if end do end subroutine get_dp_2hd From 4c6efeebab7921139dbf8cc078c4b65d86da466e Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 21 Oct 2022 17:33:16 -0600 Subject: [PATCH 023/140] added budget for phAP-phBF in physpkg to fix error with budget_print --- src/physics/cam/physpkg.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index a6017b73f2..c3a3e36efe 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -208,6 +208,7 @@ subroutine phys_register !!$ call budget_add('BD_phys_tot',idyAM,idyBF,'phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)',outfld=.true.) ! Register budgets. + call budget_add('BP_param_and_efix','phAP','phBF','phy','dif',longname='dE/dt CAM physics parameterizations + efix dycore E (phAP-phBF)',outfld=.true.) call budget_add('BP_phy_params','phAP','phBP','phy','dif',longname='dE/dt CAM physics parameterizations (phAP-phBP)',outfld=.true.) call budget_add('BD_phy_params','dyAP','dyBP','phy','dif',longname='dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)',outfld=.true.) call budget_add('BP_pwork','phAM','phAP','phy','dif',longname='dE/dt dry mass adjustment (phAM-phAP)',outfld=.true.) From f3edd5e40c8e3c269d748bc89ba924646a2b3b2b Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Mon, 24 Oct 2022 16:42:27 -0600 Subject: [PATCH 024/140] bug fix for comparing internal/external grids --- src/cpl/nuopc/atm_comp_nuopc.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/cpl/nuopc/atm_comp_nuopc.F90 b/src/cpl/nuopc/atm_comp_nuopc.F90 index 1547911608..1d0372e3fe 100644 --- a/src/cpl/nuopc/atm_comp_nuopc.F90 +++ b/src/cpl/nuopc/atm_comp_nuopc.F90 @@ -699,7 +699,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! error check differences between internally generated lons and those read in do n = 1,lsize - if (abs(lonMesh(n) - lon(n)) > grid_tol .and. abs(lonMesh(n) - lon(n)) /= 360._r8) then + if (abs(lonMesh(n) - lon(n)) > grid_tol .and. .not. & + abs(abs(lonMesh(n) - lon(n))- 360._r8) < grid_tol) then write(6,100)n,lon(n),lonMesh(n), abs(lonMesh(n)-lon(n)) 100 format('ERROR: CAM n, lonmesh(n), lon(n), diff_lon = ',i6,2(f21.13,3x),d21.5) call shr_sys_abort() From cd401075ee5cf695eed0a83093a7abd67885bd7c Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Mon, 24 Oct 2022 18:25:39 -0600 Subject: [PATCH 025/140] update default ic for aquaplanet to notopo --- bld/namelist_files/namelist_defaults_cam.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index b29e1e5be4..cb1ef4d54c 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -46,6 +46,7 @@ atm/cam/inic/mpas/mpasa480_L32_notopo_coords_c201125.nc atm/cam/inic/mpas/mpasa120_L32_notopo_coords_c201216.nc +atm/cam/inic/mpas/mpasa120_L32_notopo_coords_c201216.nc atm/cam/inic/mpas/mpasa120_L32_topo_coords_c201022.nc atm/cam/inic/mpas/mpasa120_L32_topo_coords_c201022.nc From dc5e9e1a062d69d255a020aac966389bc33c1d52 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Wed, 26 Oct 2022 14:19:02 -0600 Subject: [PATCH 026/140] update cam_dev with required budget_add call for logging energy budgets --- src/physics/cam_dev/physpkg.F90 | 1 + src/utils/cam_thermo.F90 | 1 - 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index 68d66b1988..536060b933 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -196,6 +196,7 @@ subroutine phys_register !!$ call budget_add('BD_phys_tot',idyAM,idyBF,'phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)',outfld=.true.) ! Register budgets. + call budget_add('BP_param_and_efix','phAP','phBF','phy','dif',longname='dE/dt CAM physics parameterizations + efix dycore E (phAP-phBF)',outfld=.true.) call budget_add('BP_phy_params','phAP','phBP','phy','dif',longname='dE/dt CAM physics parameterizations (phAP-phBP)',outfld=.true.) call budget_add('BD_phy_params','dyAP','dyBP','phy','dif',longname='dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)',outfld=.true.) call budget_add('BP_pwork','phAM','phAP','phy','dif',longname='dE/dt dry mass adjustment (phAM-phAP)',outfld=.true.) diff --git a/src/utils/cam_thermo.F90 b/src/utils/cam_thermo.F90 index 43dad7e48c..7f4e2d0344 100644 --- a/src/utils/cam_thermo.F90 +++ b/src/utils/cam_thermo.F90 @@ -632,7 +632,6 @@ subroutine get_dp_1hd(tracer, mixing_ratio, active_species_idx, dp_dry, dp, ps, ps = ptop do kdx = 1, SIZE(tracer, 2) do idx = 1, SIZE(tracer, 1) -!jt ps(idx, kdx) = ps(idx, kdx) + dp(idx, kdx) ps(idx) = ps(idx) + dp(idx, kdx) end do end do From a9b449a688043aa7125d78d729928740b9c17bd8 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Thu, 27 Oct 2022 12:59:32 -0600 Subject: [PATCH 027/140] move dBF energy call from dyn_comp to dp_coupling --- src/dynamics/se/dp_coupling.F90 | 4 +++- src/dynamics/se/dyn_comp.F90 | 1 - 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index 03132e8ccf..62ff4ebb98 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -57,7 +57,7 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) use time_mod, only: timelevel_qdp use control_mod, only: qsplit use test_fvm_mapping, only: test_mapping_overwrite_dyn_state, test_mapping_output_phys_state - + use prim_advance_mod, only: calc_tot_energy_dynamics ! arguments type(dyn_export_t), intent(inout) :: dyn_out ! dynamics export type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -128,6 +128,8 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) allocate(q_tmp(nphys_pts,pver,pcnst,nelemd)) allocate(omega_tmp(nphys_pts,pver,nelemd)) + call calc_tot_energy_dynamics(elem,dyn_out%fvm, 1, nelemd,tl_f , tl_qdp_np0,'dBF') + if (use_gw_front .or. use_gw_front_igw) then allocate(frontgf(nphys_pts,pver,nelemd), stat=ierr) if (ierr /= 0) call endrun("dp_coupling: Allocate of frontgf failed.") diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 2a5a243b1a..52c50ef5df 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -1207,7 +1207,6 @@ subroutine dyn_run(dyn_state) end do end if - call calc_tot_energy_dynamics(dyn_state%elem,dyn_state%fvm, nets, nete, TimeLevel%n0, n0_qdp,'dBF') !$OMP END PARALLEL if (ldiag) then From f751ff6b06134d0aef503db86c109d671e7b38f9 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Thu, 27 Oct 2022 12:59:58 -0600 Subject: [PATCH 028/140] initial clean-up of energy diags for log file --- src/dynamics/se/dycore_budget.F90 | 332 +++++++++++------------------- 1 file changed, 119 insertions(+), 213 deletions(-) diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index b98a4ff315..bda2c428a4 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -3,7 +3,10 @@ module dycore_budget implicit none public :: print_budget -real(r8), parameter :: eps = 1.0E-12_r8 +real(r8), parameter :: eps = 1.0E-9_r8 + +real(r8), save :: previous_dEdt_adiabatic_dycore = 0.0_r8 +real(r8), save :: previous_dEdt_dry_mass_adjust = 0.0_r8 !========================================================================================= contains @@ -30,7 +33,7 @@ subroutine print_budget() diffusion_del4, diffusion_fric, diffusion_del4_tot, diffusion_sponge, & diffusion_total, twoDresidual, rate_of_change_physics, & rate_of_change_heating_term_put_back_in, rate_of_change_hvis_sponge, & - value_pdc, dADIA, ttt, fff, & + dADIA, ttt, fff, & mass_change__2D_dyn,mass_change__vertical_remapping, & mass_change__heating_term_put_back_in,mass_change__hypervis_total, & error, mass_change__physics, dbd, daf, dar, dad, qneg, val,phbf,ded @@ -38,27 +41,9 @@ subroutine print_budget() real(r8) :: E_dBF, E_phBF, diff - integer :: m_cnst, qsize_condensate_loading - logical :: te_consistent_version + integer :: m_cnst !-------------------------------------------------------------------------------------- - qsize_condensate_loading=qsize - te_consistent_version=.false. - if (qsize_condensate_loading.eq.1) then - if (lcp_moist.eqv..false.) then - write(iulog,*)"Using total energy consistent version: qsize_condensate_loading=1 and cp=cpdry" - te_consistent_version=.true. - else - write(iulog,*)"WARNING: Total energy formulas for dynamics and physics are different:" - write(iulog,*)" Dynamics (cp includes water vapor; condensates not thermodynamically active)." - write(iulog,*)" Physics (cp=cp_dry in internal energy)." - end if - else - write(iulog,*)"WARNING: Total energy formulaes for dynamics and physics are different" - write(iulog,*)"in dynamics (cp and dp includes all water variables) and physics (cp=cp_dry in internal energy)." - end if - - if (masterproc) then call budget_get_global('phAP-phBP',1,ph_param) call budget_get_global('phBP-phBF',1,ph_EFIX) @@ -119,9 +104,6 @@ subroutine print_budget() write(iulog,*)" end of remapping loop ------------------------------------------------------" write(iulog,*)"dBF state passed to parameterizations = state after last remapping " write(iulog,*)" " - write(iulog,*)" " - write(iulog,*)" " - write(iulog,*)" " write(iulog,*)"------------------------------------------------------------" write(iulog,*)"Physics time loop" @@ -138,19 +120,11 @@ subroutine print_budget() write(iulog,*)" CAM physics energy tendencies (using pressure coordinate)" write(iulog,*)"------------------------------------------------------------" write(iulog,*)" " - write(iulog,*)"dE/dt energy fixer (phBP-pBF) ",ph_EFIX," W/M^2" - write(iulog,*)"dE/dt all parameterizations (phAP-pBP) ",ph_param," W/M^2" - write(iulog,*)"dE/dt dry mass adjustment (pAM-pAP) ",ph_DMEA," W/M^2" - write(iulog,*)"dE/dt physics total (pAM-pBF) ",ph_phys_total," W/M^2" - ! - ! consistency check - ! - if (abs(ph_param+ph_EFIX+ph_DMEA-ph_phys_total)>eps) then - write(iulog,*) "Physics energy budget not adding up:" - write(iulog,*) "(phBP-pBF)+(phAP-pBP)+(pAM-pAP) does not add up to (pAM-pBF)",\ - abs(ph_param+ph_EFIX+ph_DMEA-ph_phys_total) - call endrun('dycore_budget module: physics energy budget consistency error') - endif + write(iulog,'(a40,F5.2,a6)')"dE/dt energy fixer (phBP-pBF) ",ph_EFIX," W/M^2" + write(iulog,'(a40,F5.2,a6)')"dE/dt all parameterizations (phAP-pBP) ",ph_param," W/M^2" + write(iulog,'(a40,F5.2,a6)')"dE/dt dry mass adjustment (pAM-pAP) ",ph_DMEA," W/M^2" + write(iulog,'(a40,F5.2,a6)')"dE/dt physics total (pAM-pBF) ",ph_phys_total," W/M^2" + write(iulog,*)" " write(iulog,*) " " write(iulog,*) "-dE/dt energy fixer = dE/dt dry mass adjustment +" write(iulog,*) " dE/dt dycore +" @@ -158,10 +132,76 @@ subroutine print_budget() write(iulog,*) " dE/dt energy formula differences " write(iulog,*) " " write(iulog,*) "(equation 23 in Lauritzen and Williamson (2019))" + write(iulog,*) " " + dycore = -ph_EFIX-ph_DMEA + dycore = -ph_EFIX-previous_dEdt_dry_mass_adjust + write(iulog,*) "" + write(iulog,*) "Dycore TE dissipation estimated from physics in pressure coordinate:" + write(iulog,*) "(note to avoid sampling error we need dE/dt from previous time-step)" + write(iulog,*) "" + write(iulog,*) "dE/dt adiabatic dycore estimated from physics (t=n-1) = " + write(iulog,'(a58,F5.2,a6)') "-dE/dt energy fixer(t=n)-dE/dt dry-mass adjust(t=n-1) = ",dycore," W/M^2" + write(iulog,*) "" + write(iulog,'(a58,F5.2,a6)') "dE/dt adiabatic dycore computed in dycore (t=n-1) = ",& + previous_dEdt_adiabatic_dycore," W/M^2" + write(iulog,'(a58,F5.2,a6)') "dE/dt dry-mass adjust (t=n-1) = ",& + previous_dEdt_dry_mass_adjust," W/M^2" + write(iulog,*) "" + if (abs(previous_dEdt_adiabatic_dycore)>eps) then + diff = abs((dycore-previous_dEdt_adiabatic_dycore)/previous_dEdt_adiabatic_dycore) + if (diff>eps) then + write(iulog,*) "energy budget not closed: previous_dEdt_adiabatic_dycore <> dycore" + write(iulog,*) "normalized difference is:",diff +! call endrun('dycore_budget module: physics energy budget consistency error 2') + end if + end if + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" Physics dynamics coupling errors" + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" " + write(iulog,'(a46,F5.2,a6)')"dE/dt physics tendency in dynamics (dBD-dAF) ",rate_of_change_physics," W/M^2" + write(iulog,'(a46,F5.2,a6)')"dE/dt physics tendency in physics (pAM-pBF) ",ph_phys_total," W/M^2" + write(iulog,*)" " + write(iulog,'(a46,F5.2,a6)')"dE/dt physics-dynamics coupling errors ",ph_phys_total-rate_of_change_physics," W/M^2" + + write(iulog,*)" " + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" SE dycore energy tendencies" + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" " +! write(iulog,*)"dE/dt dyn total (dycore+phys tendency (dBF-dED) ",dyn_total," W/M^2" + write(iulog,'(a46,F5.2,a6)')"dE/dt adiabatic dynamics ",dADIA," W/M^2" + write(iulog,*)" " + write(iulog,*)"Adiabatic dynamics can be divided into quasi-horizontal and vertical remapping: " + write(iulog,*)" " + write(iulog,'(a40,F5.2,a6)') "dE/dt 2D dynamics (dAD-dBD) ",rate_of_change_2D_dyn," W/M^2" + write(iulog,'(a40,F5.2,a6)') "dE/dt vertical remapping (dAR-dAD) ",rate_of_change_vertical_remapping," W/M^2" + write(iulog,*) " " + write(iulog,*) "Breakdown of 2D dynamics:" + write(iulog,*) " " + write(iulog,'(a45,F5.2,a6)')" dE/dt hypervis del4 (dCH-dBH) ",diffusion_del4," W/M^2" + write(iulog,'(a45,F5.2,a6)')" dE/dt hypervis frictional heating (dAH-dCH) ",diffusion_fric," W/M^2" + write(iulog,'(a45,F5.2,a6)')" dE/dt hypervis del4 total (dAH-dBH) ",diffusion_del4_tot," W/M^2" + write(iulog,'(a45,F5.2,a6)')" dE/dt hypervis sponge total (dAS-dBS) ",diffusion_sponge," W/M^2" + write(iulog,'(a45,F5.2,a6)')" dE/dt explicit diffusion total ",diffusion_total," W/M^2" + twoDresidual = rate_of_change_2D_dyn-diffusion_total + write(iulog,'(a45,F5.2,a6)')" dE/dt residual (time-truncation errors) ",twoDresidual," W/M^2" + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" Consistency checks" + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" " ! - ! check for energy formula difference + ! consistency check ! + if (abs(ph_param+ph_EFIX+ph_DMEA-ph_phys_total)>eps) then + write(iulog,*) "Physics energy budget not adding up:" + write(iulog,*) "(phBP-pBF)+(phAP-pBP)+(pAM-pAP) does not add up to (pAM-pBF)",\ + abs(ph_param+ph_EFIX+ph_DMEA-ph_phys_total) + call endrun('dycore_budget module: physics energy budget consistency error') + endif write(iulog,*) "" write(iulog,*) "Is globally integrated total energy of state at the end of dynamics (dBF)" write(iulog,*) "and beginning of physics (phBF) the same?" @@ -171,9 +211,10 @@ subroutine print_budget() if (abs(E_phBF)>eps) then diff = abs_diff(E_dBF,E_phBF) if (abs(diff)1 and/or cp<>cpdry)" - write(iulog,*)"" - write(iulog,*)"PDC errors can not be assesed trhough " - write(iulog,*)"" - write(iulog,*)" dE/dt physics tendency in dynamics (dBD-dAF) does not match dE/dt physics total (pAM-pBF) due to energy discrepancy:",value_pdc - write(iulog,*)ph_phys_total," ",rate_of_change_physics -!jt str_pdc = "undef" - end if - write(iulog,*)"" - write(iulog,*)"Some more consisitency/budget terms" - write(iulog,*)"===================================" - write(iulog,*)"" - write(iulog,*)"Energy fixer fixes dme_adjust (pDMEA), lack of energy conservation in adiabatic" - write(iulog,*)"dynamical core (dADIA), energy discrepancy (EDIFF) and energy lost/gained in physics-dynamics coupling" - write(iulog,*)"" - write(iulog,*)"dADIA ",dADIA," W/M^2" - write(iulog,*)"pDMEA ",ph_DMEA," W/M^2" - write(iulog,*)"physics-dynamics coupling ",value_pdc," W/M^2" - write(iulog,*)"" -!jt str="dPDC+EDIFF" - write(iulog,*)"" - write(iulog,*)" -energy fixer = DME_adjust+adaib dycore+phys-dyn errors+discr" - write(iulog,*)" " - ttt = -ph_DMEA-dADIA-value_pdc -!jt discr = -99.0 - write(iulog,*)" DME_adjust+adaib dycore+phys-dyn errors+discr = ",ttt - write(iulog,*)" Energy fixer = ",ph_EFIX - write(iulog,*)"" - fff = ttt-ph_EFIX - write(iulog,*)" Difference = ",fff - - - - call budget_get_global('phBF',1,phbf) - call budget_get_global('dED',1,ded) - qneg=phbf-ded - write(iulog,*)"" - write(iulog,*)" qneg: ",qneg - write(iulog,*)"" - - if (qsize.gt.0) then - write(iulog,*)"" - write(iulog,*)"" - write(iulog,*)"" - write(iulog,*)"=================================================================================" - write(iulog,*)"| |" - write(iulog,*)"| ANALYSIS OF WATER VAPOR, CLOUD LIQUID AND CLOUD ICE BUDGETS |" - write(iulog,*)"| |" - write(iulog,*)"=================================================================================" - write(iulog,*)"" - end if - !jt do m_cnst=4,4+qsize-1 do m_cnst=4,6 - if (m_cnst.eq.4) then - write(iulog,*)"Water vapor" - write(iulog,*)"-----------" - end if - if (m_cnst.eq.5) then - write(iulog,*)"Cloud liquid" - write(iulog,*)"-----------" - end if - if (m_cnst.eq.6) then - write(iulog,*)"Cloud ice" - write(iulog,*)"-----------" - end if - + write(iulog,*)"------------------------------------------------------------" + if (m_cnst.eq.4) write(iulog,*)"Water vapor mass budget" + if (m_cnst.eq.5) write(iulog,*)"Cloud liquid mass budget" + if (m_cnst.eq.6) write(iulog,*)"Cloud ice mass budget" + write(iulog,*)"------------------------------------------------------------" call budget_get_global('phBP-phBF',m_cnst,pEFIX) call budget_get_global('phAM-phAP',m_cnst,pDMEA) call budget_get_global('phAP-phBP',m_cnst,param) !jt call budget_get_global('dBF-dED',m_cnst,dyn_total) call budget_get_global('phAM-phBF',m_cnst,phys_total) - write(iulog,*)"dMASS/dt energy fixer (pBP-pBF) ",pEFIX," Pa" - write(iulog,*)"dMASS/dt parameterizations (pAP-pBP) ",param," Pa" - write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",pDMEA," Pa" - write(iulog,*)" " - val = pEFIX+pDMEA - write(iulog,*)"=> dMASS/dt dynamical core (estimated from physics) " - write(iulog,*)" dMASS/dt energy fixer + dMASS/dt dry mass adjustment ",val," Pa" - - write(iulog,*)"=> dMASS/dt physics total (pAM-pBF)",phys_total," Pa" - - - write(iulog,*)" " - write(iulog,*)" " + write(iulog,*)"dMASS/dt energy fixer (pBP-pBF) ",pEFIX," Pa" + write(iulog,*)"dMASS/dt parameterizations (pAP-pBP) ",param," Pa" + write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",pDMEA," Pa" + write(iulog,*)"dMASS/dt physics total (pAM-pBF) ",phys_total," Pa" write(iulog,*)" " - if (is_budget('dAD').and.is_budget('dBD').and.is_budget('dAR').and.is_budget('dCH')) then call budget_get_global('dAD-dBD',m_cnst,mass_change__2D_dyn) call budget_get_global('dAR-dAD',m_cnst,mass_change__vertical_remapping) - dADIA = mass_change__2D_dyn+mass_change__vertical_remapping - write(iulog,*)"dE/dt total adiabatic dynamics ",dADIA," Pa" - write(iulog,*)"dE/dt 2D dynamics (dAD-dBD) ",mass_change__2D_dyn," Pa" - write(iulog,*)" " - write(iulog,*)"Breakdown of 2D dynamics:" - write(iulog,*)" " - call budget_get_global('dAH-dCH',m_cnst,mass_change__heating_term_put_back_in) - call budget_get_global('dAH-dBH',m_cnst,mass_change__hypervis_total) - write(iulog,*)" dE/dt hypervis (dAH-dBH) ",mass_change__hypervis_total," Pa" - write(iulog,*)" dE/dt frictional heating (dAH-dCH) ",mass_change__heating_term_put_back_in," Pa" - error = mass_change__2D_dyn-mass_change__hypervis_total - write(iulog,*)" dE/dt residual (time truncation errors) ",error," Pa" - end if - if (is_budget('dAR').and.is_budget('dAD')) then - call budget_get_global('dAR',m_cnst,dar) - call budget_get_global('dAD',m_cnst,dad) - call budget_get_global('dAR-dAD',m_cnst,mass_change__vertical_remapping) - write(iulog,*)"dE/dt vertical remapping (dAR-dAD) ",mass_change__vertical_remapping," Pa","dar:",dar,"dad:",dad + diff = mass_change__2D_dyn+mass_change__vertical_remapping + write(iulog,*)"dMASS/dt total adiabatic dynamics ",diff," Pa" + if (abs(diff)>1.E-12_r8) then + write(iulog,*) "Error: mass non-conservation in dynamical core" + + write(iulog,*)"dMASS/dt 2D dynamics (dAD-dBD) ",mass_change__2D_dyn," Pa" + if (is_budget('dAR').and.is_budget('dAD')) then + call budget_get_global('dAR',m_cnst,dar) + call budget_get_global('dAD',m_cnst,dad) + call budget_get_global('dAR-dAD',m_cnst,mass_change__vertical_remapping) + write(iulog,*)"dE/dt vertical remapping (dAR-dAD) ",mass_change__vertical_remapping + end if + write(iulog,*)" " + write(iulog,*)"Breakdown of 2D dynamics:" + write(iulog,*)" " + call budget_get_global('dAH-dCH',m_cnst,mass_change__heating_term_put_back_in) + call budget_get_global('dAH-dBH',m_cnst,mass_change__hypervis_total) + write(iulog,*)"dMASS/dt hypervis (dAH-dBH) ",mass_change__hypervis_total," Pa" + write(iulog,*)"dMASS/dt frictional heating (dAH-dCH) ",mass_change__heating_term_put_back_in," Pa" + error = mass_change__2D_dyn-mass_change__hypervis_total + write(iulog,*)"dMASS/dt residual (time truncation errors)",error," Pa" + end if end if write(iulog,*)" " - write(iulog,*)" " - if (is_budget('dBD').and.is_budget('dAF')) then call budget_get_global('dBD',m_cnst,dbd) call budget_get_global('dAF',m_cnst,daf) call budget_get_global('dBD-dAF',m_cnst,mass_change__physics) - write(iulog,*)"dE/dt physics tendency in dynamics (dBD-dAF) ",mass_change__physics," Pa","dbd:",dbd,"daf:",daf + write(iulog,*)"dMASS/dt physics tendency in dynamics (dBD-dAF) ",mass_change__physics," Pa" val = phys_total-mass_change__physics + write(iulog,*) "Mass physics dynamics coupling error:",val end if - if (is_budget('dBD').and.is_budget('dAF')) then - if (ftype .eq. 1 .or.ftype .eq. 2) then - write(iulog,*)" " - write(iulog,*)" Consistency check:" - write(iulog,*)" " - write(iulog,*)" dE/dt physics tendency in dynamics (dBD-dAF) should exactly match dE/dt physics total (pAM-pBF):",val - write(iulog,*)" " - else - write(iulog,*)"Dribbling errors (pAM-pBF-(dBD-dAF))",val - end if - end if - write(iulog,*)"" - write(iulog,*)"=================================================================================" write(iulog,*)"" end do + ! + ! save adiabatic dycore dE/dt and dry-mass adjustment to avoid samping error + ! + previous_dEdt_adiabatic_dycore = dADIA + previous_dEdt_dry_mass_adjust = ph_DMEA end if end subroutine print_budget !========================================================================================= From b66b28996dbe2edfa5ffb8aa8c5e2708fe902162 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 31 Oct 2022 16:10:26 -0600 Subject: [PATCH 029/140] better physics-dynamics coupling with MPAS (code ifdef'ed in since it is answer changing) --- src/dynamics/mpas/dp_coupling.F90 | 55 ++++++++++++++++++++++++++++--- 1 file changed, 50 insertions(+), 5 deletions(-) diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index 162542a8ba..8bbb0727e8 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -132,7 +132,7 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) if( ierr /= 0 ) call endrun(subname//':failed to allocate pintdry array') call hydrostatic_pressure( & - nCellsSolve, plev, zz, zint, rho_zz, theta_m, tracers(index_qv,:,:),& + nCellsSolve, plev, zz, zint, rho_zz, theta_m, exner, tracers(index_qv,:,:),& pmiddry, pintdry, pmid) call t_startf('dpcopy') @@ -678,7 +678,8 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn end subroutine derived_tend !========================================================================================= -subroutine hydrostatic_pressure(nCells, nVertLevels, zz, zgrid, rho_zz, theta_m, q, pmiddry, pintdry,pmid) +subroutine hydrostatic_pressure(nCells, nVertLevels, zz, zgrid, rho_zz, theta_m, & + exner, q, pmiddry, pintdry,pmid) ! Compute dry hydrostatic pressure at layer interfaces and midpoints ! @@ -697,6 +698,7 @@ subroutine hydrostatic_pressure(nCells, nVertLevels, zz, zgrid, rho_zz, theta_m, real(r8), dimension(nVertLevels+1, nCells), intent(in) :: zgrid ! geometric heights of layer interfaces [m] real(r8), dimension(nVertLevels, nCells), intent(in) :: rho_zz ! dry density / zz [kg m^-3] real(r8), dimension(nVertLevels, nCells), intent(in) :: theta_m ! modified potential temperature + real(r8), dimension(nVertLevels, nCells), intent(in) :: exner ! Exner function real(r8), dimension(nVertLevels, nCells), intent(in) :: q ! water vapor dry mixing ratio real(r8), dimension(nVertLevels, nCells), intent(out):: pmiddry ! layer midpoint dry hydrostatic pressure [Pa] real(r8), dimension(nVertLevels+1, nCells), intent(out):: pintdry ! layer interface dry hydrostatic pressure [Pa] @@ -704,16 +706,21 @@ subroutine hydrostatic_pressure(nCells, nVertLevels, zz, zgrid, rho_zz, theta_m, ! Local variables integer :: iCell, k - real(r8), dimension(nVertLevels) :: dz ! Geometric layer thickness in column + real(r8), dimension(nVertLevels) :: dz ! Geometric layer thickness in column + real(r8), dimension(nVertLevels) :: dp,dpdry ! Pressure thickness +#ifdef phl_cam_development real(r8), dimension(nVertLevels+1) :: pint ! hydrostatic pressure at interface +#else + real(r8), dimension(nVertLevels+1,nCells) :: pint ! hydrostatic pressure at interface +#endif real(r8) :: pi, t - real(r8) :: pk,rhok,rhodryk,theta,thetavk,kap1,kap2 - + real(r8) :: pk,rhok,rhodryk,theta,thetavk,kap1,kap2,tvk,tk ! ! For each column, integrate downward from model top to compute dry hydrostatic pressure at layer ! midpoints and interfaces. The pressure averaged to layer midpoints should be consistent with ! the ideal gas law using the rho_zz and theta values prognosed by MPAS at layer midpoints. ! +#ifdef phl_cam_development kap1 = p0**(-rgas/cp) ! pre-compute constants kap2 = cp/cv ! pre-compute constants do iCell = 1, nCells @@ -748,6 +755,44 @@ subroutine hydrostatic_pressure(nCells, nVertLevels, zz, zgrid, rho_zz, theta_m, pmiddry(k,iCell) = 0.5_r8*(pintdry(k+1,iCell)+pintdry(k,iCell)) end do end do +#else + kap1 = p0**(-rgas/cp) ! pre-compute constants + kap2 = cp/cv ! pre-compute constants + do iCell = 1, nCells + dz(:) = zgrid(2:nVertLevels+1,iCell) - zgrid(1:nVertLevels,iCell) + do k = nVertLevels, 1, -1 + rhodryk = zz(k,iCell)* rho_zz(k,iCell) !full CAM physics density + rhok = (1.0_r8+q(k,iCell))*rhodryk !not used !dry CAM physics density + dp(k) = gravit*dz(k)*rhok + dpdry(k) = gravit*dz(k)*rhodryk!phl not used + end do + + k = nVertLevels + rhok = (1.0_r8+q(k,iCell))*zz(k,iCell) * rho_zz(k,iCell) !full CAM physics density + thetavk = theta_m(k,iCell)/ (1.0_r8 + q(k,iCell)) !convert modified theta to virtual theta + tvk = thetavk*exner(k,iCell) + pk = (rhok*rgas*thetavk*kap1)**kap2 !mid-level top pressure + ! + ! model top pressure consistently diagnosed using the assumption that the mid level + ! is at height z(nVertLevels-1)+0.5*dz + ! + pintdry(nVertLevels+1,iCell) = pk-0.5_r8*dz(nVertLevels)*rhok*gravity !hydrostatic + pint (nVertLevels+1,iCell) = pintdry(nVertLevels+1,iCell) + do k = nVertLevels, 1, -1 + ! + ! compute hydrostatic dry interface pressure so that (pintdry(k+1)-pintdry(k))/g is pseudo density + ! + thetavk = theta_m(k,iCell)/ (1.0_r8 + q(k,iCell)) !convert modified theta to virtual theta + tvk = thetavk*exner(k,iCell) + tk = tvk*(1.0_r8+q(k,iCell))/(1.0_r8+Rv_over_Rd*q(k,iCell)) + pint (k,iCell) = pint (k+1,iCell)+dp(k) + pintdry(k,iCell) = pintdry(k+1,iCell)+dpdry(k) + pmid(k,iCell) = dp(k) *rgas*tvk/(gravit*dz(k)) + pmiddry(k,iCell) = dpdry(k)*rgas*tk /(gravit*dz(k)) + end do + end do +#endif + end subroutine hydrostatic_pressure subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, theta_m, q, ux,uy,outfld_name_suffix,te_budgets,budgets_cnt,budgets_subcycle_cnt) From f9350acebba3b548075e49a3e486d23802b52f07 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 31 Oct 2022 16:23:48 -0600 Subject: [PATCH 030/140] further improvements in logfile energy diagnostics --- src/dynamics/mpas/dycore_budget.F90 | 224 ++++++++++++++++------------ src/dynamics/se/dycore_budget.F90 | 38 ++--- 2 files changed, 144 insertions(+), 118 deletions(-) diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index 97e3e86d49..c60a98811f 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -1,9 +1,9 @@ module dycore_budget - +use shr_kind_mod, only: r8=>shr_kind_r8 implicit none public :: print_budget - +real(r8), parameter :: eps = 1.0E-9_r8 !========================================================================================= contains @@ -12,10 +12,9 @@ module dycore_budget subroutine print_budget() use budgets, only: budget_get_global - use shr_kind_mod, only: r8=>shr_kind_r8 use spmd_utils, only: masterproc use cam_logfile, only: iulog - + use cam_abortutils, only: endrun ! Local variables integer :: b_ind,s_ind,is1,is2 logical :: budget_outfld @@ -27,130 +26,157 @@ subroutine print_budget() integer :: i character(len=*), parameter :: subname = 'check_energy:print_budgets' - real(r8) :: ph_param,ph_EFIX,ph_DMEA,ph_param_and_efix,ph_phys_total - real(r8) :: dy_param,dy_EFIX,dy_DMEA,dy_param_and_efix,dy_phys_total + real(r8) :: ph_param,ph_EFIX,ph_dmea,ph_param_and_efix,ph_phys_total + real(r8) :: dy_param,dy_EFIX,dy_dmea,dy_param_and_efix,dy_phys_total real(r8) :: mpas_param,mpas_dmea,mpas_phys_total, dycore, err, param, pefix, pdmea, param_mpas, phys_total + real(r8) :: diff integer :: m_cnst !-------------------------------------------------------------------------------------- if (masterproc) then call budget_get_global('phAP-phBP',1,ph_param) call budget_get_global('phBP-phBF',1,ph_EFIX) - call budget_get_global('phAM-phAP',1,ph_DMEA) + call budget_get_global('phAM-phAP',1,ph_dmea) call budget_get_global('phAP-phBF',1,ph_param_and_efix) call budget_get_global('phAM-phBF',1,ph_phys_total) call budget_get_global('dyAP-dyBP',1,dy_param) call budget_get_global('dyBP-dyBF',1,dy_EFIX) - call budget_get_global('dyAM-dyAP',1,dy_DMEA) + call budget_get_global('dyAM-dyAP',1,dy_dmea) call budget_get_global('dyAP-dyBF',1,dy_param_and_efix) call budget_get_global('dyAM-dyBF',1,dy_phys_total) call budget_get_global('dAP-dBF',1,mpas_param) call budget_get_global('dAM-dAP',1,mpas_dmea) call budget_get_global('dAM-dBF',1,mpas_phys_total) - - - write(iulog,*)" " - write(iulog,*)"=======================================================" - write(iulog,*)"| |" - write(iulog,*)"| ANALYSIS OF ENERGY DIAGNOSTICS IN PHYSICS |" - write(iulog,*)"| |" - write(iulog,*)"=======================================================" - write(iulog,*)" " - write(iulog,*)"-------------------------------------------------------" - write(iulog,*)" CAM physics energy increments (in pressure coordinate)" - write(iulog,*)"-------------------------------------------------------" - write(iulog,*)" " - write(iulog,*)"dE/dt params no efix (param) (pAP-pBP) ",ph_param," W/M^2" - write(iulog,*)"dE/dt energy fixer (efix) (pBP-pBF) ",ph_EFIX," W/M^2" - write(iulog,*)"NOTE: energy fixer uses energy formula consistent with dycore (so this is not p-based for MPAS) " - write(iulog,*)"dE/dt params + efix (pAP-pBF) ",ph_param_and_efix," W/M^2" - write(iulog,*)" " - write(iulog,*)"dE/dt dry mass adj (pwork) (pAM-pAP) ",ph_DMEA," W/M^2" - write(iulog,*)"dE/dt physics total (phys) (pAM-pBF) ",ph_phys_total," W/M^2" - write(iulog,*)" " - dycore = -ph_EFIX-ph_DMEA - write(iulog,*)"Dycore TE dissipation estimated from physics in pressure coordinate ",dycore," W/M^2" - write(iulog,*)"(assuming no physics-dynamics coupling errors) " + write(iulog,*)" " - write(iulog,*)"---------------------------------------------------------------------------" - write(iulog,*)" CAM physics dycore consistent energy increments (for MPAS in z coordinate)" - write(iulog,*)"---------------------------------------------------------------------------" + write(iulog,*)" Total energy diagnostics introduced in Lauritzen and Williamson (2019)" + write(iulog,*)" (DOI:10.1029/2018MS001549)" + write(iulog,*)" " + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)"Physics time loop" + write(iulog,*)"------------------------------------------------------------" write(iulog,*)" " - write(iulog,*)"dE/dt params no efix (param) (dyAP-dyBP) ",dy_param," W/M^2" - write(iulog,*)"dE/dt energy fixer (efix) (dyBP-dyBF) ",dy_EFIX," W/M^2" - write(iulog,*)"dE/dt parameterizations + efix (dyAP-dyBF) ",dy_param_and_efix," W/M^2" + write(iulog,*)"phBF: state passed to parameterizations, before energy fixer" + write(iulog,*)"phBP: after energy fixer, before parameterizations" + write(iulog,*)"phAP: after last phys_update in parameterizations and state " + write(iulog,*)" saved for energy fixer" + write(iulog,*)"phAM: after dry mass correction" + write(iulog,*)"history files saved off here" write(iulog,*)" " - write(iulog,*)"dE/dt dry mass adjustment (pwork) (dyAM-dyAP) ",dy_DMEA," W/M^2" - write(iulog,*)"dE/dt physics total (phys) (dyAM-dyBF) ",dy_phys_total," W/M^2" + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" CAM physics energy tendencies (using pressure coordinate) " + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" " + write(iulog,'(a40,F6.2,a6)')"dE/dt energy fixer (phBP-phBF) ",ph_EFIX," W/M^2" + write(iulog,'(a40,F6.2,a6)')"dE/dt all parameterizations (phAP-phBP) ",ph_param," W/M^2" + write(iulog,'(a40,F6.2,a6)')"dE/dt dry mass adjustment (phAM-phAP) ",ph_dmea," W/M^2" + write(iulog,'(a40,F6.2,a6)')"dE/dt physics total (phAM-phBF) ",ph_phys_total," W/M^2" + write(iulog,*)" " write(iulog,*)" " - dycore = -dy_EFIX-dy_DMEA + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" CAM physics energy tendencies (using z coordinate) " + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" " + write(iulog,'(a40,F6.2,a6)')"dE/dt energy fixer (dyBP-dyBF) ",dy_EFIX," W/M^2" + write(iulog,'(a40,F6.2,a6)')"dE/dt all parameterizations (dyAP-dyBP) ",dy_param," W/M^2" + write(iulog,'(a40,F6.2,a6)')"dE/dt dry mass adjustment (dyAM-dyAP) ",dy_dmea," W/M^2" + write(iulog,'(a40,F6.2,a6)')"dE/dt physics total (dyAM-dyBF) ",dy_phys_total," W/M^2" + write(iulog,*)" " + dycore = -dy_EFIX-dy_dmea write(iulog,*)"Dycore TE dissipation estimated from physics with dycore energy ",dycore," W/M^2" write(iulog,*)"(assuming no physics-dynamics coupling errors; -efix-dme_adjust) " write(iulog,*)" " - - - write(iulog,*)"==========================================================================" - write(iulog,*)"| |" - write(iulog,*)"| ANALYSIS OF ENERGY DIAGNOSTICS IN PHYSICS dp_coupling (MPAS) |" - write(iulog,*)"| |" - write(iulog,*)"==========================================================================" + + write(iulog,*) " " + write(iulog,*) "-dE/dt energy fixer = dE/dt dry mass adjustment +" + write(iulog,*) " dE/dt dycore +" + write(iulog,*) " dE/dt physics-dynamics coupling errors +" + write(iulog,*) " dE/dt energy formula differences " + write(iulog,*) " " + write(iulog,*) "(equation 23 in Lauritzen and Williamson (2019))" + write(iulog,*) " " +! dycore = -ph_EFIX-ph_dmea +! dycore = -ph_EFIX-previous_dEdt_dry_mass_adjust +! write(iulog,*) "" +! write(iulog,*) "Dycore TE dissipation estimated from physics in pressure coordinate:" +! write(iulog,*) "(note to avoid sampling error we need dE/dt from previous time-step)" +! write(iulog,*) "" +! write(iulog,*) "dE/dt adiabatic dycore estimated from physics (t=n-1) = " +! write(iulog,'(a58,F6.2,a6)') "-dE/dt energy fixer(t=n)-dE/dt dry-mass adjust(t=n-1) = ",dycore," W/M^2" +! write(iulog,*) "" +! write(iulog,'(a58,F6.2,a6)') "dE/dt adiabatic dycore computed in dycore (t=n-1) = ",& +! previous_dEdt_adiabatic_dycore," W/M^2" +! write(iulog,'(a58,F6.2,a6)') "dE/dt dry-mass adjust (t=n-1) = ",& +! previous_dEdt_dry_mass_adjust," W/M^2" +! write(iulog,*) "" +! if (abs(previous_dEdt_adiabatic_dycore)>eps) then +! diff = abs((dycore-previous_dEdt_adiabatic_dycore)/previous_dEdt_adiabatic_dycore) +! if (diff>eps) then +! write(iulog,*) "energy budget not closed: previous_dEdt_adiabatic_dycore <> dycore" +! write(iulog,*) "normalized difference is:",diff +! call endrun('dycore_budget module: physics energy budget consistency error 2') +! end if +! end if + write(iulog,*)" " - write(iulog,*)" " - write(iulog,*)"dE/dt parameterizations + efix (total physics increment) in MPAS " - write(iulog,*)"when adding as one increment - no dribbling (dAP-dBF) ",mpas_param," W/M^2" - err = ph_param_and_efix-mpas_param - write(iulog,*)"compare to same tendency in physics (MUST BE SMALL!) ",err," W/M^2" + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" MPAS energy tendencies " + write(iulog,*)"------------------------------------------------------------" write(iulog,*)" " - write(iulog,*)"dE/dt dry mass adjustment in MPAS (dAM-dAP) ",mpas_dmea," W/M^2" - err = dy_DMEA-mpas_dmea - write(iulog,*)"compare to same tendency in physics (MUST BE SMALL!) ",err," W/M^2" - - write(iulog,*)"==========================================================================" - write(iulog,*)"| |" - write(iulog,*)"| ANALYSIS OF MASS diagnostics in (MPAS) |" - write(iulog,*)"| |" - write(iulog,*)"==========================================================================" - + write(iulog,*) "dE/dt all parameterizations+ " + write(iulog,'(a42,F6.2,a6)')"dE/dt energy fixer (dAP-dBF) ",mpas_param," W/M^2" + write(iulog,'(a42,F6.2,a6)')"dE/dt dry mass adjustment (dAM-dAP) ",mpas_dmea," W/M^2" + write(iulog,*)" " + write(iulog,*)"Are these values consistent with CAM physics dE/dt's?" + write(iulog,*)" " + diff = abs_diff(mpas_param,dy_param+dy_EFIX) + write(iulog,*)"Physics tendency: ((dAP-dBF)-(dyAP-dyBF))/(dyAP-dyBF) =",diff + if (abs(diff)>eps) then + call endrun('dycore_budget module: physics tendency in dynamics error') + endif + diff = abs_diff(mpas_dmea,dy_dmea) + write(iulog,*)"Dry-mass adj. : ((dAM-dAP)-(dyAM-dyAP))/(dyAM-dyAP) =",diff + if (abs(diff)>eps) then + call endrun('dycore_budget module: dry-mass adjustment in dynamics error') + endif + write(iulog,*)" " do m_cnst=4,6 - - if (m_cnst.eq.4) then - - write(iulog,*)"Water vapor budget" - write(iulog,*)"------------------" - end if - if (m_cnst.eq.5) then - write(iulog,*)"Cloud liquid budget" - write(iulog,*)"------------------" - end if - if (m_cnst.eq.6) then - write(iulog,*)"Cloud ice budget" - write(iulog,*)"------------------" - end if - write(iulog,*)"" - - call budget_get_global('phAP-phBP',m_cnst,param) - call budget_get_global('phBP-phBF',m_cnst,pEFIX) - call budget_get_global('phAM-phAP',m_cnst,pDMEA) - - call budget_get_global('dAM-dBF',m_cnst,param_mpas) - call budget_get_global('phAM-phBF',m_cnst,phys_total) - - write(iulog,*)"dMASS/dt energy fixer (pBP-pBF) ",pEFIX," Pa" - write(iulog,*)"dMASS/dt parameterizations (pAP-pBP) ",param," Pa" - write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",pDMEA," Pa" - write(iulog,*)"" - write(iulog,*)"" - write(iulog,*)"dMass/dt physics total in MPAS (dAM-dBF) ",param_mpas," Pa" - err = (param_mpas-param) - write(iulog,*)"Is mass budget closed? (pAP-pBP)-(dAM-dBF) ",err - write(iulog,*)"---------------------------------------------------------------------------------------------------" - write(iulog,*)" " + write(iulog,*)"------------------------------------------------------------" + if (m_cnst.eq.4) write(iulog,*)"Water vapor mass budget" + if (m_cnst.eq.5) write(iulog,*)"Cloud liquid mass budget" + if (m_cnst.eq.6) write(iulog,*)"Cloud ice mass budget" + write(iulog,*)"------------------------------------------------------------" + call budget_get_global('phAP-phBP',m_cnst,param) + call budget_get_global('phBP-phBF',m_cnst,pEFIX) + call budget_get_global('phAM-phAP',m_cnst,pdmea) + + call budget_get_global('dAM-dBF',m_cnst,param_mpas) + call budget_get_global('phAM-phBF',m_cnst,phys_total) + + write(iulog,*)"dMASS/dt energy fixer (pBP-pBF) ",pEFIX," Pa" + write(iulog,*)"dMASS/dt parameterizations (pAP-pBP) ",param," Pa" + write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",pdmea," Pa" + write(iulog,*)"" + write(iulog,*)"" + write(iulog,*)"dMass/dt physics total in MPAS (dAM-dBF) ",param_mpas," Pa" + err = (param_mpas-param) + write(iulog,*)"Is mass budget closed? (pAP-pBP)-(dAM-dBF) ",err + write(iulog,*)"---------------------------------------------------------------------------------------------------" + write(iulog,*)" " end do + end if + end subroutine print_budget + !========================================================================================= + function abs_diff(a,b) + real(r8), intent(in) :: a,b + real(r8) :: abs_diff + if (abs(b)>eps) then + abs_diff = abs((b-a)/b) + else + abs_diff = abs(b-a) end if -end subroutine print_budget -!========================================================================================= - +end function abs_diff end module dycore_budget diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index bda2c428a4..c370f58f16 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -120,10 +120,10 @@ subroutine print_budget() write(iulog,*)" CAM physics energy tendencies (using pressure coordinate)" write(iulog,*)"------------------------------------------------------------" write(iulog,*)" " - write(iulog,'(a40,F5.2,a6)')"dE/dt energy fixer (phBP-pBF) ",ph_EFIX," W/M^2" - write(iulog,'(a40,F5.2,a6)')"dE/dt all parameterizations (phAP-pBP) ",ph_param," W/M^2" - write(iulog,'(a40,F5.2,a6)')"dE/dt dry mass adjustment (pAM-pAP) ",ph_DMEA," W/M^2" - write(iulog,'(a40,F5.2,a6)')"dE/dt physics total (pAM-pBF) ",ph_phys_total," W/M^2" + write(iulog,'(a40,F6.2,a6)')"dE/dt energy fixer (phBP-phBF) ",ph_EFIX," W/M^2" + write(iulog,'(a40,F6.2,a6)')"dE/dt all parameterizations (phAP-phBP) ",ph_param," W/M^2" + write(iulog,'(a40,F6.2,a6)')"dE/dt dry mass adjustment (phAM-phAP) ",ph_DMEA," W/M^2" + write(iulog,'(a40,F6.2,a6)')"dE/dt physics total (phAM-phBF) ",ph_phys_total," W/M^2" write(iulog,*)" " write(iulog,*) " " write(iulog,*) "-dE/dt energy fixer = dE/dt dry mass adjustment +" @@ -140,11 +140,11 @@ subroutine print_budget() write(iulog,*) "(note to avoid sampling error we need dE/dt from previous time-step)" write(iulog,*) "" write(iulog,*) "dE/dt adiabatic dycore estimated from physics (t=n-1) = " - write(iulog,'(a58,F5.2,a6)') "-dE/dt energy fixer(t=n)-dE/dt dry-mass adjust(t=n-1) = ",dycore," W/M^2" + write(iulog,'(a58,F6.2,a6)') "-dE/dt energy fixer(t=n)-dE/dt dry-mass adjust(t=n-1) = ",dycore," W/M^2" write(iulog,*) "" - write(iulog,'(a58,F5.2,a6)') "dE/dt adiabatic dycore computed in dycore (t=n-1) = ",& + write(iulog,'(a58,F6.2,a6)') "dE/dt adiabatic dycore computed in dycore (t=n-1) = ",& previous_dEdt_adiabatic_dycore," W/M^2" - write(iulog,'(a58,F5.2,a6)') "dE/dt dry-mass adjust (t=n-1) = ",& + write(iulog,'(a58,F6.2,a6)') "dE/dt dry-mass adjust (t=n-1) = ",& previous_dEdt_dry_mass_adjust," W/M^2" write(iulog,*) "" if (abs(previous_dEdt_adiabatic_dycore)>eps) then @@ -159,10 +159,10 @@ subroutine print_budget() write(iulog,*)" Physics dynamics coupling errors" write(iulog,*)"------------------------------------------------------------" write(iulog,*)" " - write(iulog,'(a46,F5.2,a6)')"dE/dt physics tendency in dynamics (dBD-dAF) ",rate_of_change_physics," W/M^2" - write(iulog,'(a46,F5.2,a6)')"dE/dt physics tendency in physics (pAM-pBF) ",ph_phys_total," W/M^2" + write(iulog,'(a46,F6.2,a6)')"dE/dt physics tendency in dynamics (dBD-dAF) ",rate_of_change_physics," W/M^2" + write(iulog,'(a46,F6.2,a6)')"dE/dt physics tendency in physics (pAM-pBF) ",ph_phys_total," W/M^2" write(iulog,*)" " - write(iulog,'(a46,F5.2,a6)')"dE/dt physics-dynamics coupling errors ",ph_phys_total-rate_of_change_physics," W/M^2" + write(iulog,'(a46,F6.2,a6)')"dE/dt physics-dynamics coupling errors ",ph_phys_total-rate_of_change_physics," W/M^2" write(iulog,*)" " write(iulog,*)"------------------------------------------------------------" @@ -170,23 +170,23 @@ subroutine print_budget() write(iulog,*)"------------------------------------------------------------" write(iulog,*)" " ! write(iulog,*)"dE/dt dyn total (dycore+phys tendency (dBF-dED) ",dyn_total," W/M^2" - write(iulog,'(a46,F5.2,a6)')"dE/dt adiabatic dynamics ",dADIA," W/M^2" + write(iulog,'(a46,F6.2,a6)')"dE/dt adiabatic dynamics ",dADIA," W/M^2" write(iulog,*)" " write(iulog,*)"Adiabatic dynamics can be divided into quasi-horizontal and vertical remapping: " write(iulog,*)" " - write(iulog,'(a40,F5.2,a6)') "dE/dt 2D dynamics (dAD-dBD) ",rate_of_change_2D_dyn," W/M^2" - write(iulog,'(a40,F5.2,a6)') "dE/dt vertical remapping (dAR-dAD) ",rate_of_change_vertical_remapping," W/M^2" + write(iulog,'(a40,F6.2,a6)') "dE/dt 2D dynamics (dAD-dBD) ",rate_of_change_2D_dyn," W/M^2" + write(iulog,'(a40,F6.2,a6)') "dE/dt vertical remapping (dAR-dAD) ",rate_of_change_vertical_remapping," W/M^2" write(iulog,*) " " write(iulog,*) "Breakdown of 2D dynamics:" write(iulog,*) " " - write(iulog,'(a45,F5.2,a6)')" dE/dt hypervis del4 (dCH-dBH) ",diffusion_del4," W/M^2" - write(iulog,'(a45,F5.2,a6)')" dE/dt hypervis frictional heating (dAH-dCH) ",diffusion_fric," W/M^2" - write(iulog,'(a45,F5.2,a6)')" dE/dt hypervis del4 total (dAH-dBH) ",diffusion_del4_tot," W/M^2" - write(iulog,'(a45,F5.2,a6)')" dE/dt hypervis sponge total (dAS-dBS) ",diffusion_sponge," W/M^2" - write(iulog,'(a45,F5.2,a6)')" dE/dt explicit diffusion total ",diffusion_total," W/M^2" + write(iulog,'(a45,F6.2,a6)')" dE/dt hypervis del4 (dCH-dBH) ",diffusion_del4," W/M^2" + write(iulog,'(a45,F6.2,a6)')" dE/dt hypervis frictional heating (dAH-dCH) ",diffusion_fric," W/M^2" + write(iulog,'(a45,F6.2,a6)')" dE/dt hypervis del4 total (dAH-dBH) ",diffusion_del4_tot," W/M^2" + write(iulog,'(a45,F6.2,a6)')" dE/dt hypervis sponge total (dAS-dBS) ",diffusion_sponge," W/M^2" + write(iulog,'(a45,F6.2,a6)')" dE/dt explicit diffusion total ",diffusion_total," W/M^2" twoDresidual = rate_of_change_2D_dyn-diffusion_total - write(iulog,'(a45,F5.2,a6)')" dE/dt residual (time-truncation errors) ",twoDresidual," W/M^2" + write(iulog,'(a45,F6.2,a6)')" dE/dt residual (time-truncation errors) ",twoDresidual," W/M^2" write(iulog,*)" " write(iulog,*)" " write(iulog,*)"------------------------------------------------------------" From 4145dcae1c9227dc438d7073d22eaa49bd0c321f Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 31 Oct 2022 17:27:32 -0600 Subject: [PATCH 031/140] remove endrun while developing --- src/dynamics/mpas/dycore_budget.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index c60a98811f..a70329f89f 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -139,7 +139,8 @@ subroutine print_budget() diff = abs_diff(mpas_dmea,dy_dmea) write(iulog,*)"Dry-mass adj. : ((dAM-dAP)-(dyAM-dyAP))/(dyAM-dyAP) =",diff if (abs(diff)>eps) then - call endrun('dycore_budget module: dry-mass adjustment in dynamics error') + write(iulog,*) "error: dry-mass adjustment in dynamics error" +! call endrun('dycore_budget module: dry-mass adjustment in dynamics error') endif write(iulog,*)" " do m_cnst=4,6 From 8f9af29b7a6ffb6bc69c3f9620909828f8f1e1cc Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Tue, 1 Nov 2022 11:08:06 -0600 Subject: [PATCH 032/140] TFIX output should be turned on for all dycores using energy fixer --- src/physics/cam/cam_diagnostics.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/physics/cam/cam_diagnostics.F90 b/src/physics/cam/cam_diagnostics.F90 index f0131dab0e..1c21702212 100644 --- a/src/physics/cam/cam_diagnostics.F90 +++ b/src/physics/cam/cam_diagnostics.F90 @@ -242,7 +242,7 @@ subroutine diag_init_dry(pbuf2d) call register_vector_field('UAP','VAP') call addfld (apcnst(1), (/ 'lev' /), 'A','kg/kg', trim(cnst_longname(1))//' (after physics)') - if ( dycore_is('LR') .or. dycore_is('SE') .or. dycore_is('FV3') ) then + if (.not.dycore_is('EUL')) then call addfld ('TFIX', horiz_only, 'A', 'K/s', 'T fixer (T equivalent of Energy correction)') end if call addfld ('TTEND_TOT', (/ 'lev' /), 'A', 'K/s', 'Total temperature tendency') @@ -386,7 +386,7 @@ subroutine diag_init_dry(pbuf2d) call add_default ('UAP ' , history_budget_histfile_num, ' ') call add_default ('VAP ' , history_budget_histfile_num, ' ') call add_default (apcnst(1) , history_budget_histfile_num, ' ') - if ( dycore_is('LR') .or. dycore_is('SE') .or. dycore_is('FV3') ) then + if (.not.dycore_is('EUL')) then call add_default ('TFIX ' , history_budget_histfile_num, ' ') end if end if @@ -2104,7 +2104,7 @@ subroutine diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt) ! Total physics tendency for Temperature ! (remove global fixer tendency from total for FV and SE dycores) - if (dycore_is('LR') .or. dycore_is('SE') .or. dycore_is('FV3') ) then + if (.not.dycore_is('EUL')) then call check_energy_get_integrals( heat_glob_out=heat_glob ) ftem2(:ncol) = heat_glob/cpair call outfld('TFIX', ftem2, pcols, lchnk ) From eaba6466644e434fad144e9493fde2294fabfd01 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Tue, 1 Nov 2022 11:54:08 -0600 Subject: [PATCH 033/140] remove FV dme adjust diagnostics --- src/physics/cam/cam_diagnostics.F90 | 64 ++--------------------------- src/physics/cam/constituents.F90 | 2 - src/physics/cam/physpkg.F90 | 14 +------ src/physics/cam_dev/physpkg.F90 | 11 +---- 4 files changed, 6 insertions(+), 85 deletions(-) diff --git a/src/physics/cam/cam_diagnostics.F90 b/src/physics/cam/cam_diagnostics.F90 index 1c21702212..94f2192737 100644 --- a/src/physics/cam/cam_diagnostics.F90 +++ b/src/physics/cam/cam_diagnostics.F90 @@ -14,7 +14,7 @@ module cam_diagnostics use cam_history, only: outfld, write_inithist, hist_fld_active, inithist_all use constituents, only: pcnst, cnst_name, cnst_longname, cnst_cam_outfld -use constituents, only: ptendnam, dmetendnam, apcnst, bpcnst, cnst_get_ind +use constituents, only: ptendnam, apcnst, bpcnst, cnst_get_ind use dycore, only: dycore_is use phys_control, only: phys_getopts use wv_saturation, only: qsat, qsat_water, svp_ice_vect @@ -547,18 +547,6 @@ subroutine diag_init_moist(pbuf2d) if (ixcldice > 0) then call addfld (ptendnam(ixcldice),(/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name(ixcldice))//' total physics tendency ') end if - if ( dycore_is('LR') .or. dycore_is('FV3') )then - call addfld (dmetendnam( 1),(/ 'lev' /), 'A','kg/kg/s', & - trim(cnst_name( 1))//' dme adjustment tendency (FV) ') - if (ixcldliq > 0) then - call addfld (dmetendnam(ixcldliq),(/ 'lev' /), 'A','kg/kg/s', & - trim(cnst_name(ixcldliq))//' dme adjustment tendency (FV) ') - end if - if (ixcldice > 0) then - call addfld (dmetendnam(ixcldice),(/ 'lev' /), 'A','kg/kg/s', & - trim(cnst_name(ixcldice))//' dme adjustment tendency (FV) ') - end if - end if ! outfld calls in diag_physvar_ic @@ -649,15 +637,6 @@ subroutine diag_init_moist(pbuf2d) if (ixcldice > 0) then call add_default (ptendnam(ixcldice), history_budget_histfile_num, ' ') end if - if ( dycore_is('LR') .or. dycore_is('FV3') )then - call add_default(dmetendnam(1) , history_budget_histfile_num, ' ') - if (ixcldliq > 0) then - call add_default(dmetendnam(ixcldliq), history_budget_histfile_num, ' ') - end if - if (ixcldice > 0) then - call add_default(dmetendnam(ixcldice), history_budget_histfile_num, ' ') - end if - end if if( history_budget_histfile_num > 1 ) then call add_default ('DTCOND ' , history_budget_histfile_num, ' ') end if @@ -2144,7 +2123,7 @@ end subroutine diag_phys_tend_writeout_dry !####################################################################### subroutine diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, & - tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini) + qini, cldliqini, cldiceini) !--------------------------------------------------------------- ! @@ -2159,9 +2138,6 @@ subroutine diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, & type(physics_buffer_desc), pointer :: pbuf(:) type(physics_tend ), intent(in) :: tend real(r8), intent(in) :: ztodt ! physics timestep - real(r8), intent(inout) :: tmp_q (pcols,pver) ! As input, holds pre-adjusted tracers (FV) - real(r8), intent(inout) :: tmp_cldliq(pcols,pver) ! As input, holds pre-adjusted tracers (FV) - real(r8), intent(inout) :: tmp_cldice(pcols,pver) ! As input, holds pre-adjusted tracers (FV) real(r8), intent(in) :: qini (pcols,pver) ! tracer fields at beginning of physics real(r8), intent(in) :: cldliqini (pcols,pver) ! tracer fields at beginning of physics real(r8), intent(in) :: cldiceini (pcols,pver) ! tracer fields at beginning of physics @@ -2194,35 +2170,6 @@ subroutine diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, & end if end if - ! Tendency for dry mass adjustment of q (FV only) - - if (dycore_is('LR') .or. dycore_is('FV3') ) then - tmp_q (:ncol,:pver) = (state%q(:ncol,:pver, 1) - tmp_q (:ncol,:pver))*rtdt - if (ixcldliq > 0) then - tmp_cldliq(:ncol,:pver) = (state%q(:ncol,:pver,ixcldliq) - tmp_cldliq(:ncol,:pver))*rtdt - else - tmp_cldliq(:ncol,:pver) = 0.0_r8 - end if - if (ixcldice > 0) then - tmp_cldice(:ncol,:pver) = (state%q(:ncol,:pver,ixcldice) - tmp_cldice(:ncol,:pver))*rtdt - else - tmp_cldice(:ncol,:pver) = 0.0_r8 - end if - if ( cnst_cam_outfld( 1) ) then - call outfld (dmetendnam( 1), tmp_q , pcols, lchnk) - end if - if (ixcldliq > 0) then - if ( cnst_cam_outfld(ixcldliq) ) then - call outfld (dmetendnam(ixcldliq), tmp_cldliq, pcols, lchnk) - end if - end if - if (ixcldice > 0) then - if ( cnst_cam_outfld(ixcldice) ) then - call outfld (dmetendnam(ixcldice), tmp_cldice, pcols, lchnk) - end if - end if - end if - ! Total physics tendency for moisture and other tracers if ( cnst_cam_outfld( 1) ) then @@ -2247,7 +2194,7 @@ end subroutine diag_phys_tend_writeout_moist !####################################################################### subroutine diag_phys_tend_writeout(state, pbuf, tend, ztodt, & - tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini) + qini, cldliqini, cldiceini) !--------------------------------------------------------------- ! @@ -2262,9 +2209,6 @@ subroutine diag_phys_tend_writeout(state, pbuf, tend, ztodt, & type(physics_buffer_desc), pointer :: pbuf(:) type(physics_tend ), intent(in) :: tend real(r8), intent(in) :: ztodt ! physics timestep - real(r8) , intent(inout) :: tmp_q (pcols,pver) ! As input, holds pre-adjusted tracers (FV) - real(r8), intent(inout) :: tmp_cldliq(pcols,pver) ! As input, holds pre-adjusted tracers (FV) - real(r8), intent(inout) :: tmp_cldice(pcols,pver) ! As input, holds pre-adjusted tracers (FV) real(r8), intent(in) :: qini (pcols,pver) ! tracer fields at beginning of physics real(r8), intent(in) :: cldliqini (pcols,pver) ! tracer fields at beginning of physics real(r8), intent(in) :: cldiceini (pcols,pver) ! tracer fields at beginning of physics @@ -2274,7 +2218,7 @@ subroutine diag_phys_tend_writeout(state, pbuf, tend, ztodt, & call diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt) if (moist_physics) then call diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, & - tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini) + qini, cldliqini, cldiceini) end if end subroutine diag_phys_tend_writeout diff --git a/src/physics/cam/constituents.F90 b/src/physics/cam/constituents.F90 index aa2c67400c..49a3fab61d 100644 --- a/src/physics/cam/constituents.F90 +++ b/src/physics/cam/constituents.F90 @@ -72,7 +72,6 @@ module constituents character(len=16), public :: fixcnam (pcnst) ! names of species slt fixer tendencies character(len=16), public :: tendnam (pcnst) ! names of total tendencies of species character(len=16), public :: ptendnam (pcnst) ! names of total physics tendencies of species -character(len=16), public :: dmetendnam(pcnst) ! names of dme adjusted tracers (FV) character(len=16), public :: sflxnam (pcnst) ! names of surface fluxes of species character(len=16), public :: tottnam (pcnst) ! names for horz + vert + fixer tendencies @@ -497,7 +496,6 @@ subroutine cnst_chk_dim fixcnam (m) = 'DF'//cnst_name(m) tendnam (m) = 'TE'//cnst_name(m) ptendnam (m) = 'PTE'//cnst_name(m) - dmetendnam(m) = 'DME'//cnst_name(m) tottnam (m) = 'TA'//cnst_name(m) sflxnam(m) = 'SF'//cnst_name(m) end do diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index c3a3e36efe..f31e74110a 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -1464,9 +1464,6 @@ subroutine tphysac (ztodt, cam_in, & real(r8) obklen(pcols) ! Obukhov length real(r8) :: fh2o(pcols) ! h2o flux to balance source from methane chemistry real(r8) :: flx_heat(pcols) ! Heat flux for check_energy_chng. - real(r8) :: tmp_q (pcols,pver) ! tmp space - real(r8) :: tmp_cldliq(pcols,pver) ! tmp space - real(r8) :: tmp_cldice(pcols,pver) ! tmp space real(r8) :: tmp_trac (pcols,pver,pcnst) ! tmp space real(r8) :: tmp_pdel (pcols,pver) ! tmp space real(r8) :: tmp_ps (pcols) ! tmp space @@ -1911,14 +1908,6 @@ subroutine tphysac (ztodt, cam_in, & ! assumes moist. This is done in p_d_coupling for other dynamics. Bundy, Feb 2004. if (moist_mixing_ratio_dycore) call set_dry_to_wet(state) ! Physics had dry, dynamics wants moist - ! Scale dry mass and energy (does nothing if dycore is EUL or SLD) - call cnst_get_ind('CLDLIQ', ixcldliq) - call cnst_get_ind('CLDICE', ixcldice) - - tmp_q (:ncol,:pver) = state%q(:ncol,:pver,1) - tmp_cldliq(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) - tmp_cldice(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) - ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. ! So, save off tracers if (.not.moist_mixing_ratio_dycore.and.& @@ -1986,8 +1975,7 @@ subroutine tphysac (ztodt, cam_in, & endif endif - call diag_phys_tend_writeout (state, pbuf, tend, ztodt, tmp_q, tmp_cldliq, tmp_cldice, & - qini, cldliqini, cldiceini) + call diag_phys_tend_writeout (state, pbuf, tend, ztodt, qini, cldliqini, cldiceini) call clybry_fam_set( ncol, lchnk, map2chm, state%q, pbuf ) diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index 536060b933..b5b433d77f 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -1476,9 +1476,6 @@ subroutine tphysac (ztodt, cam_in, & real(r8) obklen(pcols) ! Obukhov length real(r8) :: fh2o(pcols) ! h2o flux to balance source from methane chemistry real(r8) :: flx_heat(pcols) ! Heat flux for check_energy_chng. - real(r8) :: tmp_q (pcols,pver) ! tmp space - real(r8) :: tmp_cldliq(pcols,pver) ! tmp space - real(r8) :: tmp_cldice(pcols,pver) ! tmp space real(r8) :: tmp_trac (pcols,pver,pcnst) ! tmp space real(r8) :: tmp_pdel (pcols,pver) ! tmp space real(r8) :: tmp_ps (pcols) ! tmp space @@ -2328,11 +2325,6 @@ subroutine tphysac (ztodt, cam_in, & moist_mixing_ratio_dycore = dycore_is('LR').or. dycore_is('FV3') if (moist_mixing_ratio_dycore) call set_dry_to_wet(state) ! Physics had dry, dynamics wants moist - ! Scale dry mass and energy (does nothing if dycore is EUL or SLD) - tmp_q (:ncol,:pver) = state%q(:ncol,:pver,ixq) - tmp_cldliq(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) - tmp_cldice(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) - ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. ! So, save off tracers if (.not.moist_mixing_ratio_dycore.and.& @@ -2400,8 +2392,7 @@ subroutine tphysac (ztodt, cam_in, & endif endif - call diag_phys_tend_writeout (state, pbuf, tend, ztodt, tmp_q, tmp_cldliq, tmp_cldice, & - qini, cldliqini, cldiceini) + call diag_phys_tend_writeout (state, pbuf, tend, ztodt, qini, cldliqini, cldiceini) call clybry_fam_set( ncol, lchnk, map2chm, state%q, pbuf ) From a1f2fb56faca3bdccbff359e7cd8c319feec6893 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Tue, 1 Nov 2022 13:08:09 -0600 Subject: [PATCH 034/140] renaming for incl. all liq and all ice in one variable --- src/physics/cam/physpkg.F90 | 30 +++++++++++++++--------------- src/physics/cam_dev/physpkg.F90 | 30 +++++++++++++++--------------- 2 files changed, 30 insertions(+), 30 deletions(-) diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index f31e74110a..b0d622c6f3 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -72,8 +72,8 @@ module physpkg integer :: sgh30_idx = 0 integer :: qini_idx = 0 - integer :: cldliqini_idx = 0 - integer :: cldiceini_idx = 0 + integer :: liqini_idx = 0 + integer :: iceini_idx = 0 integer :: prec_str_idx = 0 integer :: snow_str_idx = 0 @@ -238,8 +238,8 @@ subroutine phys_register ! Fields for physics package diagnostics call pbuf_add_field('QINI', 'physpkg', dtype_r8, (/pcols,pver/), qini_idx) - call pbuf_add_field('CLDLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), cldliqini_idx) - call pbuf_add_field('CLDICEINI', 'physpkg', dtype_r8, (/pcols,pver/), cldiceini_idx) + call pbuf_add_field('LIQINI', 'physpkg', dtype_r8, (/pcols,pver/), liqini_idx) + call pbuf_add_field('ICEINI', 'physpkg', dtype_r8, (/pcols,pver/), iceini_idx) ! check energy package call check_energy_register @@ -1474,8 +1474,8 @@ subroutine tphysac (ztodt, cam_in, & real(r8), pointer, dimension(:,:) :: cld real(r8), pointer, dimension(:,:) :: qini - real(r8), pointer, dimension(:,:) :: cldliqini - real(r8), pointer, dimension(:,:) :: cldiceini + real(r8), pointer, dimension(:,:) :: liqini + real(r8), pointer, dimension(:,:) :: iceini real(r8), pointer, dimension(:,:) :: dtcore real(r8), pointer, dimension(:,:) :: dqcore real(r8), pointer, dimension(:,:) :: ducore @@ -1508,8 +1508,8 @@ subroutine tphysac (ztodt, cam_in, & call pbuf_get_field(pbuf, dvcore_idx, dvcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, qini_idx, qini) - call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) - call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + call pbuf_get_field(pbuf, liqini_idx, liqini) + call pbuf_get_field(pbuf, iceini_idx, iceini) ifld = pbuf_get_index('CLD') call pbuf_get_field(pbuf, ifld, cld, start=(/1,1,itim_old/),kount=(/pcols,pver,1/)) @@ -1975,7 +1975,7 @@ subroutine tphysac (ztodt, cam_in, & endif endif - call diag_phys_tend_writeout (state, pbuf, tend, ztodt, qini, cldliqini, cldiceini) + call diag_phys_tend_writeout (state, pbuf, tend, ztodt, qini, liqini, iceini) call clybry_fam_set( ncol, lchnk, map2chm, state%q, pbuf ) @@ -2115,8 +2115,8 @@ subroutine tphysbc (ztodt, state, & ! physics buffer fields for total energy and mass adjustment real(r8), pointer, dimension(: ) :: teout real(r8), pointer, dimension(:,:) :: qini - real(r8), pointer, dimension(:,:) :: cldliqini - real(r8), pointer, dimension(:,:) :: cldiceini + real(r8), pointer, dimension(:,:) :: liqini + real(r8), pointer, dimension(:,:) :: iceini real(r8), pointer, dimension(:,:) :: dtcore real(r8), pointer, dimension(:,:) :: dqcore real(r8), pointer, dimension(:,:) :: ducore @@ -2190,8 +2190,8 @@ subroutine tphysbc (ztodt, state, & call pbuf_get_field(pbuf, teout_idx, teout, (/1,itim_old/), (/pcols,1/)) call pbuf_get_field(pbuf, qini_idx, qini) - call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) - call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + call pbuf_get_field(pbuf, liqini_idx, liqini) + call pbuf_get_field(pbuf, iceini_idx, iceini) call pbuf_get_field(pbuf, dtcore_idx, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, dqcore_idx, dqcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) @@ -2254,8 +2254,8 @@ subroutine tphysbc (ztodt, state, & call cnst_get_ind('CLDLIQ', ixcldliq) call cnst_get_ind('CLDICE', ixcldice) qini (:ncol,:pver) = state%q(:ncol,:pver, 1) - cldliqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) - cldiceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) + liqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) + iceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) call outfld('TEOUT', teout , pcols, lchnk ) call outfld('TEINP', state%te_ini(:,dyn_te_idx), pcols, lchnk ) diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index b5b433d77f..55f1f5b26a 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -69,8 +69,8 @@ module physpkg integer :: sgh30_idx = 0 integer :: qini_idx = 0 - integer :: cldliqini_idx = 0 - integer :: cldiceini_idx = 0 + integer :: liqini_idx = 0 + integer :: iceini_idx = 0 integer :: prec_str_idx = 0 integer :: snow_str_idx = 0 @@ -225,8 +225,8 @@ subroutine phys_register ! Fields for physics package diagnostics call pbuf_add_field('QINI', 'physpkg', dtype_r8, (/pcols,pver/), qini_idx) - call pbuf_add_field('CLDLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), cldliqini_idx) - call pbuf_add_field('CLDICEINI', 'physpkg', dtype_r8, (/pcols,pver/), cldiceini_idx) + call pbuf_add_field('LIQINI', 'physpkg', dtype_r8, (/pcols,pver/), liqini_idx) + call pbuf_add_field('ICEINI', 'physpkg', dtype_r8, (/pcols,pver/), iceini_idx) ! check energy package call check_energy_register @@ -1486,8 +1486,8 @@ subroutine tphysac (ztodt, cam_in, & real(r8), pointer, dimension(:,:) :: cld real(r8), pointer, dimension(:,:) :: qini - real(r8), pointer, dimension(:,:) :: cldliqini - real(r8), pointer, dimension(:,:) :: cldiceini + real(r8), pointer, dimension(:,:) :: liqini + real(r8), pointer, dimension(:,:) :: iceini real(r8), pointer, dimension(:,:) :: dtcore real(r8), pointer, dimension(:,:) :: dqcore real(r8), pointer, dimension(:,:) :: ducore @@ -1521,8 +1521,8 @@ subroutine tphysac (ztodt, cam_in, & call pbuf_get_field(pbuf, dvcore_idx, dvcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, qini_idx, qini) - call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) - call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + call pbuf_get_field(pbuf, liqini_idx, liqini) + call pbuf_get_field(pbuf, iceini_idx, iceini) ifld = pbuf_get_index('CLD') call pbuf_get_field(pbuf, ifld, cld, start=(/1,1,itim_old/),kount=(/pcols,pver,1/)) @@ -2392,7 +2392,7 @@ subroutine tphysac (ztodt, cam_in, & endif endif - call diag_phys_tend_writeout (state, pbuf, tend, ztodt, qini, cldliqini, cldiceini) + call diag_phys_tend_writeout (state, pbuf, tend, ztodt, qini, liqini, iceini) call clybry_fam_set( ncol, lchnk, map2chm, state%q, pbuf ) @@ -2499,8 +2499,8 @@ subroutine tphysbc (ztodt, state, & ! physics buffer fields for total energy and mass adjustment real(r8), pointer, dimension(: ) :: teout real(r8), pointer, dimension(:,:) :: qini - real(r8), pointer, dimension(:,:) :: cldliqini - real(r8), pointer, dimension(:,:) :: cldiceini + real(r8), pointer, dimension(:,:) :: liqini + real(r8), pointer, dimension(:,:) :: iceini real(r8), pointer, dimension(:,:) :: dtcore real(r8), pointer, dimension(:,:) :: dqcore real(r8), pointer, dimension(:,:) :: ducore @@ -2563,8 +2563,8 @@ subroutine tphysbc (ztodt, state, & call pbuf_get_field(pbuf, teout_idx, teout, (/1,itim_old/), (/pcols,1/)) call pbuf_get_field(pbuf, qini_idx, qini) - call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) - call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + call pbuf_get_field(pbuf, liqini_idx, liqini) + call pbuf_get_field(pbuf, iceini_idx, iceini) call pbuf_get_field(pbuf, dtcore_idx, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, dqcore_idx, dqcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) @@ -2630,8 +2630,8 @@ subroutine tphysbc (ztodt, state, & call cnst_get_ind('CLDLIQ', ixcldliq) call cnst_get_ind('CLDICE', ixcldice) qini (:ncol,:pver) = state%q(:ncol,:pver, ixq) - cldliqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) - cldiceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) + liqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) + iceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) call outfld('TEOUT', teout , pcols, lchnk ) call outfld('TEINP', state%te_ini(:,dyn_te_idx), pcols, lchnk ) From 142f29d5d4651ff0df0e7553ec5d7b22b031fb3c Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Tue, 1 Nov 2022 15:04:27 -0600 Subject: [PATCH 035/140] Revert "renaming for incl. all liq and all ice in one variable" This reverts commit a1f2fb56faca3bdccbff359e7cd8c319feec6893. --- src/physics/cam/physpkg.F90 | 30 +++++++++++++++--------------- src/physics/cam_dev/physpkg.F90 | 30 +++++++++++++++--------------- 2 files changed, 30 insertions(+), 30 deletions(-) diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index b0d622c6f3..f31e74110a 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -72,8 +72,8 @@ module physpkg integer :: sgh30_idx = 0 integer :: qini_idx = 0 - integer :: liqini_idx = 0 - integer :: iceini_idx = 0 + integer :: cldliqini_idx = 0 + integer :: cldiceini_idx = 0 integer :: prec_str_idx = 0 integer :: snow_str_idx = 0 @@ -238,8 +238,8 @@ subroutine phys_register ! Fields for physics package diagnostics call pbuf_add_field('QINI', 'physpkg', dtype_r8, (/pcols,pver/), qini_idx) - call pbuf_add_field('LIQINI', 'physpkg', dtype_r8, (/pcols,pver/), liqini_idx) - call pbuf_add_field('ICEINI', 'physpkg', dtype_r8, (/pcols,pver/), iceini_idx) + call pbuf_add_field('CLDLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), cldliqini_idx) + call pbuf_add_field('CLDICEINI', 'physpkg', dtype_r8, (/pcols,pver/), cldiceini_idx) ! check energy package call check_energy_register @@ -1474,8 +1474,8 @@ subroutine tphysac (ztodt, cam_in, & real(r8), pointer, dimension(:,:) :: cld real(r8), pointer, dimension(:,:) :: qini - real(r8), pointer, dimension(:,:) :: liqini - real(r8), pointer, dimension(:,:) :: iceini + real(r8), pointer, dimension(:,:) :: cldliqini + real(r8), pointer, dimension(:,:) :: cldiceini real(r8), pointer, dimension(:,:) :: dtcore real(r8), pointer, dimension(:,:) :: dqcore real(r8), pointer, dimension(:,:) :: ducore @@ -1508,8 +1508,8 @@ subroutine tphysac (ztodt, cam_in, & call pbuf_get_field(pbuf, dvcore_idx, dvcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, qini_idx, qini) - call pbuf_get_field(pbuf, liqini_idx, liqini) - call pbuf_get_field(pbuf, iceini_idx, iceini) + call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) + call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) ifld = pbuf_get_index('CLD') call pbuf_get_field(pbuf, ifld, cld, start=(/1,1,itim_old/),kount=(/pcols,pver,1/)) @@ -1975,7 +1975,7 @@ subroutine tphysac (ztodt, cam_in, & endif endif - call diag_phys_tend_writeout (state, pbuf, tend, ztodt, qini, liqini, iceini) + call diag_phys_tend_writeout (state, pbuf, tend, ztodt, qini, cldliqini, cldiceini) call clybry_fam_set( ncol, lchnk, map2chm, state%q, pbuf ) @@ -2115,8 +2115,8 @@ subroutine tphysbc (ztodt, state, & ! physics buffer fields for total energy and mass adjustment real(r8), pointer, dimension(: ) :: teout real(r8), pointer, dimension(:,:) :: qini - real(r8), pointer, dimension(:,:) :: liqini - real(r8), pointer, dimension(:,:) :: iceini + real(r8), pointer, dimension(:,:) :: cldliqini + real(r8), pointer, dimension(:,:) :: cldiceini real(r8), pointer, dimension(:,:) :: dtcore real(r8), pointer, dimension(:,:) :: dqcore real(r8), pointer, dimension(:,:) :: ducore @@ -2190,8 +2190,8 @@ subroutine tphysbc (ztodt, state, & call pbuf_get_field(pbuf, teout_idx, teout, (/1,itim_old/), (/pcols,1/)) call pbuf_get_field(pbuf, qini_idx, qini) - call pbuf_get_field(pbuf, liqini_idx, liqini) - call pbuf_get_field(pbuf, iceini_idx, iceini) + call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) + call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) call pbuf_get_field(pbuf, dtcore_idx, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, dqcore_idx, dqcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) @@ -2254,8 +2254,8 @@ subroutine tphysbc (ztodt, state, & call cnst_get_ind('CLDLIQ', ixcldliq) call cnst_get_ind('CLDICE', ixcldice) qini (:ncol,:pver) = state%q(:ncol,:pver, 1) - liqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) - iceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) + cldliqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) + cldiceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) call outfld('TEOUT', teout , pcols, lchnk ) call outfld('TEINP', state%te_ini(:,dyn_te_idx), pcols, lchnk ) diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index 55f1f5b26a..b5b433d77f 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -69,8 +69,8 @@ module physpkg integer :: sgh30_idx = 0 integer :: qini_idx = 0 - integer :: liqini_idx = 0 - integer :: iceini_idx = 0 + integer :: cldliqini_idx = 0 + integer :: cldiceini_idx = 0 integer :: prec_str_idx = 0 integer :: snow_str_idx = 0 @@ -225,8 +225,8 @@ subroutine phys_register ! Fields for physics package diagnostics call pbuf_add_field('QINI', 'physpkg', dtype_r8, (/pcols,pver/), qini_idx) - call pbuf_add_field('LIQINI', 'physpkg', dtype_r8, (/pcols,pver/), liqini_idx) - call pbuf_add_field('ICEINI', 'physpkg', dtype_r8, (/pcols,pver/), iceini_idx) + call pbuf_add_field('CLDLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), cldliqini_idx) + call pbuf_add_field('CLDICEINI', 'physpkg', dtype_r8, (/pcols,pver/), cldiceini_idx) ! check energy package call check_energy_register @@ -1486,8 +1486,8 @@ subroutine tphysac (ztodt, cam_in, & real(r8), pointer, dimension(:,:) :: cld real(r8), pointer, dimension(:,:) :: qini - real(r8), pointer, dimension(:,:) :: liqini - real(r8), pointer, dimension(:,:) :: iceini + real(r8), pointer, dimension(:,:) :: cldliqini + real(r8), pointer, dimension(:,:) :: cldiceini real(r8), pointer, dimension(:,:) :: dtcore real(r8), pointer, dimension(:,:) :: dqcore real(r8), pointer, dimension(:,:) :: ducore @@ -1521,8 +1521,8 @@ subroutine tphysac (ztodt, cam_in, & call pbuf_get_field(pbuf, dvcore_idx, dvcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, qini_idx, qini) - call pbuf_get_field(pbuf, liqini_idx, liqini) - call pbuf_get_field(pbuf, iceini_idx, iceini) + call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) + call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) ifld = pbuf_get_index('CLD') call pbuf_get_field(pbuf, ifld, cld, start=(/1,1,itim_old/),kount=(/pcols,pver,1/)) @@ -2392,7 +2392,7 @@ subroutine tphysac (ztodt, cam_in, & endif endif - call diag_phys_tend_writeout (state, pbuf, tend, ztodt, qini, liqini, iceini) + call diag_phys_tend_writeout (state, pbuf, tend, ztodt, qini, cldliqini, cldiceini) call clybry_fam_set( ncol, lchnk, map2chm, state%q, pbuf ) @@ -2499,8 +2499,8 @@ subroutine tphysbc (ztodt, state, & ! physics buffer fields for total energy and mass adjustment real(r8), pointer, dimension(: ) :: teout real(r8), pointer, dimension(:,:) :: qini - real(r8), pointer, dimension(:,:) :: liqini - real(r8), pointer, dimension(:,:) :: iceini + real(r8), pointer, dimension(:,:) :: cldliqini + real(r8), pointer, dimension(:,:) :: cldiceini real(r8), pointer, dimension(:,:) :: dtcore real(r8), pointer, dimension(:,:) :: dqcore real(r8), pointer, dimension(:,:) :: ducore @@ -2563,8 +2563,8 @@ subroutine tphysbc (ztodt, state, & call pbuf_get_field(pbuf, teout_idx, teout, (/1,itim_old/), (/pcols,1/)) call pbuf_get_field(pbuf, qini_idx, qini) - call pbuf_get_field(pbuf, liqini_idx, liqini) - call pbuf_get_field(pbuf, iceini_idx, iceini) + call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) + call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) call pbuf_get_field(pbuf, dtcore_idx, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, dqcore_idx, dqcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) @@ -2630,8 +2630,8 @@ subroutine tphysbc (ztodt, state, & call cnst_get_ind('CLDLIQ', ixcldliq) call cnst_get_ind('CLDICE', ixcldice) qini (:ncol,:pver) = state%q(:ncol,:pver, ixq) - liqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) - iceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) + cldliqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) + cldiceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) call outfld('TEOUT', teout , pcols, lchnk ) call outfld('TEINP', state%te_ini(:,dyn_te_idx), pcols, lchnk ) From b8d70f2ad4c1f0fd22fb0a7f8d4f28774b09f319 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Tue, 1 Nov 2022 19:09:54 -0600 Subject: [PATCH 036/140] add all water in pressure for SE (large commit!) - recover cam_development answers with #ifdef phl_cam_development --- bld/namelist_files/namelist_defaults_cam.xml | 2 +- src/dynamics/se/dp_coupling.F90 | 22 ++++- src/dynamics/se/dycore/prim_advance_mod.F90 | 87 +++++++++++++------- src/physics/cam/physics_types.F90 | 28 +++++-- src/physics/cam/physpkg.F90 | 31 ++++++- src/physics/cam_dev/physpkg.F90 | 31 ++++++- 6 files changed, 160 insertions(+), 41 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index cb1ef4d54c..12de7a79fb 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2719,7 +2719,7 @@ 'Q','CLDLIQ','CLDICE' 'Q','CLDLIQ','CLDICE' 'Q','CLDLIQ','CLDICE','RAINQM','SNOWQM' -'Q','CLDLIQ','CLDICE','RAINQM','SNOWQM' +'Q','CLDLIQ','CLDICE','RAINQM','SNOWQM','GRAUQM' diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index 62ff4ebb98..1eabbbb3d0 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -542,6 +542,10 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) use constituents, only: qmin use physconst, only: gravit, zvir use cam_thermo, only: cam_thermo_update +#ifndef phl_cam_development + use air_composition, only: thermodynamic_active_species_num + use air_composition, only: thermodynamic_active_species_idx +#endif use air_composition, only: cpairv, rairv, cappav use shr_const_mod, only: shr_const_rwv use phys_control, only: waccmx_is @@ -562,7 +566,7 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) real(r8) :: zvirv(pcols,pver) ! Local zvir array pointer real(r8) :: factor_array(pcols,nlev) - integer :: m, i, k, ncol + integer :: m, i, k, ncol, m_cnst type(physics_buffer_desc), pointer :: pbuf_chnk(:) !---------------------------------------------------------------------------- @@ -604,7 +608,8 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) end do ! wet pressure variables (should be removed from physics!) - +!#define phl_cam_development +#ifdef phl_cam_development do k=1,nlev do i=1,ncol ! to be consistent with total energy formula in physic's check_energy module only @@ -612,7 +617,18 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) factor_array(i,k) = 1+phys_state(lchnk)%q(i,k,1) end do end do - +#else + factor_array(:,:) = 1.0_r8 + do m_cnst=1,thermodynamic_active_species_num + m = thermodynamic_active_species_idx(m_cnst) + do k=1,nlev + do i=1,ncol + ! at this point all q's are dry + factor_array(i,k) = factor_array(i,k)+phys_state(lchnk)%q(i,k,m) + end do + end do + end do +#endif do k=1,nlev do i=1,ncol phys_state(lchnk)%pdel (i,k) = phys_state(lchnk)%pdeldry(i,k)*factor_array(i,k) diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index afc7d87752..3754f93746 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -1459,10 +1459,13 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf use fvm_control_volume_mod, only: fvm_struct use cam_thermo, only: get_dp, MASS_MIXING_RATIO use air_composition, only: thermodynamic_active_species_idx_dycore, get_cp + use air_composition, only: thermodynamic_active_species_liq_num,thermodynamic_active_species_liq_idx + use air_composition, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_ice_idx use dimensions_mod, only: cnst_name_gll use budgets, only: budget_info_byname use cam_logfile, only: iulog use spmd_utils, only: masterproc + !------------------------------Arguments-------------------------------- type (element_t) , intent(inout) :: elem(:) @@ -1477,6 +1480,7 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf real(kind=r8) :: ke(npsq) ! kinetic energy (J/m2) real(kind=r8) :: cdp_fvm(nc,nc,nlev) + real(kind=r8) :: cdp(np,np,nlev) real(kind=r8) :: se_tmp real(kind=r8) :: ke_tmp real(kind=r8) :: ps(np,np) @@ -1492,7 +1496,7 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf real(kind=r8) :: mr_cnst, mo_cnst, cos_lat, mr_tmp, mo_tmp real(kind=r8) :: cp(np,np,nlev) - integer :: ie,i,j,k,budget_ind,state_ind + integer :: ie,i,j,k,budget_ind,state_ind,idx integer :: ixwv,ixcldice, ixcldliq, ixtt ! CLDICE, CLDLIQ and test tracer indices character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 @@ -1608,9 +1612,15 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf end do fvm(ie)%budget(1:nc,1:nc,4,state_ind)=fvm(ie)%budget(1:nc,1:nc,4,state_ind)/gravit end if - if (ixcldliq>0) then + ! + ! sum over liquid water + ! + if (thermodynamic_active_species_liq_num>0) then cdp_fvm = 0.0_r8 - cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixcldliq)*fvm(ie)%dp_fvm(1:nc,1:nc,:) + do idx = 1,thermodynamic_active_species_liq_num + cdp_fvm = cdp_fvm + fvm(ie)%c(1:nc,1:nc,:,thermodynamic_active_species_liq_idx(idx))& + *fvm(ie)%dp_fvm(1:nc,1:nc,:) + end do call util_function(cdp_fvm,nc,nlev,name_out4,ie) do j = 1, nc do i = 1, nc @@ -1619,9 +1629,16 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf end do fvm(ie)%budget(1:nc,1:nc,5,state_ind)=fvm(ie)%budget(1:nc,1:nc,5,state_ind)/gravit end if - if (ixcldice>0) then - cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixcldice)*fvm(ie)%dp_fvm(1:nc,1:nc,:) - call util_function(cdp_fvm,nc,nlev,name_out5,ie) + ! + ! sum over ice water + ! + if (thermodynamic_active_species_ice_num>0) then + cdp_fvm = 0.0_r8 + do idx = 1,thermodynamic_active_species_ice_num + cdp_fvm = cdp_fvm + fvm(ie)%c(1:nc,1:nc,:,thermodynamic_active_species_ice_idx(idx))& + *fvm(ie)%dp_fvm(1:nc,1:nc,:) + end do + call util_function(cdp_fvm,nc,nlev,name_out5,ie) do j = 1, nc do i = 1, nc @@ -1644,34 +1661,48 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf call util_function(elem(ie)%state%qdp(:,:,:,1,tl_qdp),np,nlev,name_out3,ie) do j = 1, np do i = 1, np - elem(ie)%derived%budget(i,j,4,state_ind) = elem(ie)%derived%budget(i,j,4,state_ind) + sum(elem(ie)%state%qdp(i,j,:,1,tl_qdp)/gravit) + elem(ie)%derived%budget(i,j,4,state_ind) = elem(ie)%derived%budget(i,j,4,state_ind) + sum(cdp(i,j,:)/gravit) end do end do - if (ixcldliq>0) then - call util_function(elem(ie)%state%qdp(:,:,:,ixcldliq,tl_qdp),np,nlev,name_out4,ie) - do j = 1, np - do i = 1, np - elem(ie)%derived%budget(i,j,5,state_ind) = elem(ie)%derived%budget(i,j,5,state_ind) + sum(elem(ie)%state%qdp(i,j,:,ixcldliq,tl_qdp)/gravit) - end do - end do + ! + ! sum over liquid water + ! + if (thermodynamic_active_species_liq_num>0) then + cdp = 0.0_r8 + do idx = 1,thermodynamic_active_species_liq_num + cdp = cdp + elem(ie)%state%qdp(:,:,:,thermodynamic_active_species_liq_idx(idx),tl_qdp) + end do + call util_function(elem(ie)%state%qdp(:,:,:,ixcldliq,tl_qdp),np,nlev,name_out4,ie) + do j = 1, np + do i = 1, np + elem(ie)%derived%budget(i,j,5,state_ind) = elem(ie)%derived%budget(i,j,5,state_ind) + sum(cdp(i,j,:)/gravit) + end do + end do end if - if (ixcldice>0) then - call util_function(elem(ie)%state%qdp(:,:,:,ixcldice,tl_qdp),np,nlev,name_out5,ie) - do j = 1, np - do i = 1, np - elem(ie)%derived%budget(i,j,6,state_ind) = elem(ie)%derived%budget(i,j,6,state_ind) + sum(elem(ie)%state%qdp(i,j,:,ixcldice,tl_qdp)/gravit) - end do - end do + ! + ! sum over ice water + ! + if (thermodynamic_active_species_ice_num>0) then + cdp = 0.0_r8 + do idx = 1,thermodynamic_active_species_ice_num + cdp = cdp + elem(ie)%state%qdp(:,:,:,thermodynamic_active_species_ice_idx(idx),tl_qdp) + end do + call util_function(elem(ie)%state%qdp(:,:,:,ixcldice,tl_qdp),np,nlev,name_out5,ie) + do j = 1, np + do i = 1, np + elem(ie)%derived%budget(i,j,6,state_ind) = elem(ie)%derived%budget(i,j,6,state_ind) + sum(cdp(i,j,:)/gravit) + end do + end do end if if (ixtt>0) then - call util_function(elem(ie)%state%qdp(:,:,:,ixtt ,tl_qdp),np,nlev,name_out6,ie) - do j = 1, np - do i = 1, np - elem(ie)%derived%budget(i,j,7,state_ind) = elem(ie)%derived%budget(i,j,7,state_ind) + sum(elem(ie)%state%qdp(i,j,:,ixtt,tl_qdp)/gravit) - end do - end do + call util_function(elem(ie)%state%qdp(:,:,:,ixtt ,tl_qdp),np,nlev,name_out6,ie) + do j = 1, np + do i = 1, np + elem(ie)%derived%budget(i,j,7,state_ind) = elem(ie)%derived%budget(i,j,7,state_ind) + sum(cdp(i,j,:)/gravit) + end do + end do end if - end if + end if end do end if ! diff --git a/src/physics/cam/physics_types.F90 b/src/physics/cam/physics_types.F90 index 18809a7d98..c8cf372ab6 100644 --- a/src/physics/cam/physics_types.F90 +++ b/src/physics/cam/physics_types.F90 @@ -1212,7 +1212,9 @@ subroutine physics_cnst_limit(state) end subroutine physics_cnst_limit !=============================================================================== - subroutine physics_dme_adjust(state, tend, qini, dt) + subroutine physics_dme_adjust(state, tend, qini, liqini, iceini, dt) + use air_composition, only: dry_air_species_num,thermodynamic_active_species_num + use air_composition, only: thermodynamic_active_species_idx !----------------------------------------------------------------------- ! ! Purpose: Adjust the dry mass in each layer back to the value of physics input state @@ -1244,6 +1246,8 @@ subroutine physics_dme_adjust(state, tend, qini, dt) type(physics_state), intent(inout) :: state type(physics_tend ), intent(inout) :: tend real(r8), intent(in ) :: qini(pcols,pver) ! initial specific humidity + real(r8), intent(in ) :: liqini(pcols,pver) ! initial total liquid + real(r8), intent(in ) :: iceini(pcols,pver) ! initial total ice real(r8), intent(in ) :: dt ! model physics timestep ! !---------------------------Local workspace----------------------------- @@ -1258,7 +1262,12 @@ subroutine physics_dme_adjust(state, tend, qini, dt) real(r8) :: zvirv(pcols,pver) ! Local zvir array pointer + real(r8) :: tot_water (pcols,2) ! total water (initial, present) + real(r8) :: tot_water_chg(pcols) ! total water change + + real(r8),allocatable :: cpairv_loc(:,:) + integer :: m_cnst ! !----------------------------------------------------------------------- @@ -1276,10 +1285,18 @@ subroutine physics_dme_adjust(state, tend, qini, dt) ! constituents, momentum, and total energy state%ps(:ncol) = state%pint(:ncol,1) do k = 1, pver - - ! adjusment factor is just change in water vapor - fdq(:ncol) = 1._r8 + state%q(:ncol,k,1) - qini(:ncol,k) - +!#define phl_cam_development +#ifndef phl_cam_development + tot_water(:ncol,1) = qini(:ncol,k)+liqini(:ncol,k)+iceini(:ncol,k) !initial total H2O + tot_water(:ncol,2) = 0.0_r8 + do m_cnst=dry_air_species_num+1,thermodynamic_active_species_num + m = thermodynamic_active_species_idx(m_cnst) + tot_water(:ncol,2) = tot_water(:ncol,2)+state%q(:ncol,k,m) + end do + fdq(:ncol) = 1._r8 + tot_water(:ncol,2) - tot_water(:ncol,1) +#else + fdq(:ncol) = 1._r8 + state%q(:ncol,k,1) - qini(:ncol,k) +#endif ! adjust constituents to conserve mass in each layer do m = 1, pcnst state%q(:ncol,k,m) = state%q(:ncol,k,m) / fdq(:ncol) @@ -1310,6 +1327,7 @@ subroutine physics_dme_adjust(state, tend, qini, dt) state%pint (:ncol,k+1) = state%pint(:ncol,k ) + state%pdel(:ncol,k) state%lnpint(:ncol,k+1) = log(state%pint(:ncol,k+1)) state%rpdel (:ncol,k ) = 1._r8/ state%pdel(:ncol,k ) + !note that mid-level variables (e.g. pmid) are not recomputed end do if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index f31e74110a..89bca4fc8e 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -74,6 +74,8 @@ module physpkg integer :: qini_idx = 0 integer :: cldliqini_idx = 0 integer :: cldiceini_idx = 0 + integer :: totliqini_idx = 0 + integer :: toticeini_idx = 0 integer :: prec_str_idx = 0 integer :: snow_str_idx = 0 @@ -240,6 +242,8 @@ subroutine phys_register call pbuf_add_field('QINI', 'physpkg', dtype_r8, (/pcols,pver/), qini_idx) call pbuf_add_field('CLDLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), cldliqini_idx) call pbuf_add_field('CLDICEINI', 'physpkg', dtype_r8, (/pcols,pver/), cldiceini_idx) + call pbuf_add_field('TOTLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), totliqini_idx) + call pbuf_add_field('TOTICEINI', 'physpkg', dtype_r8, (/pcols,pver/), toticeini_idx) ! check energy package call check_energy_register @@ -1476,6 +1480,8 @@ subroutine tphysac (ztodt, cam_in, & real(r8), pointer, dimension(:,:) :: qini real(r8), pointer, dimension(:,:) :: cldliqini real(r8), pointer, dimension(:,:) :: cldiceini + real(r8), pointer, dimension(:,:) :: totliqini + real(r8), pointer, dimension(:,:) :: toticeini real(r8), pointer, dimension(:,:) :: dtcore real(r8), pointer, dimension(:,:) :: dqcore real(r8), pointer, dimension(:,:) :: ducore @@ -1510,6 +1516,8 @@ subroutine tphysac (ztodt, cam_in, & call pbuf_get_field(pbuf, qini_idx, qini) call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + call pbuf_get_field(pbuf, totliqini_idx, totliqini) + call pbuf_get_field(pbuf, toticeini_idx, toticeini) ifld = pbuf_get_index('CLD') call pbuf_get_field(pbuf, ifld, cld, start=(/1,1,itim_old/),kount=(/pcols,pver,1/)) @@ -1920,7 +1928,7 @@ subroutine tphysac (ztodt, cam_in, & call set_dry_to_wet(state) - call physics_dme_adjust(state, tend, qini, ztodt) + call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) call calc_te_and_aam_budgets(state, 'phAM') call calc_te_and_aam_budgets(state, 'dyAM', vc=vc_dycore) @@ -1937,7 +1945,7 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat) end if - call physics_dme_adjust(state, tend, qini, ztodt) + call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) if (trim(cam_take_snapshot_after) == "physics_dme_adjust") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& @@ -2030,6 +2038,8 @@ subroutine tphysbc (ztodt, state, & use cam_history, only: outfld use physconst, only: cpair, latvap use constituents, only: pcnst, qmin, cnst_get_ind + use air_composition, only: thermodynamic_active_species_liq_num,thermodynamic_active_species_liq_idx + use air_composition, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_ice_idx use convect_deep, only: convect_deep_tend, convect_deep_tend_2, deep_scheme_does_scav_trans use time_manager, only: is_first_step, get_nstep use convect_shallow, only: convect_shallow_tend @@ -2104,6 +2114,7 @@ subroutine tphysbc (ztodt, state, & integer :: i ! column indicex integer :: ixcldice, ixcldliq, ixq ! constituent indices for cloud liquid and ice water. + integer :: m, m_cnst ! for macro/micro co-substepping integer :: macmic_it ! iteration variables real(r8) :: cld_macmic_ztodt ! modified timestep @@ -2117,6 +2128,8 @@ subroutine tphysbc (ztodt, state, & real(r8), pointer, dimension(:,:) :: qini real(r8), pointer, dimension(:,:) :: cldliqini real(r8), pointer, dimension(:,:) :: cldiceini + real(r8), pointer, dimension(:,:) :: totliqini + real(r8), pointer, dimension(:,:) :: toticeini real(r8), pointer, dimension(:,:) :: dtcore real(r8), pointer, dimension(:,:) :: dqcore real(r8), pointer, dimension(:,:) :: ducore @@ -2192,6 +2205,8 @@ subroutine tphysbc (ztodt, state, & call pbuf_get_field(pbuf, qini_idx, qini) call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + call pbuf_get_field(pbuf, totliqini_idx, totliqini) + call pbuf_get_field(pbuf, toticeini_idx, toticeini) call pbuf_get_field(pbuf, dtcore_idx, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, dqcore_idx, dqcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) @@ -2257,6 +2272,18 @@ subroutine tphysbc (ztodt, state, & cldliqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) cldiceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) + totliqini(:ncol,:pver) = 0.0_r8 + do m_cnst=1,thermodynamic_active_species_liq_num + m = thermodynamic_active_species_liq_idx(m_cnst) + totliqini(:ncol,:pver) = totliqini(:ncol,:pver)+state%q(:ncol,:pver,m) + end do + toticeini(:ncol,:pver) = 0.0_r8 + do m_cnst=1,thermodynamic_active_species_ice_num + m = thermodynamic_active_species_ice_idx(m_cnst) + toticeini(:ncol,:pver) = toticeini(:ncol,:pver)+state%q(:ncol,:pver,m) + end do + + call outfld('TEOUT', teout , pcols, lchnk ) call outfld('TEINP', state%te_ini(:,dyn_te_idx), pcols, lchnk ) call outfld('TEFIX', state%te_cur(:,dyn_te_idx), pcols, lchnk ) diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index b5b433d77f..bb7dfd05d4 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -71,6 +71,8 @@ module physpkg integer :: qini_idx = 0 integer :: cldliqini_idx = 0 integer :: cldiceini_idx = 0 + integer :: totliqini_idx = 0 + integer :: toticeini_idx = 0 integer :: prec_str_idx = 0 integer :: snow_str_idx = 0 @@ -227,6 +229,8 @@ subroutine phys_register call pbuf_add_field('QINI', 'physpkg', dtype_r8, (/pcols,pver/), qini_idx) call pbuf_add_field('CLDLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), cldliqini_idx) call pbuf_add_field('CLDICEINI', 'physpkg', dtype_r8, (/pcols,pver/), cldiceini_idx) + call pbuf_add_field('TOTLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), totliqini_idx) + call pbuf_add_field('TOTICEINI', 'physpkg', dtype_r8, (/pcols,pver/), toticeini_idx) ! check energy package call check_energy_register @@ -1488,6 +1492,8 @@ subroutine tphysac (ztodt, cam_in, & real(r8), pointer, dimension(:,:) :: qini real(r8), pointer, dimension(:,:) :: cldliqini real(r8), pointer, dimension(:,:) :: cldiceini + real(r8), pointer, dimension(:,:) :: totliqini + real(r8), pointer, dimension(:,:) :: toticeini real(r8), pointer, dimension(:,:) :: dtcore real(r8), pointer, dimension(:,:) :: dqcore real(r8), pointer, dimension(:,:) :: ducore @@ -1523,6 +1529,8 @@ subroutine tphysac (ztodt, cam_in, & call pbuf_get_field(pbuf, qini_idx, qini) call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + call pbuf_get_field(pbuf, totliqini_idx, totliqini) + call pbuf_get_field(pbuf, toticeini_idx, toticeini) ifld = pbuf_get_index('CLD') call pbuf_get_field(pbuf, ifld, cld, start=(/1,1,itim_old/),kount=(/pcols,pver,1/)) @@ -2338,7 +2346,7 @@ subroutine tphysac (ztodt, cam_in, & call set_dry_to_wet(state) - call physics_dme_adjust(state, tend, qini, ztodt) + call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) call calc_te_and_aam_budgets(state, 'phAM') call calc_te_and_aam_budgets(state, 'dyAM',vc=vc_dycore) @@ -2355,7 +2363,7 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) end if - call physics_dme_adjust(state, tend, qini, ztodt) + call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) if (trim(cam_take_snapshot_after) == "physics_dme_adjust") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& @@ -2436,6 +2444,8 @@ subroutine tphysbc (ztodt, state, & use cam_diagnostics, only: diag_conv_tend_ini, diag_conv, diag_export, diag_state_b4_phys_write use cam_history, only: outfld use constituents, only: qmin + use air_composition, only: thermodynamic_active_species_liq_num,thermodynamic_active_species_liq_idx + use air_composition, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_ice_idx use convect_deep, only: convect_deep_tend use time_manager, only: is_first_step, get_nstep use convect_diagnostics,only: convect_diagnostics_calc @@ -2491,6 +2501,7 @@ subroutine tphysbc (ztodt, state, & integer :: i ! column indicex integer :: ixcldice, ixcldliq, ixq ! constituent indices for cloud liquid and ice water. + integer :: m, m_cnst ! physics buffer fields to compute tendencies for stratiform package integer itim_old, ifld @@ -2501,6 +2512,8 @@ subroutine tphysbc (ztodt, state, & real(r8), pointer, dimension(:,:) :: qini real(r8), pointer, dimension(:,:) :: cldliqini real(r8), pointer, dimension(:,:) :: cldiceini + real(r8), pointer, dimension(:,:) :: totliqini + real(r8), pointer, dimension(:,:) :: toticeini real(r8), pointer, dimension(:,:) :: dtcore real(r8), pointer, dimension(:,:) :: dqcore real(r8), pointer, dimension(:,:) :: ducore @@ -2565,6 +2578,8 @@ subroutine tphysbc (ztodt, state, & call pbuf_get_field(pbuf, qini_idx, qini) call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + call pbuf_get_field(pbuf, totliqini_idx, totliqini) + call pbuf_get_field(pbuf, toticeini_idx, toticeini) call pbuf_get_field(pbuf, dtcore_idx, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, dqcore_idx, dqcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) @@ -2633,6 +2648,18 @@ subroutine tphysbc (ztodt, state, & cldliqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) cldiceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) + totliqini(:ncol,:pver) = 0.0_r8 + do m_cnst=1,thermodynamic_active_species_liq_num + m = thermodynamic_active_species_liq_idx(m_cnst) + totliqini(:ncol,:pver) = totliqini(:ncol,:pver)+state%q(:ncol,:pver,m) + end do + toticeini(:ncol,:pver) = 0.0_r8 + do m_cnst=1,thermodynamic_active_species_ice_num + m = thermodynamic_active_species_ice_idx(m_cnst) + toticeini(:ncol,:pver) = toticeini(:ncol,:pver)+state%q(:ncol,:pver,m) + end do + + call outfld('TEOUT', teout , pcols, lchnk ) call outfld('TEINP', state%te_ini(:,dyn_te_idx), pcols, lchnk ) call outfld('TEFIX', state%te_cur(:,dyn_te_idx), pcols, lchnk ) From 783a85728a253c9e08ab693d0c3bf9809bcfba3a Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Wed, 2 Nov 2022 09:37:52 -0600 Subject: [PATCH 037/140] remove unused variable --- src/dynamics/mpas/dp_coupling.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index 8bbb0727e8..cd49983287 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -826,7 +826,7 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t logical :: b_subcycle real(r8) :: rho_dz,zcell,temperature,theta,pk,ptop,exner real(r8), dimension(nVertLevels, nCells) :: rhod, dz - real(r8), dimension(nCells) :: kinetic_energy,potential_energy,internal_energy,water_vapor,water_liq,water_ice + real(r8), dimension(nCells) :: kinetic_energy,potential_energy,internal_energy,water_vapor real(r8), dimension(nCells) :: liq !total column integrated liquid real(r8), dimension(nCells) :: ice !total column integrated ice From 78b14743897d3302cb44c90dfde9abee94066062 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Wed, 2 Nov 2022 09:38:06 -0600 Subject: [PATCH 038/140] fix bug in how indices for energy diagnostics are set in dyn_comp.F90 --- src/dynamics/mpas/dyn_comp.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index 424680605f..d6fdc01c46 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -599,21 +599,21 @@ subroutine dyn_init(dyn_in, dyn_out) ! initialize CAM thermodynamic infrastructure ! do m=1,thermodynamic_active_species_num - thermodynamic_active_species_idx_dycore(m) = dyn_in % mpas_from_cam_cnst(thermodynamic_active_species_idx(m)) + thermodynamic_active_species_idx_dycore(m) = dyn_out % cam_from_mpas_cnst(thermodynamic_active_species_idx(m)) if (masterproc) then - write(iulog,*) subname//": m,thermodynamic_active_species_idx_dycore: ",m,thermodynamic_active_species_idx_dycore(m) + write(iulog,'(a,2I4)') subname//": m,thermodynamic_active_species_idx_dycore: ",m,thermodynamic_active_species_idx_dycore(m) end if end do do m=1,thermodynamic_active_species_liq_num - thermodynamic_active_species_liq_idx_dycore(m) = dyn_in % mpas_from_cam_cnst(thermodynamic_active_species_liq_idx(m)) + thermodynamic_active_species_liq_idx_dycore(m) = dyn_out % cam_from_mpas_cnst(thermodynamic_active_species_liq_idx(m)) if (masterproc) then - write(iulog,*) subname//": m,thermodynamic_active_species_idx_liq_dycore: ",m,thermodynamic_active_species_liq_idx_dycore(m) + write(iulog,'(a,2I4)') subname//": m,thermodynamic_active_species_idx_liq_dycore: ",m,thermodynamic_active_species_liq_idx_dycore(m) end if end do do m=1,thermodynamic_active_species_ice_num - thermodynamic_active_species_ice_idx_dycore(m) = dyn_in % mpas_from_cam_cnst(thermodynamic_active_species_ice_idx(m)) + thermodynamic_active_species_ice_idx_dycore(m) = dyn_out % cam_from_mpas_cnst(thermodynamic_active_species_ice_idx(m)) if (masterproc) then - write(iulog,*) subname//": m,thermodynamic_active_species_idx_ice_dycore: ",m,thermodynamic_active_species_ice_idx_dycore(m) + write(iulog,'(a,2I4)') subname//": m,thermodynamic_active_species_idx_ice_dycore: ",m,thermodynamic_active_species_ice_idx_dycore(m) end if end do From 7def1f874da0ab15b3ceba40023a169dc98d1184 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Wed, 30 Nov 2022 14:29:32 -0700 Subject: [PATCH 039/140] MPAS: add all water to pressure and consistent height-pressure formulation --- src/dynamics/mpas/dp_coupling.F90 | 78 +++++++++++++++++++---------- src/dynamics/mpas/dycore_budget.F90 | 23 +++++++-- 2 files changed, 70 insertions(+), 31 deletions(-) diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index cd49983287..46f4c8da42 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -132,7 +132,7 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) if( ierr /= 0 ) call endrun(subname//':failed to allocate pintdry array') call hydrostatic_pressure( & - nCellsSolve, plev, zz, zint, rho_zz, theta_m, exner, tracers(index_qv,:,:),& + nCellsSolve, plev, size(tracers, 1), index_qv, zz, zint, rho_zz, theta_m, exner, tracers,& pmiddry, pintdry, pmid) call t_startf('dpcopy') @@ -329,7 +329,6 @@ end subroutine p_d_coupling !========================================================================================= subroutine derived_phys(phys_state, phys_tend, pbuf2d) - ! Compute fields in the physics state object which are diagnosed from the ! MPAS prognostic fields. @@ -349,7 +348,7 @@ subroutine derived_phys(phys_state, phys_tend, pbuf2d) ! Local variables - integer :: i, k, lchnk, m, ncol + integer :: i, k, lchnk, m, ncol, m_cnst real(r8) :: factor(pcols,pver) real(r8) :: zvirv(pcols,pver) @@ -396,7 +395,16 @@ subroutine derived_phys(phys_state, phys_tend, pbuf2d) do k = 1, pver ! To be consistent with total energy formula in physic's check_energy module only ! include water vapor in moist pdel. +#ifdef phl_cam_development factor(:ncol,k) = 1._r8 + phys_state(lchnk)%q(:ncol,k,1) +#else + factor(:ncol,k) = 1.0_r8 + do m_cnst=1,thermodynamic_active_species_num + m = thermodynamic_active_species_idx(m_cnst) + ! at this point all q's are dry + factor(:ncol,k) = factor(:ncol,k)+phys_state(lchnk)%q(:ncol,k,m) + end do +#endif phys_state(lchnk)%pdel(:ncol,k) = phys_state(lchnk)%pdeldry(:ncol,k)*factor(:ncol,k) phys_state(lchnk)%rpdel(:ncol,k) = 1._r8 / phys_state(lchnk)%pdel(:ncol,k) end do @@ -678,9 +686,8 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn end subroutine derived_tend !========================================================================================= -subroutine hydrostatic_pressure(nCells, nVertLevels, zz, zgrid, rho_zz, theta_m, & +subroutine hydrostatic_pressure(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, theta_m, & exner, q, pmiddry, pintdry,pmid) - ! Compute dry hydrostatic pressure at layer interfaces and midpoints ! ! Given arrays of zz, zgrid, rho_zz, and theta_m from the MPAS-A prognostic @@ -694,18 +701,20 @@ subroutine hydrostatic_pressure(nCells, nVertLevels, zz, zgrid, rho_zz, theta_m, ! Arguments integer, intent(in) :: nCells integer, intent(in) :: nVertLevels - real(r8), dimension(nVertLevels, nCells), intent(in) :: zz ! d(zeta)/dz [-] - real(r8), dimension(nVertLevels+1, nCells), intent(in) :: zgrid ! geometric heights of layer interfaces [m] - real(r8), dimension(nVertLevels, nCells), intent(in) :: rho_zz ! dry density / zz [kg m^-3] - real(r8), dimension(nVertLevels, nCells), intent(in) :: theta_m ! modified potential temperature - real(r8), dimension(nVertLevels, nCells), intent(in) :: exner ! Exner function - real(r8), dimension(nVertLevels, nCells), intent(in) :: q ! water vapor dry mixing ratio - real(r8), dimension(nVertLevels, nCells), intent(out):: pmiddry ! layer midpoint dry hydrostatic pressure [Pa] - real(r8), dimension(nVertLevels+1, nCells), intent(out):: pintdry ! layer interface dry hydrostatic pressure [Pa] - real(r8), dimension(nVertLevels, nCells), intent(out):: pmid ! layer midpoint hydrostatic pressure [Pa] + integer, intent(in) :: qsize + integer, intent(in) :: index_qv + real(r8), dimension(nVertLevels, nCells), intent(in) :: zz ! d(zeta)/dz [-] + real(r8), dimension(nVertLevels+1, nCells), intent(in) :: zgrid ! geometric heights of layer interfaces [m] + real(r8), dimension(nVertLevels, nCells), intent(in) :: rho_zz ! dry density / zz [kg m^-3] + real(r8), dimension(nVertLevels, nCells), intent(in) :: theta_m ! modified potential temperature + real(r8), dimension(nVertLevels, nCells), intent(in) :: exner ! Exner function + real(r8), dimension(qsize,nVertLevels, nCells), intent(in) :: q ! water vapor dry mixing ratio + real(r8), dimension(nVertLevels, nCells), intent(out):: pmiddry ! layer midpoint dry hydrostatic pressure [Pa] + real(r8), dimension(nVertLevels+1, nCells), intent(out):: pintdry ! layer interface dry hydrostatic pressure [Pa] + real(r8), dimension(nVertLevels, nCells), intent(out):: pmid ! layer midpoint hydrostatic pressure [Pa] ! Local variables - integer :: iCell, k + integer :: iCell, k, idx real(r8), dimension(nVertLevels) :: dz ! Geometric layer thickness in column real(r8), dimension(nVertLevels) :: dp,dpdry ! Pressure thickness #ifdef phl_cam_development @@ -728,9 +737,9 @@ subroutine hydrostatic_pressure(nCells, nVertLevels, zz, zgrid, rho_zz, theta_m, dz(:) = zgrid(2:nVertLevels+1,iCell) - zgrid(1:nVertLevels,iCell) k = nVertLevels - rhok = (1.0_r8+q(k,iCell))*zz(k,iCell) * rho_zz(k,iCell) !full CAM physics density - thetavk = theta_m(k,iCell)/ (1.0_r8 + q(k,iCell)) !convert modified theta to virtual theta - pk = (rhok*rgas*thetavk*kap1)**kap2 !mid-level top pressure + rhok = (1.0_r8+q(index_qv,k,iCell))*zz(k,iCell) * rho_zz(k,iCell) !full CAM physics density + thetavk = theta_m(k,iCell)/ (1.0_r8 + q(index_qv,k,iCell)) !convert modified theta to virtual theta + pk = (rhok*rgas*thetavk*kap1)**kap2 !mid-level top pressure ! ! model top pressure consistently diagnosed using the assumption that the mid level ! is at height z(nVertLevels-1)+0.5*dz @@ -742,7 +751,7 @@ subroutine hydrostatic_pressure(nCells, nVertLevels, zz, zgrid, rho_zz, theta_m, ! compute hydrostatic dry interface pressure so that (pintdry(k+1)-pintdry(k))/g is pseudo density ! rhodryk = zz(k,iCell) * rho_zz(k,iCell) - rhok = (1.0_r8+q(k,iCell))*rhodryk + rhok = (1.0_r8+q(index_qv,k,iCell))*rhodryk pintdry(k,iCell) = pintdry(k+1,iCell) + gravity * rhodryk * dz(k) pint (k) = pint (k+1) + gravity * rhok * dz(k) end do @@ -762,14 +771,22 @@ subroutine hydrostatic_pressure(nCells, nVertLevels, zz, zgrid, rho_zz, theta_m, dz(:) = zgrid(2:nVertLevels+1,iCell) - zgrid(1:nVertLevels,iCell) do k = nVertLevels, 1, -1 rhodryk = zz(k,iCell)* rho_zz(k,iCell) !full CAM physics density - rhok = (1.0_r8+q(k,iCell))*rhodryk !not used !dry CAM physics density + rhok = 1.0_r8 + do idx=1,thermodynamic_active_species_num + rhok = rhok+q(thermodynamic_active_species_idx_dycore(idx),k,iCell) + end do + rhok = rhok*rhodryk dp(k) = gravit*dz(k)*rhok - dpdry(k) = gravit*dz(k)*rhodryk!phl not used + dpdry(k) = gravit*dz(k)*rhodryk end do k = nVertLevels - rhok = (1.0_r8+q(k,iCell))*zz(k,iCell) * rho_zz(k,iCell) !full CAM physics density - thetavk = theta_m(k,iCell)/ (1.0_r8 + q(k,iCell)) !convert modified theta to virtual theta + rhok = 1.0_r8 + do idx=1,thermodynamic_active_species_num + rhok = rhok+q(thermodynamic_active_species_idx_dycore(idx),k,iCell) + end do + rhok = rhok*zz(k,iCell) * rho_zz(k,iCell) + thetavk = theta_m(k,iCell)/ (1.0_r8 + q(index_qv,k,iCell)) !convert modified theta to virtual theta tvk = thetavk*exner(k,iCell) pk = (rhok*rgas*thetavk*kap1)**kap2 !mid-level top pressure ! @@ -782,9 +799,9 @@ subroutine hydrostatic_pressure(nCells, nVertLevels, zz, zgrid, rho_zz, theta_m, ! ! compute hydrostatic dry interface pressure so that (pintdry(k+1)-pintdry(k))/g is pseudo density ! - thetavk = theta_m(k,iCell)/ (1.0_r8 + q(k,iCell)) !convert modified theta to virtual theta + thetavk = theta_m(k,iCell)/ (1.0_r8 + q(index_qv,k,iCell)) !convert modified theta to virtual theta tvk = thetavk*exner(k,iCell) - tk = tvk*(1.0_r8+q(k,iCell))/(1.0_r8+Rv_over_Rd*q(k,iCell)) + tk = tvk*(1.0_r8+q(index_qv,k,iCell))/(1.0_r8+Rv_over_Rd*q(index_qv,k,iCell)) pint (k,iCell) = pint (k+1,iCell)+dp(k) pintdry(k,iCell) = pintdry(k+1,iCell)+dpdry(k) pmid(k,iCell) = dp(k) *rgas*tvk/(gravit*dz(k)) @@ -852,7 +869,15 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t dz(k,iCell) = zgrid(k+1,iCell) - zgrid(k,iCell) zcell = 0.5_r8*(zgrid(k,iCell)+zgrid(k+1,iCell)) rhod(k,iCell) = zz(k,iCell) * rho_zz(k,iCell) +#ifdef phl_cam_development rho_dz = (1.0_r8+q(index_qv,k,iCell))*rhod(k,iCell)*dz(k,iCell) +#else + rho_dz = 1.0_r8 + do idx=1,thermodynamic_active_species_num + rho_dz = rho_dz+q(thermodynamic_active_species_idx_dycore(idx),k,iCell) + end do + rho_dz = rho_dz*rhod(k,iCell)*dz(k,iCell) +#endif theta = theta_m(k,iCell)/(1.0_r8 + Rv_over_Rd *q(index_qv,k,iCell))!convert theta_m to theta exner = (rgas*rhod(k,iCell)*theta_m(k,iCell)/p0)**(rgas/cv) @@ -864,7 +889,6 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t potential_energy(iCell) = potential_energy(iCell)+ rho_dz*gravit*zcell internal_energy(iCell) = internal_energy(iCell) + rho_dz*cv*temperature end do - internal_energy(iCell) = internal_energy(iCell) + potential_energy(iCell) !static energy end do call outfld(name_out1,internal_energy,ncells,1) call outfld(name_out2,kinetic_energy ,ncells,1) @@ -890,7 +914,7 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t te_budgets(s_ind,:,:)=0._r8 end if - te_budgets(s_ind,1,:)=te_budgets(s_ind,1,:)+(internal_energy+kinetic_energy) + te_budgets(s_ind,1,:)= te_budgets(s_ind,1,:)+potential_energy+internal_energy+kinetic_energy te_budgets(s_ind,2,:)=te_budgets(s_ind,2,:)+internal_energy te_budgets(s_ind,3,:)=te_budgets(s_ind,3,:)+kinetic_energy write(iulog,*)'tot_e te_budget for this proc ',s_ind,',1:3,1 is ',te_budgets(s_ind,1,1),' ',te_budgets(s_ind,2,1),' ',te_budgets(s_ind,3,1) diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index a70329f89f..4ea6b9f666 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -4,7 +4,7 @@ module dycore_budget public :: print_budget real(r8), parameter :: eps = 1.0E-9_r8 - +real(r8), save :: previous_dEdt_adiabatic_dycore = 0.0_r8 !========================================================================================= contains !========================================================================================= @@ -29,6 +29,7 @@ subroutine print_budget() real(r8) :: ph_param,ph_EFIX,ph_dmea,ph_param_and_efix,ph_phys_total real(r8) :: dy_param,dy_EFIX,dy_dmea,dy_param_and_efix,dy_phys_total real(r8) :: mpas_param,mpas_dmea,mpas_phys_total, dycore, err, param, pefix, pdmea, param_mpas, phys_total + real(r8) :: E_dBF, E_dyBF real(r8) :: diff integer :: m_cnst !-------------------------------------------------------------------------------------- @@ -120,6 +121,20 @@ subroutine print_budget() ! end if ! end if + call budget_get_global('dBF',1,E_dBF) !state passed to physics + call budget_get_global('dyBF',1,E_dyBF)!state beginning physics + if (abs(E_dyBF)>eps) then + diff = abs_diff(E_dBF,E_dyBF) + if (abs(diff) Date: Wed, 30 Nov 2022 15:08:19 -0700 Subject: [PATCH 040/140] separate "static energy" into enthalpy and PHIS energy --- src/dynamics/mpas/dp_coupling.F90 | 2 +- src/dynamics/mpas/dycore_budget.F90 | 7 +++++-- src/physics/cam/check_energy.F90 | 10 ++++++---- src/utils/cam_thermo.F90 | 21 +++++++++++++++------ 4 files changed, 27 insertions(+), 13 deletions(-) diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index 46f4c8da42..7ad25feece 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -914,7 +914,7 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t te_budgets(s_ind,:,:)=0._r8 end if - te_budgets(s_ind,1,:)= te_budgets(s_ind,1,:)+potential_energy+internal_energy+kinetic_energy + te_budgets(s_ind,1,:)=te_budgets(s_ind,1,:)+potential_energy+internal_energy+kinetic_energy te_budgets(s_ind,2,:)=te_budgets(s_ind,2,:)+internal_energy te_budgets(s_ind,3,:)=te_budgets(s_ind,3,:)+kinetic_energy write(iulog,*)'tot_e te_budget for this proc ',s_ind,',1:3,1 is ',te_budgets(s_ind,1,1),' ',te_budgets(s_ind,2,1),' ',te_budgets(s_ind,3,1) diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index 4ea6b9f666..922dd28a29 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -120,7 +120,10 @@ subroutine print_budget() ! call endrun('dycore_budget module: physics energy budget consistency error 2') ! end if ! end if - + write(iulog,*) "" + write(iulog,*) "Is globally integrated total energy of state at the end of dynamics (dBF)" + write(iulog,*) "and beginning of physics (phBF) the same?" + write(iulog,*) "" call budget_get_global('dBF',1,E_dBF) !state passed to physics call budget_get_global('dyBF',1,E_dyBF)!state beginning physics if (abs(E_dyBF)>eps) then @@ -132,7 +135,7 @@ subroutine print_budget() write(iulog,*)"no. (dBF-dyBF)/dyBF =",diff write(iulog,*)"E_dBF=",E_dBF,"; E_dyBF=",E_dyBF write(iulog,*)"Error in physics dynamics coupling!" -! call endrun('dycore_budget module: Error in physics dynamics coupling') + call endrun('dycore_budget module: Error in physics dynamics coupling') end if end if write(iulog,*)" " diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index f9c876324d..fb27a48495 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -394,7 +394,8 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & real(r8) :: scaling(state%psetcols,pver) ! scaling for conversion of temperature increment real(r8) :: temp(state%ncol,pver) ! temperature - real(r8) :: se(pcols) ! Dry Static energy (J/m2) + real(r8) :: se(pcols) ! enthalpy or internal energy (J/m2) + real(r8) :: po(pcols) ! surface potential or potential energy (J/m2) real(r8) :: ke(pcols) ! kinetic energy (J/m2) real(r8) :: wv(pcols) ! column integrated vapor (kg/m2) real(r8) :: liq(pcols) ! column integrated liquid (kg/m2) @@ -424,7 +425,7 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & state%pdel(1:ncol,1:pver), cp_or_cv(1:ncol,1:pver), & state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), state%T(1:ncol,1:pver), & vc_physics, ps = state%ps(1:ncol), phis = state%phis(1:ncol), & - te = te, H2O = tw, se=se,ke=ke,wv=wv,liq=liq,ice=ice) + te = te, H2O = tw, se=se,po=po,ke=ke,wv=wv,liq=liq,ice=ice) ! compute expected values and tendencies do i = 1, ncol ! change in static energy and total water @@ -955,6 +956,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) !---------------------------Local storage------------------------------- real(r8) :: se(pcols) ! Dry Static energy (J/m2) + real(r8) :: po(pcols) ! Dry Static energy (J/m2) real(r8) :: ke(pcols) ! kinetic energy (J/m2) real(r8) :: wv(pcols) ! column integrated vapor (kg/m2) real(r8) :: liq(pcols) ! column integrated liquid (kg/m2) @@ -1023,7 +1025,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) state%pdel(1:ncol,1:pver), cp_or_cv, & state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), temp(1:ncol,1:pver), & vc_loc, ps = state%ps(1:ncol), phis = state%phis(1:ncol), & - z_mid = state%z_ini(1:ncol,:), se = se, ke = ke, wv = wv, liq = liq, ice = ice) + z_mid = state%z_ini(1:ncol,:), se = se, po = po, ke = ke, wv = wv, liq = liq, ice = ice) call cnst_get_ind('TT_LW' , ixtt , abort=.false.) @@ -1049,7 +1051,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) end if end if - state%te_budgets(1:ncol,1,ind)=(se(1:ncol)+ke(1:ncol)) + state%te_budgets(1:ncol,1,ind)=(se(1:ncol)+ke(1:ncol)+po(1:ncol)) state%te_budgets(1:ncol,2,ind)=se(1:ncol) state%te_budgets(1:ncol,3,ind)=ke(1:ncol) state%te_budgets(1:ncol,4,ind)=wv(1:ncol) diff --git a/src/utils/cam_thermo.F90 b/src/utils/cam_thermo.F90 index 7f4e2d0344..127a4abd76 100644 --- a/src/utils/cam_thermo.F90 +++ b/src/utils/cam_thermo.F90 @@ -1524,7 +1524,7 @@ end subroutine cam_thermo_calc_kappav_2hd !*************************************************************************** ! subroutine get_hydrostatic_energy_1hd(tracer, pdel, cp_or_cv, U, V, T, & - vcoord, ps, phis, z_mid, dycore_idx, qidx, te, se, ke, & + vcoord, ps, phis, z_mid, dycore_idx, qidx, te, se, po, ke, & wv, H2O, liq, ice) use cam_logfile, only: iulog @@ -1557,8 +1557,12 @@ subroutine get_hydrostatic_energy_1hd(tracer, pdel, cp_or_cv, U, V, T, & real(r8), intent(out), optional :: te (:) ! KE: vertically integrated kinetic energy real(r8), intent(out), optional :: ke (:) - ! SE: vertically integrated internal+geopotential energy + ! SE: vertically integrated enthalpy (pressure coordinate) + ! or internal energy (z coordinate) real(r8), intent(out), optional :: se (:) + ! PO: vertically integrated PHIS term (pressure coordinate) + ! or potential enerhy (z coordinate) + real(r8), intent(out), optional :: po (:) ! WV: vertically integrated water vapor real(r8), intent(out), optional :: wv (:) ! liq: vertically integrated liquid @@ -1568,7 +1572,8 @@ subroutine get_hydrostatic_energy_1hd(tracer, pdel, cp_or_cv, U, V, T, & ! Local variables real(r8) :: ke_vint(SIZE(tracer, 1)) ! Vertical integral of KE - real(r8) :: se_vint(SIZE(tracer, 1)) ! Vertical integral of SE + real(r8) :: se_vint(SIZE(tracer, 1)) ! Vertical integral of enthalpy or internal energy + real(r8) :: po_vint(SIZE(tracer, 1)) ! Vertical integral of PHIS or potential energy real(r8) :: wv_vint(SIZE(tracer, 1)) ! Vertical integral of wv real(r8) :: liq_vint(SIZE(tracer, 1)) ! Vertical integral of liq real(r8) :: ice_vint(SIZE(tracer, 1)) ! Vertical integral of ice @@ -1640,7 +1645,7 @@ subroutine get_hydrostatic_energy_1hd(tracer, pdel, cp_or_cv, U, V, T, & end do end do do idx = 1, SIZE(tracer, 1) - se_vint(idx) = se_vint(idx) + (phis(idx) * ps(idx) / gravit) + po_vint(idx) = (phis(idx) * ps(idx) / gravit) end do case(vc_height) if (.not. present(z_mid)) then @@ -1651,6 +1656,7 @@ subroutine get_hydrostatic_energy_1hd(tracer, pdel, cp_or_cv, U, V, T, & end if ke_vint = 0._r8 se_vint = 0._r8 + po_vint = 0._r8 wv_vint = 0._r8 do kdx = 1, SIZE(tracer, 2) do idx = 1, SIZE(tracer, 1) @@ -1659,7 +1665,7 @@ subroutine get_hydrostatic_energy_1hd(tracer, pdel, cp_or_cv, U, V, T, & se_vint(idx) = se_vint(idx) + (T(idx, kdx) * & cp_or_cv(idx, kdx) * pdel(idx, kdx) / gravit) ! z_mid is height above ground - se_vint(idx) = se_vint(idx) + (z_mid(idx, kdx) + & + po_vint(idx) = po_vint(idx) + (z_mid(idx, kdx) + & phis(idx) / gravit) * pdel(idx, kdx) wv_vint(idx) = wv_vint(idx) + (tracer(idx, kdx, wvidx) * & pdel(idx, kdx) / gravit) @@ -1670,11 +1676,14 @@ subroutine get_hydrostatic_energy_1hd(tracer, pdel, cp_or_cv, U, V, T, & call endrun(subname//': vertical coordinate not supported') end select if (present(te)) then - te = se_vint + ke_vint + te = se_vint + po_vint+ ke_vint end if if (present(se)) then se = se_vint end if + if (present(po)) then + po = po_vint + end if if (present(ke)) then ke = ke_vint end if From 92b0e395de4b2155bdb3efcdbc7f07d28498523d Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Wed, 30 Nov 2022 15:09:50 -0700 Subject: [PATCH 041/140] typo --- src/dynamics/mpas/dycore_budget.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index 922dd28a29..452fcadc73 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -122,7 +122,7 @@ subroutine print_budget() ! end if write(iulog,*) "" write(iulog,*) "Is globally integrated total energy of state at the end of dynamics (dBF)" - write(iulog,*) "and beginning of physics (phBF) the same?" + write(iulog,*) "and beginning of physics (dyBF) the same?" write(iulog,*) "" call budget_get_global('dBF',1,E_dBF) !state passed to physics call budget_get_global('dyBF',1,E_dyBF)!state beginning physics From cbc0d29b340b8b0d33cb2d96881250e55dd91a8a Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Wed, 30 Nov 2022 16:20:35 -0700 Subject: [PATCH 042/140] minor addtions in dycore_budget.F90 --- src/dynamics/mpas/dycore_budget.F90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index 452fcadc73..8774e9841c 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -3,7 +3,7 @@ module dycore_budget implicit none public :: print_budget -real(r8), parameter :: eps = 1.0E-9_r8 +real(r8), parameter :: eps = 1.0E-10_r8 real(r8), save :: previous_dEdt_adiabatic_dycore = 0.0_r8 !========================================================================================= contains @@ -135,7 +135,7 @@ subroutine print_budget() write(iulog,*)"no. (dBF-dyBF)/dyBF =",diff write(iulog,*)"E_dBF=",E_dBF,"; E_dyBF=",E_dyBF write(iulog,*)"Error in physics dynamics coupling!" - call endrun('dycore_budget module: Error in physics dynamics coupling') +! call endrun('dycore_budget module: Error in physics dynamics coupling') end if end if write(iulog,*)" " @@ -177,13 +177,15 @@ subroutine print_budget() write(iulog,*)"dMASS/dt energy fixer (pBP-pBF) ",pEFIX," Pa" write(iulog,*)"dMASS/dt parameterizations (pAP-pBP) ",param," Pa" write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",pdmea," Pa" - write(iulog,*)"" - write(iulog,*)"" write(iulog,*)"dMass/dt physics total in MPAS (dAM-dBF) ",param_mpas," Pa" err = (param_mpas-param) + write(iulog,*)"" write(iulog,*)"Is mass budget closed? (pAP-pBP)-(dAM-dBF) ",err write(iulog,*)"---------------------------------------------------------------------------------------------------" write(iulog,*)" " + if (err>eps) then + call endrun('dycore_budget module: Error in mass budget') + end if end do end if end subroutine print_budget From adf8ea512603c1808e48c0ece74cd876d5e1707e Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Wed, 14 Dec 2022 16:35:12 -0700 Subject: [PATCH 043/140] fix bug in mass diagnostics in SE --- src/dynamics/se/dycore/prim_advance_mod.F90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index 3754f93746..1010874e1d 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -1658,7 +1658,8 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf fvm(ie)%budget(1:nc,1:nc,7,state_ind)=fvm(ie)%budget(1:nc,1:nc,7,state_ind)/gravit end if else - call util_function(elem(ie)%state%qdp(:,:,:,1,tl_qdp),np,nlev,name_out3,ie) + cdp = elem(ie)%state%qdp(:,:,:,1,tl_qdp) + call util_function(cdp,np,nlev,name_out3,ie) do j = 1, np do i = 1, np elem(ie)%derived%budget(i,j,4,state_ind) = elem(ie)%derived%budget(i,j,4,state_ind) + sum(cdp(i,j,:)/gravit) @@ -1672,7 +1673,7 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf do idx = 1,thermodynamic_active_species_liq_num cdp = cdp + elem(ie)%state%qdp(:,:,:,thermodynamic_active_species_liq_idx(idx),tl_qdp) end do - call util_function(elem(ie)%state%qdp(:,:,:,ixcldliq,tl_qdp),np,nlev,name_out4,ie) + call util_function(cdp,np,nlev,name_out4,ie) do j = 1, np do i = 1, np elem(ie)%derived%budget(i,j,5,state_ind) = elem(ie)%derived%budget(i,j,5,state_ind) + sum(cdp(i,j,:)/gravit) @@ -1687,7 +1688,7 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf do idx = 1,thermodynamic_active_species_ice_num cdp = cdp + elem(ie)%state%qdp(:,:,:,thermodynamic_active_species_ice_idx(idx),tl_qdp) end do - call util_function(elem(ie)%state%qdp(:,:,:,ixcldice,tl_qdp),np,nlev,name_out5,ie) + call util_function(cdp,np,nlev,name_out5,ie) do j = 1, np do i = 1, np elem(ie)%derived%budget(i,j,6,state_ind) = elem(ie)%derived%budget(i,j,6,state_ind) + sum(cdp(i,j,:)/gravit) @@ -1695,7 +1696,8 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf end do end if if (ixtt>0) then - call util_function(elem(ie)%state%qdp(:,:,:,ixtt ,tl_qdp),np,nlev,name_out6,ie) + cdp = elem(ie)%state%qdp(:,:,:,ixtt ,tl_qdp) + call util_function(cdp,np,nlev,name_out6,ie) do j = 1, np do i = 1, np elem(ie)%derived%budget(i,j,7,state_ind) = elem(ie)%derived%budget(i,j,7,state_ind) + sum(cdp(i,j,:)/gravit) From 64aefc11ccbf1b73ffc1d97b1513c33574e33d40 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 16 Dec 2022 07:19:11 -0700 Subject: [PATCH 044/140] switch to generalized virtual temperature (closes MPAS energy budget) --- src/dynamics/eul/dp_coupling.F90 | 2 +- src/dynamics/fv/dp_coupling.F90 | 2 +- src/dynamics/fv3/dp_coupling.F90 | 2 +- src/dynamics/mpas/dp_coupling.F90 | 22 +++++---- src/dynamics/mpas/dycore_budget.F90 | 11 +++-- src/dynamics/se/dp_coupling.F90 | 2 +- src/physics/cam/check_energy.F90 | 2 +- src/physics/cam/geopotential.F90 | 74 +++++++++++++++++++++++++++-- src/physics/cam/physics_types.F90 | 2 +- 9 files changed, 97 insertions(+), 22 deletions(-) diff --git a/src/dynamics/eul/dp_coupling.F90 b/src/dynamics/eul/dp_coupling.F90 index 946c66b092..bc900e2d0e 100644 --- a/src/dynamics/eul/dp_coupling.F90 +++ b/src/dynamics/eul/dp_coupling.F90 @@ -269,7 +269,7 @@ subroutine d_p_coupling(ps, t3, u3, v3, q3, & ! Compute initial geopotential heights call geopotential_t (phys_state(lchnk)%lnpint, phys_state(lchnk)%lnpmid , phys_state(lchnk)%pint , & phys_state(lchnk)%pmid , phys_state(lchnk)%pdel , phys_state(lchnk)%rpdel , & - phys_state(lchnk)%t , phys_state(lchnk)%q(:,:,1), rairv(:,:,lchnk), gravit, zvirv, & + phys_state(lchnk)%t , phys_state(lchnk)%q(:,:,:), rairv(:,:,lchnk), gravit, zvirv, & phys_state(lchnk)%zi , phys_state(lchnk)%zm , ncol ) ! Compute initial dry static energy, include surface geopotential diff --git a/src/dynamics/fv/dp_coupling.F90 b/src/dynamics/fv/dp_coupling.F90 index 4f109bf2ee..db8519619c 100644 --- a/src/dynamics/fv/dp_coupling.F90 +++ b/src/dynamics/fv/dp_coupling.F90 @@ -596,7 +596,7 @@ subroutine d_p_coupling(grid, phys_state, phys_tend, pbuf2d, dyn_out) ! Compute initial geopotential heights call geopotential_t (phys_state(lchnk)%lnpint, phys_state(lchnk)%lnpmid , phys_state(lchnk)%pint , & phys_state(lchnk)%pmid , phys_state(lchnk)%pdel , phys_state(lchnk)%rpdel , & - phys_state(lchnk)%t , phys_state(lchnk)%q(:,:,1), rairv(:,:,lchnk), gravit, zvirv, & + phys_state(lchnk)%t , phys_state(lchnk)%q(:,:,:), rairv(:,:,lchnk), gravit, zvirv, & phys_state(lchnk)%zi , phys_state(lchnk)%zm , ncol ) ! Compute initial dry static energy, include surface geopotential diff --git a/src/dynamics/fv3/dp_coupling.F90 b/src/dynamics/fv3/dp_coupling.F90 index 2eb69c448e..3b7fcca69b 100644 --- a/src/dynamics/fv3/dp_coupling.F90 +++ b/src/dynamics/fv3/dp_coupling.F90 @@ -733,7 +733,7 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) ! Compute initial geopotential heights - based on full pressure call geopotential_t (phys_state(lchnk)%lnpint, phys_state(lchnk)%lnpmid , phys_state(lchnk)%pint , & phys_state(lchnk)%pmid , phys_state(lchnk)%pdel , phys_state(lchnk)%rpdel , & - phys_state(lchnk)%t , phys_state(lchnk)%q(:,:,1), rairv(:,:,lchnk), gravit, zvirv , & + phys_state(lchnk)%t , phys_state(lchnk)%q(:,:,:), rairv(:,:,lchnk), gravit, zvirv , & phys_state(lchnk)%zi , phys_state(lchnk)%zm , ncol ) ! Compute initial dry static energy, include surface geopotential diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index 7ad25feece..b26a783ca7 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -465,7 +465,7 @@ subroutine derived_phys(phys_state, phys_tend, pbuf2d) call geopotential_t( & phys_state(lchnk)%lnpint, phys_state(lchnk)%lnpmid, phys_state(lchnk)%pint, & phys_state(lchnk)%pmid, phys_state(lchnk)%pdel, phys_state(lchnk)%rpdel, & - phys_state(lchnk)%t, phys_state(lchnk)%q(:,:,1), rairv(:,:,lchnk), gravit, zvirv, & + phys_state(lchnk)%t, phys_state(lchnk)%q(:,:,:), rairv(:,:,lchnk), gravit, zvirv, & phys_state(lchnk)%zi, phys_state(lchnk)%zm, ncol) ! Compute initial dry static energy, include surface geopotential @@ -722,7 +722,7 @@ subroutine hydrostatic_pressure(nCells, nVertLevels, qsize, index_qv, zz, zgrid, #else real(r8), dimension(nVertLevels+1,nCells) :: pint ! hydrostatic pressure at interface #endif - real(r8) :: pi, t + real(r8) :: pi, t, sum_water real(r8) :: pk,rhok,rhodryk,theta,thetavk,kap1,kap2,tvk,tk ! ! For each column, integrate downward from model top to compute dry hydrostatic pressure at layer @@ -765,8 +765,6 @@ subroutine hydrostatic_pressure(nCells, nVertLevels, qsize, index_qv, zz, zgrid, end do end do #else - kap1 = p0**(-rgas/cp) ! pre-compute constants - kap2 = cp/cv ! pre-compute constants do iCell = 1, nCells dz(:) = zgrid(2:nVertLevels+1,iCell) - zgrid(1:nVertLevels,iCell) do k = nVertLevels, 1, -1 @@ -786,9 +784,13 @@ subroutine hydrostatic_pressure(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rhok = rhok+q(thermodynamic_active_species_idx_dycore(idx),k,iCell) end do rhok = rhok*zz(k,iCell) * rho_zz(k,iCell) - thetavk = theta_m(k,iCell)/ (1.0_r8 + q(index_qv,k,iCell)) !convert modified theta to virtual theta + sum_water = 1.0_r8 + do idx=1,thermodynamic_active_species_num + sum_water = sum_water+q(thermodynamic_active_species_idx_dycore(idx),k,iCell) + end do + thetavk = theta_m(k,iCell)/sum_water tvk = thetavk*exner(k,iCell) - pk = (rhok*rgas*thetavk*kap1)**kap2 !mid-level top pressure + pk = dp(k)*rgas*tvk/(gravit*dz(k)) ! ! model top pressure consistently diagnosed using the assumption that the mid level ! is at height z(nVertLevels-1)+0.5*dz @@ -799,9 +801,13 @@ subroutine hydrostatic_pressure(nCells, nVertLevels, qsize, index_qv, zz, zgrid, ! ! compute hydrostatic dry interface pressure so that (pintdry(k+1)-pintdry(k))/g is pseudo density ! - thetavk = theta_m(k,iCell)/ (1.0_r8 + q(index_qv,k,iCell)) !convert modified theta to virtual theta + sum_water = 1.0_r8 + do idx=1,thermodynamic_active_species_num + sum_water = sum_water+q(thermodynamic_active_species_idx_dycore(idx),k,iCell) + end do + thetavk = theta_m(k,iCell)/sum_water! (1.0_r8 + q(index_qv,k,iCell)) !convert modified theta to virtual theta tvk = thetavk*exner(k,iCell) - tk = tvk*(1.0_r8+q(index_qv,k,iCell))/(1.0_r8+Rv_over_Rd*q(index_qv,k,iCell)) + tk = tvk*sum_water/(1.0_r8+Rv_over_Rd*q(index_qv,k,iCell)) pint (k,iCell) = pint (k+1,iCell)+dp(k) pintdry(k,iCell) = pintdry(k+1,iCell)+dpdry(k) pmid(k,iCell) = dp(k) *rgas*tvk/(gravit*dz(k)) diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index 8774e9841c..eae3288f8d 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -3,7 +3,7 @@ module dycore_budget implicit none public :: print_budget -real(r8), parameter :: eps = 1.0E-10_r8 +real(r8), parameter :: eps = 1.0E-11_r8 real(r8), save :: previous_dEdt_adiabatic_dycore = 0.0_r8 !========================================================================================= contains @@ -120,7 +120,11 @@ subroutine print_budget() ! call endrun('dycore_budget module: physics energy budget consistency error 2') ! end if ! end if - write(iulog,*) "" + write(iulog,*) " " + write(iulog,*) "------------------------------------------------------------" + write(iulog,*) " Consistency checks" + write(iulog,*) "------------------------------------------------------------" + write(iulog,*) " " write(iulog,*) "Is globally integrated total energy of state at the end of dynamics (dBF)" write(iulog,*) "and beginning of physics (dyBF) the same?" write(iulog,*) "" @@ -184,7 +188,8 @@ subroutine print_budget() write(iulog,*)"---------------------------------------------------------------------------------------------------" write(iulog,*)" " if (err>eps) then - call endrun('dycore_budget module: Error in mass budget') + write(iulog,*)" MASS BUDGET ERROR" +!xxx call endrun('dycore_budget module: Error in mass budget') end if end do end if diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index 1eabbbb3d0..47243577a0 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -700,7 +700,7 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) ! Compute initial geopotential heights - based on full pressure call geopotential_t (phys_state(lchnk)%lnpint, phys_state(lchnk)%lnpmid , phys_state(lchnk)%pint , & phys_state(lchnk)%pmid , phys_state(lchnk)%pdel , phys_state(lchnk)%rpdel , & - phys_state(lchnk)%t , phys_state(lchnk)%q(:,:,1), rairv(:,:,lchnk), gravit, zvirv , & + phys_state(lchnk)%t , phys_state(lchnk)%q(:,:,:), rairv(:,:,lchnk), gravit, zvirv , & phys_state(lchnk)%zi , phys_state(lchnk)%zm , ncol ) ! Compute initial dry static energy, include surface geopotential diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index fb27a48495..68d70ce5dd 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -1051,7 +1051,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) end if end if - state%te_budgets(1:ncol,1,ind)=(se(1:ncol)+ke(1:ncol)+po(1:ncol)) + state%te_budgets(1:ncol,1,ind)=se(1:ncol)+ke(1:ncol)+po(1:ncol) state%te_budgets(1:ncol,2,ind)=se(1:ncol) state%te_budgets(1:ncol,3,ind)=ke(1:ncol) state%te_budgets(1:ncol,4,ind)=wv(1:ncol) diff --git a/src/physics/cam/geopotential.F90 b/src/physics/cam/geopotential.F90 index b06b145e51..cbc7131f6a 100644 --- a/src/physics/cam/geopotential.F90 +++ b/src/physics/cam/geopotential.F90 @@ -132,7 +132,7 @@ subroutine geopotential_t( & !----------------------------------------------------------------------- use ppgrid, only : pcols - +use air_composition, only: thermodynamic_active_species_num,thermodynamic_active_species_idx !------------------------------Arguments-------------------------------- ! ! Input arguments @@ -146,7 +146,7 @@ subroutine geopotential_t( & real(r8), intent(in) :: pdel (:,:) ! (pcols,pver) - layer thickness real(r8), intent(in) :: rpdel(:,:) ! (pcols,pver) - inverse of layer thickness real(r8), intent(in) :: t (:,:) ! (pcols,pver) - temperature - real(r8), intent(in) :: q (:,:) ! (pcols,pver) - specific humidity + real(r8), intent(in) :: q (:,:,:) ! (pcols,pver,:)- tracers (moist mixing ratios) real(r8), intent(in) :: rair (:,:) ! (pcols,pver) - Gas constant for dry air real(r8), intent(in) :: gravit ! - Acceleration of gravity real(r8), intent(in) :: zvir (:,:) ! (pcols,pver) - rh2o/rair - 1 @@ -158,12 +158,15 @@ subroutine geopotential_t( & ! !---------------------------Local variables----------------------------- ! - integer :: i,k ! Lon, level indices + integer :: i,k,idx ! Lon, level indices, water species index real(r8) :: hkk(ncol) ! diagonal element of hydrostatic matrix real(r8) :: hkl(ncol) ! off-diagonal element real(r8) :: rog(ncol,pver) ! Rair / gravit real(r8) :: tv ! virtual temperature real(r8) :: tvfac ! Tv/T + real(r8) :: qfac(ncol,pver) ! factor to convert from wet to dry mixing ratio + real(r8) :: sum_dry_mixing_ratio(ncol,pver)! sum of dry water mixing ratios + ! !----------------------------------------------------------------------- ! @@ -174,7 +177,7 @@ subroutine geopotential_t( & do i = 1,ncol zi(i,pverp) = 0.0_r8 end do - +#ifdef phl_cam_development ! Compute zi, zm from bottom up. ! Note, zi(i,k) is the interface above zm(i,k) @@ -201,14 +204,75 @@ subroutine geopotential_t( & ! Now compute tv, zm, zi do i = 1,ncol - tvfac = 1._r8 + zvir(i,k) * q(i,k) + tvfac = 1._r8 + zvir(i,k) * q(i,k,1) tv = t(i,k) * tvfac zm(i,k) = zi(i,k+1) + rog(i,k) * tv * hkk(i) zi(i,k) = zi(i,k+1) + rog(i,k) * tv * hkl(i) end do end do +#else + ! + ! For the computation of generalized virtual temperature (equation 16 + ! in Lauritzen et al. (2018); https://doi.org/10.1029/2017MS001257) + ! + + ! Compute factor for converting wet to dry mixing ratio + qfac = 1.0_r8 + do idx = 1,thermodynamic_active_species_num + do k = 1,pver + do i = 1,ncol + qfac(i,k) = qfac(i,k)-q(i,k,thermodynamic_active_species_idx(idx)) + end do + end do + end do + qfac = 1.0_r8/qfac + + ! Compute sum of dry water mixing ratios + sum_dry_mixing_ratio = 1.0_r8 + do idx = 1,thermodynamic_active_species_num + do k = 1,pver + do i = 1,ncol + sum_dry_mixing_ratio(i,k) = sum_dry_mixing_ratio(i,k)& + +q(i,k,thermodynamic_active_species_idx(idx))*qfac(i,k) + end do + end do + end do + sum_dry_mixing_ratio(:,:) = 1.0_r8/sum_dry_mixing_ratio(:,:) + +! Compute zi, zm from bottom up. +! Note, zi(i,k) is the interface above zm(i,k) + do k = pver, 1, -1 +! First set hydrostatic elements consistent with dynamics + + if ((dycore_is('LR') .or. dycore_is('FV3'))) then + do i = 1,ncol + hkl(i) = piln(i,k+1) - piln(i,k) + hkk(i) = 1._r8 - pint(i,k) * hkl(i) * rpdel(i,k) + end do + else!MPAS, SE or EUL + ! + ! For EUL and SE: pmid = 0.5*(pint(k+1)+pint(k)) + ! For MPAS : pmid is computed from theta_m, rhodry, etc. + ! + do i = 1,ncol + hkl(i) = pdel(i,k) / pmid(i,k) + hkk(i) = 0.5_r8 * hkl(i) + end do + end if + +! Now compute tv, zm, zi + + do i = 1,ncol + tvfac = (1._r8 + (zvir(i,k)+1.0_r8) * q(i,k,1)*qfac(i,k))*sum_dry_mixing_ratio(i,k) + tv = t(i,k) * tvfac + + zm(i,k) = zi(i,k+1) + rog(i,k) * tv * hkk(i) + zi(i,k) = zi(i,k+1) + rog(i,k) * tv * hkl(i) + end do + end do +#endif return end subroutine geopotential_t end module geopotential diff --git a/src/physics/cam/physics_types.F90 b/src/physics/cam/physics_types.F90 index c8cf372ab6..32112761c0 100644 --- a/src/physics/cam/physics_types.F90 +++ b/src/physics/cam/physics_types.F90 @@ -430,7 +430,7 @@ subroutine physics_update(state, ptend, dt, tend) if (ptend%ls .or. ptend%lq(1)) then call geopotential_t ( & state%lnpint, state%lnpmid, state%pint , state%pmid , state%pdel , state%rpdel , & - state%t , state%q(:,:,1), rairv_loc(:,:), gravit , zvirv , & + state%t , state%q(:,:,:), rairv_loc(:,:), gravit , zvirv , & state%zi , state%zm , ncol ) ! update dry static energy for use in next process do k = ptend%top_level, ptend%bot_level From edfba48b30fe9af32ad50a42c3fc5844584b152c Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 16 Dec 2022 13:46:27 -0700 Subject: [PATCH 045/140] update budget/state indexes --- src/dynamics/mpas/dp_coupling.F90 | 14 +++---- src/dynamics/se/dycore/prim_advance_mod.F90 | 46 ++++++++++----------- src/physics/cam/check_energy.F90 | 20 ++++----- 3 files changed, 40 insertions(+), 40 deletions(-) diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index 7ad25feece..a620d02ecc 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -898,18 +898,18 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t ! reset all when cnt is 0 write(iulog,*)'dpc calc se,ke ',s_ind,',1:3,1 is ',internal_energy(1),' ',kinetic_energy(1) write(iulog,*)'dpc budgets initial ',s_ind,',1:3,1 is ',te_budgets(s_ind,1,1),' ',te_budgets(s_ind,2,1),' ',te_budgets(s_ind,3,1) - if (budgets_cnt(s_ind) == 0) then - budgets_subcycle_cnt(s_ind) = 0 + if (budgets_cnt(b_ind) == 0) then + budgets_subcycle_cnt(b_ind) = 0 te_budgets(s_ind,:,:)=0.0_r8 end if if (b_subcycle) then - budgets_subcycle_cnt(s_ind) = budgets_subcycle_cnt(s_ind) + 1 - if (budgets_subcycle_cnt(s_ind) == 1) then - budgets_cnt(s_ind) = budgets_cnt(s_ind) + 1 + budgets_subcycle_cnt(b_ind) = budgets_subcycle_cnt(b_ind) + 1 + if (budgets_subcycle_cnt(b_ind) == 1) then + budgets_cnt(b_ind) = budgets_cnt(b_ind) + 1 end if else - budgets_cnt(s_ind) = budgets_cnt(s_ind) + 1 - budgets_subcycle_cnt(s_ind) = 1 + budgets_cnt(b_ind) = budgets_cnt(b_ind) + 1 + budgets_subcycle_cnt(b_ind) = 1 !not subcycling so don't sum just replace previous budget values te_budgets(s_ind,:,:)=0._r8 end if diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index 1010874e1d..60f1e3225c 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -1566,24 +1566,25 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf ! could store pointer to dyn/phys state index inside of budget and call budget_state_update pass in se,ke etc. call budget_info_byname(trim(outfld_name_suffix),budget_ind=budget_ind,state_ind=state_ind) ! reset all when cnt is 0 -!jt if (ie.eq.nets) write(iulog,*)'calc_tot before:',trim(outfld_name_suffix),' cnt/sub=',elem(nets)%derived%budget_cnt(state_ind),'/',elem(nets)%derived%budget_subcycle(state_ind) - if (elem(ie)%derived%budget_cnt(state_ind) == 0) then - elem(ie)%derived%budget_subcycle(state_ind) = 0 + + if (elem(ie)%derived%budget_cnt(budget_ind) == 0) then + if (ie.eq.nets) write(iulog,*)'cnt = 0;resetting :',trim(outfld_name_suffix) + elem(ie)%derived%budget_subcycle(budget_ind) = 0 elem(ie)%derived%budget(:,:,:,state_ind)=0.0_r8 end if if (present(subcycle)) then if (subcycle) then - elem(ie)%derived%budget_subcycle(state_ind) = elem(ie)%derived%budget_subcycle(state_ind) + 1 - if (elem(ie)%derived%budget_subcycle(state_ind) == 1) then - elem(ie)%derived%budget_cnt(state_ind) = elem(ie)%derived%budget_cnt(state_ind) + 1 + elem(ie)%derived%budget_subcycle(budget_ind) = elem(ie)%derived%budget_subcycle(budget_ind) + 1 + if (elem(ie)%derived%budget_subcycle(budget_ind) == 1) then + elem(ie)%derived%budget_cnt(budget_ind) = elem(ie)%derived%budget_cnt(budget_ind) + 1 end if else - elem(ie)%derived%budget_cnt(state_ind) = elem(ie)%derived%budget_cnt(state_ind) + 1 - elem(ie)%derived%budget_subcycle(state_ind) = 1 + elem(ie)%derived%budget_cnt(budget_ind) = elem(ie)%derived%budget_cnt(budget_ind) + 1 + elem(ie)%derived%budget_subcycle(budget_ind) = 1 end if else - elem(ie)%derived%budget_cnt(state_ind) = elem(ie)%derived%budget_cnt(state_ind) + 1 - elem(ie)%derived%budget_subcycle(state_ind) = 1 + elem(ie)%derived%budget_cnt(budget_ind) = elem(ie)%derived%budget_cnt(budget_ind) + 1 + elem(ie)%derived%budget_subcycle(budget_ind) = 1 end if do j=1,np do i = 1, np @@ -1592,7 +1593,6 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf elem(ie)%derived%budget(i,j,3,state_ind) = elem(ie)%derived%budget(i,j,3,state_ind) + ke(i+(j-1)*np) end do end do -!jt if (ie.eq.nets) write(iulog,*)'calc_tot after:',trim(outfld_name_suffix),' cnt/sub=',elem(nets)%derived%budget_cnt(state_ind),'/',elem(nets)%derived%budget_subcycle(state_ind) ! ! Output energy diagnostics on GLL grid ! @@ -1783,7 +1783,7 @@ subroutine calc_tot_energy_dynamics_diff(elem,fvm,nets,nete,tl,tl_qdp,outfld_nam !---------------------------Local storage------------------------------- - integer :: ie,ixtt,b_ind,s_ind,is1,is2 + integer :: ie,ixtt,b_ind,s_ind,is1,is2,isb1,isb2 character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 real(r8), allocatable, dimension(:,:,:,:) :: tmp,tmp1,tmp2 character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn @@ -1805,29 +1805,29 @@ subroutine calc_tot_energy_dynamics_diff(elem,fvm,nets,nete,tl,tl_qdp,outfld_nam allocate(tmp1(np,np,9,nets:nete)) allocate(tmp2(np,np,9,nets:nete)) b_ind=budget_ind_byname(trim(outfld_name_suffix)) - call budget_info(b_ind,stg1stateidx=is1, stg2stateidx=is2, optype=budget_optype, pkgtype=budget_pkgtype,state_ind=s_ind) + call budget_info(b_ind,stg1stateidx=is1, stg2stateidx=is2,stg1index=isb1, stg2index=isb2, optype=budget_optype, pkgtype=budget_pkgtype,state_ind=s_ind) do ie=nets,nete ! advance budget_cnt if (present(subcycle)) then if (subcycle) then ! reset subcycle when cnt is 0 - if (elem(ie)%derived%budget_cnt(s_ind) == 0) then - elem(ie)%derived%budget_subcycle(s_ind) = 0 + if (elem(ie)%derived%budget_cnt(b_ind) == 0) then + elem(ie)%derived%budget_subcycle(b_ind) = 0 elem(ie)%derived%budget(:,:,:,s_ind)=0.0_r8 end if - elem(ie)%derived%budget_subcycle(s_ind) = elem(ie)%derived%budget_subcycle(s_ind) + 1 - if (elem(ie)%derived%budget_subcycle(s_ind) == 1) then - elem(ie)%derived%budget_cnt(s_ind) = elem(ie)%derived%budget_cnt(s_ind) + 1 + elem(ie)%derived%budget_subcycle(b_ind) = elem(ie)%derived%budget_subcycle(b_ind) + 1 + if (elem(ie)%derived%budget_subcycle(b_ind) == 1) then + elem(ie)%derived%budget_cnt(b_ind) = elem(ie)%derived%budget_cnt(b_ind) + 1 end if else - elem(ie)%derived%budget_cnt(s_ind) = elem(ie)%derived%budget_cnt(s_ind) + 1 - elem(ie)%derived%budget_subcycle(s_ind) = 1 + elem(ie)%derived%budget_cnt(b_ind) = elem(ie)%derived%budget_cnt(b_ind) + 1 + elem(ie)%derived%budget_subcycle(b_ind) = 1 end if else - elem(ie)%derived%budget_cnt(s_ind) = elem(ie)%derived%budget_cnt(s_ind) + 1 - elem(ie)%derived%budget_subcycle(s_ind) = 1 + elem(ie)%derived%budget_cnt(b_ind) = elem(ie)%derived%budget_cnt(b_ind) + 1 + elem(ie)%derived%budget_subcycle(b_ind) = 1 end if - if (elem(ie)%derived%budget_cnt(is1)==0.or.elem(ie)%derived%budget_cnt(is2)==0) then + if (elem(ie)%derived%budget_cnt(isb1)==0.or.elem(ie)%derived%budget_cnt(isb2)==0) then tmp(:,:,:,ie)=0._r8 else tmp1(:,:,:,ie)=elem(ie)%derived%budget(:,:,:,is1) diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index fb27a48495..fcd4363e99 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -974,7 +974,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) integer :: ncol ! number of atmospheric columns integer :: i,k ! column, level indices integer :: vc_loc ! local vertical coordinate variable - integer :: ind,budget_ind ! budget array index + integer :: s_ind,b_ind ! budget array index integer :: ixtt ! test tracer index character(len=32) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 !----------------------------------------------------------------------- @@ -992,7 +992,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) lchnk = state%lchnk ncol = state%ncol - call budget_info_byname(trim(outfld_name_suffix),budget_ind=budget_ind,state_ind=ind) + call budget_info_byname(trim(outfld_name_suffix),budget_ind=b_ind,state_ind=s_ind) if (present(vc)) then vc_loc = vc @@ -1051,14 +1051,14 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) end if end if - state%te_budgets(1:ncol,1,ind)=(se(1:ncol)+ke(1:ncol)+po(1:ncol)) - state%te_budgets(1:ncol,2,ind)=se(1:ncol) - state%te_budgets(1:ncol,3,ind)=ke(1:ncol) - state%te_budgets(1:ncol,4,ind)=wv(1:ncol) - state%te_budgets(1:ncol,5,ind)=liq(1:ncol) - state%te_budgets(1:ncol,6,ind)=ice(1:ncol) - state%te_budgets(1:ncol,7,ind)=tt(1:ncol) - state%budget_cnt(ind)=state%budget_cnt(ind)+1 + state%te_budgets(1:ncol,1,s_ind)=(se(1:ncol)+ke(1:ncol)+po(1:ncol)) + state%te_budgets(1:ncol,2,s_ind)=se(1:ncol) + state%te_budgets(1:ncol,3,s_ind)=ke(1:ncol) + state%te_budgets(1:ncol,4,s_ind)=wv(1:ncol) + state%te_budgets(1:ncol,5,s_ind)=liq(1:ncol) + state%te_budgets(1:ncol,6,s_ind)=ice(1:ncol) + state%te_budgets(1:ncol,7,s_ind)=tt(1:ncol) + state%budget_cnt(b_ind)=state%budget_cnt(b_ind)+1 ! Output energy diagnostics call outfld(name_out1 ,se , pcols ,lchnk ) From de1b3f3a1d94a25af4505272e0e8683aacca60a4 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 16 Dec 2022 16:13:17 -0700 Subject: [PATCH 046/140] improve log file output for MPAS --- src/dynamics/mpas/dycore_budget.F90 | 199 ++++++++++++++++------------ 1 file changed, 117 insertions(+), 82 deletions(-) diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index eae3288f8d..b54e8274f8 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -31,7 +31,10 @@ subroutine print_budget() real(r8) :: mpas_param,mpas_dmea,mpas_phys_total, dycore, err, param, pefix, pdmea, param_mpas, phys_total real(r8) :: E_dBF, E_dyBF real(r8) :: diff - integer :: m_cnst + integer :: m_cnst + character(LEN=*), parameter :: fmt = "(a40,F6.2,a1,F6.2,a1,E10.2,a4)" + character(LEN=*), parameter :: fmt2 = "(a40,F6.2,a3)" + character(LEN=5) :: pf! pass or fail identifier !-------------------------------------------------------------------------------------- if (masterproc) then @@ -52,52 +55,90 @@ subroutine print_budget() call budget_get_global('dAM-dBF',1,mpas_phys_total) write(iulog,*)" " - write(iulog,*)" Total energy diagnostics introduced in Lauritzen and Williamson (2019)" - write(iulog,*)" (DOI:10.1029/2018MS001549)" - write(iulog,*)" " - write(iulog,*)"------------------------------------------------------------" - write(iulog,*)"Physics time loop" - write(iulog,*)"------------------------------------------------------------" - write(iulog,*)" " - write(iulog,*)"phBF: state passed to parameterizations, before energy fixer" - write(iulog,*)"phBP: after energy fixer, before parameterizations" - write(iulog,*)"phAP: after last phys_update in parameterizations and state " - write(iulog,*)" saved for energy fixer" - write(iulog,*)"phAM: after dry mass correction" - write(iulog,*)"history files saved off here" - write(iulog,*)" " - write(iulog,*)"------------------------------------------------------------" - write(iulog,*)" CAM physics energy tendencies (using pressure coordinate) " - write(iulog,*)"------------------------------------------------------------" - write(iulog,*)" " - write(iulog,'(a40,F6.2,a6)')"dE/dt energy fixer (phBP-phBF) ",ph_EFIX," W/M^2" - write(iulog,'(a40,F6.2,a6)')"dE/dt all parameterizations (phAP-phBP) ",ph_param," W/M^2" - write(iulog,'(a40,F6.2,a6)')"dE/dt dry mass adjustment (phAM-phAP) ",ph_dmea," W/M^2" - write(iulog,'(a40,F6.2,a6)')"dE/dt physics total (phAM-phBF) ",ph_phys_total," W/M^2" - write(iulog,*)" " - write(iulog,*)" " - write(iulog,*)"------------------------------------------------------------" - write(iulog,*)" CAM physics energy tendencies (using z coordinate) " - write(iulog,*)"------------------------------------------------------------" - write(iulog,*)" " - write(iulog,'(a40,F6.2,a6)')"dE/dt energy fixer (dyBP-dyBF) ",dy_EFIX," W/M^2" - write(iulog,'(a40,F6.2,a6)')"dE/dt all parameterizations (dyAP-dyBP) ",dy_param," W/M^2" - write(iulog,'(a40,F6.2,a6)')"dE/dt dry mass adjustment (dyAM-dyAP) ",dy_dmea," W/M^2" - write(iulog,'(a40,F6.2,a6)')"dE/dt physics total (dyAM-dyBF) ",dy_phys_total," W/M^2" - write(iulog,*)" " - dycore = -dy_EFIX-dy_dmea - write(iulog,*)"Dycore TE dissipation estimated from physics with dycore energy ",dycore," W/M^2" - write(iulog,*)"(assuming no physics-dynamics coupling errors; -efix-dme_adjust) " + write(iulog,*)"======================================================================" + write(iulog,*)"Total energy diagnostics introduced in Lauritzen and Williamson (2019)" + write(iulog,*)"(DOI:10.1029/2018MS001549)" + write(iulog,*)"======================================================================" + write(iulog,*)" " + write(iulog,*)"Globally and vertically integrated total energy (E) diagnostics are" + write(iulog,*)"computed at various points in the physics and dynamics loops to compute" + write(iulog,*)"energy tendencies (dE/dt) and check for consistency (e.g., is E of" + write(iulog,*)"state passed to physics computed using dycore state variables the same" + write(iulog,*)"E of the state in the beginning of physics computed using the physics" + write(iulog,*)"representation of the state)" + write(iulog,*)" " + write(iulog,*)"Energy stages in physics:" + write(iulog,*)"-------------------------" + write(iulog,*)" " + write(iulog,*)" xxBF: state passed to parameterizations, before energy fixer" + write(iulog,*)" xxBP: after energy fixer, before parameterizations" + write(iulog,*)" xxAP: after last phys_update in parameterizations and state " + write(iulog,*)" saved for energy fixer" + write(iulog,*)" xxAM: after dry mass adjustment" + write(iulog,*)" history files saved off here" + write(iulog,*)" " + write(iulog,*)"where xx='ph','dy' " + write(iulog,*)" " + write(iulog,*)"Suffix ph is CAM physics total energy" + write(iulog,*)"(eq. 111 in Lauritzen et al. 2022; 10.1029/2022MS003117)" write(iulog,*)" " + write(iulog,*)"Suffix dy is dycore energy computed in CAM physics using" + write(iulog,*)"CAM physics state variables" + write(iulog,*)" " + write(iulog,*)"Energy stages in dynamics" + write(iulog,*)"-------------------------" + write(iulog,*)" " + write(iulog,*)" dBF: dynamics state before physics (d_p_coupling)" + write(iulog,*)" dAP: dynamics state with T,u,V increment but not incl water changes" + write(iulog,*)" dAM: dynamics state with full physics increment (incl. water)" + write(iulog,*)" " + write(iulog,*)"Note that these energies are computed using the dynamical core" + write(iulog,*)"state variables which may be different from the physics prognostic" + write(iulog,*)"variables." + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)"Consistency check 0:" + write(iulog,*)"--------------------" + write(iulog,*)" " + write(iulog,*)"For energetic consistency we require that dE/dt [W/m^2] from energy " + write(iulog,*)"fixer and all parameterizations computed using physics E and" + write(iulog,*)"dycore in physics E are the same! Checking:" + write(iulog,*)" " + write(iulog,*) " xx=ph xx=dy norm. diff." + write(iulog,*) " ----- ----- -----------" + diff = abs_diff(ph_EFIX,dy_EFIX,pf=pf) + write(iulog,fmt)"dE/dt energy fixer (xxBP-xxBF) ",ph_EFIX, " ",dy_EFIX," ",diff,pf + diff = abs_diff(ph_param,dy_param,pf=pf) + write(iulog,fmt)"dE/dt all parameterizations (xxAP-xxBP) ",ph_param, " ",dy_param," ",diff,pf + if (diff>eps) write(iulog,*)"FAIL" + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)"dE/dt from dry-mass adjustment will differ if dynamics and physics use" + write(iulog,*)"different energy definitions! Checking:" + write(iulog,*)" " + diff = ph_dmea-dy_dmea + write(iulog,*) " xx=ph xx=dy difference" + write(iulog,*) " ----- ----- -----------" + write(iulog,fmt)"dE/dt dry mass adjustment (xxAM-xxAP) ",ph_dmea, " ",dy_dmea," ",diff + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)"Some energy budget observations:" + write(iulog,*)"--------------------------------" + write(iulog,*)" " + write(iulog,*)"Note that total energy fixer fixes:" write(iulog,*) " " write(iulog,*) "-dE/dt energy fixer = dE/dt dry mass adjustment +" write(iulog,*) " dE/dt dycore +" - write(iulog,*) " dE/dt physics-dynamics coupling errors +" - write(iulog,*) " dE/dt energy formula differences " + write(iulog,*) " dE/dt physics-dynamics coupling errors" write(iulog,*) " " write(iulog,*) "(equation 23 in Lauritzen and Williamson (2019))" write(iulog,*) " " + dycore = -dy_EFIX-dy_dmea + write(iulog,*)"Hence the dycore E dissipation estimated from energy fixer is ",dycore," W/M^2" + write(iulog,*)"(assuming no physics-dynamics coupling errors)" + write(iulog,*)" " + ! dycore = -ph_EFIX-ph_dmea ! dycore = -ph_EFIX-previous_dEdt_dry_mass_adjust ! write(iulog,*) "" @@ -121,9 +162,9 @@ subroutine print_budget() ! end if ! end if write(iulog,*) " " - write(iulog,*) "------------------------------------------------------------" - write(iulog,*) " Consistency checks" - write(iulog,*) "------------------------------------------------------------" + write(iulog,*) "-------------------------------------------------------------------" + write(iulog,*) " Consistency check 1: state passed to physics same as end dynamics?" + write(iulog,*) "-------------------------------------------------------------------" write(iulog,*) " " write(iulog,*) "Is globally integrated total energy of state at the end of dynamics (dBF)" write(iulog,*) "and beginning of physics (dyBF) the same?" @@ -134,7 +175,6 @@ subroutine print_budget() diff = abs_diff(E_dBF,E_dyBF) if (abs(diff)eps) then - write(iulog,*)" MASS BUDGET ERROR" -!xxx call endrun('dycore_budget module: Error in mass budget') - end if + if (err>eps) write(iulog,*)" MASS BUDGET ERROR" end do end if end subroutine print_budget !========================================================================================= - function abs_diff(a,b) - real(r8), intent(in) :: a,b - real(r8) :: abs_diff - if (abs(b)>eps) then - abs_diff = abs((b-a)/b) - else - abs_diff = abs(b-a) - end if -end function abs_diff + function abs_diff(a,b,pf) + real(r8), intent(in) :: a,b + character(LEN=5), optional, intent(out):: pf + real(r8) :: abs_diff + if (abs(b)>eps) then + abs_diff = abs((b-a)/b) + else + abs_diff = abs(b-a) + end if + if (present(pf)) then + if (abs_diff>eps) then + pf = ' FAIL' + else + pf = ' PASS' + end if + end if + end function abs_diff end module dycore_budget From 92f0860a86da452a2ec284ac8996e40da44f1923 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 16 Dec 2022 16:13:39 -0700 Subject: [PATCH 047/140] remove unused option (energy conserving dry-mass adjustment) --- src/physics/cam/geopotential.F90 | 95 +------------------------------ src/physics/cam/physics_types.F90 | 52 +---------------- 2 files changed, 2 insertions(+), 145 deletions(-) diff --git a/src/physics/cam/geopotential.F90 b/src/physics/cam/geopotential.F90 index cbc7131f6a..f75f352ba3 100644 --- a/src/physics/cam/geopotential.F90 +++ b/src/physics/cam/geopotential.F90 @@ -20,102 +20,9 @@ module geopotential private save - public geopotential_dse public geopotential_t contains -!=============================================================================== - subroutine geopotential_dse( & - piln , pmln , pint , pmid , pdel , rpdel , & - dse , q , phis , rair , gravit , cpair , & - zvir , t , zi , zm , ncol ) -!----------------------------------------------------------------------- -! -! Purpose: -! Compute the temperature and geopotential height (above the surface) at the -! midpoints and interfaces from the input dry static energy and pressures. -! -!----------------------------------------------------------------------- -!------------------------------Arguments-------------------------------- -! -! Input arguments - integer, intent(in) :: ncol ! Number of longitudes - - ! rair, and cpair are passed in as slices of rank 3 arrays allocated - ! at runtime. Don't specify size to avoid temporary copy. - real(r8), intent(in) :: piln (:,:) ! (pcols,pverp) - Log interface pressures - real(r8), intent(in) :: pmln (:,:) ! (pcols,pver) - Log midpoint pressures - real(r8), intent(in) :: pint (:,:) ! (pcols,pverp) - Interface pressures - real(r8), intent(in) :: pmid (:,:) ! (pcols,pver) - Midpoint pressures - real(r8), intent(in) :: pdel (:,:) ! (pcols,pver) - layer thickness - real(r8), intent(in) :: rpdel(:,:) ! (pcols,pver) - inverse of layer thickness - real(r8), intent(in) :: dse (:,:) ! (pcols,pver) - dry static energy - real(r8), intent(in) :: q (:,:) ! (pcols,pver) - specific humidity - real(r8), intent(in) :: phis (:) ! (pcols) - surface geopotential - real(r8), intent(in) :: rair (:,:) ! - Gas constant for dry air - real(r8), intent(in) :: gravit ! - Acceleration of gravity - real(r8), intent(in) :: cpair(:,:) ! - specific heat at constant p for dry air - real(r8), intent(in) :: zvir (:,:) ! (pcols,pver) - rh2o/rair - 1 - -! Output arguments - - real(r8), intent(out) :: t(:,:) ! (pcols,pver) - temperature - real(r8), intent(out) :: zi(:,:) ! (pcols,pverp) - Height above surface at interfaces - real(r8), intent(out) :: zm(:,:) ! (pcols,pver) - Geopotential height at mid level -! -!---------------------------Local variables----------------------------------------- -! - logical :: calc1 ! switch for calculation method - integer :: i,k ! Lon, level, level indices - real(r8) :: hkk(ncol) ! diagonal element of hydrostatic matrix - real(r8) :: hkl(ncol) ! off-diagonal element - real(r8) :: rog(ncol,pver) ! Rair / gravit - real(r8) :: tv ! virtual temperature - real(r8) :: tvfac ! Tv/T -! -!---------------------------------------------------------------------------------- - rog(:ncol,:) = rair(:ncol,:) / gravit - -! set calculation method based on dycore type - calc1 = dycore_is ('LR').or.dycore_is('FV3') - -! The surface height is zero by definition. - do i = 1,ncol - zi(i,pverp) = 0.0_r8 - end do - -! Compute the virtual temperature, zi, zm from bottom up -! Note, zi(i,k) is the interface above zm(i,k) - do k = pver, 1, -1 - -! First set hydrostatic elements consistent with dynamics - if (calc1) then - do i = 1,ncol - hkl(i) = piln(i,k+1) - piln(i,k) - hkk(i) = 1._r8 - pint(i,k) * hkl(i) * rpdel(i,k) - end do - else - do i = 1,ncol - hkl(i) = pdel(i,k) / pmid(i,k) - hkk(i) = 0.5_r8 * hkl(i) - end do - end if - -! Now compute tv, t, zm, zi - do i = 1,ncol - tvfac = 1._r8 + zvir(i,k) * q(i,k) - tv = (dse(i,k) - phis(i) - gravit*zi(i,k+1)) / ((cpair(i,k) / tvfac) + & - rair(i,k)*hkk(i)) - - t (i,k) = tv / tvfac - - zm(i,k) = zi(i,k+1) + rog(i,k) * tv * hkk(i) - zi(i,k) = zi(i,k+1) + rog(i,k) * tv * hkl(i) - end do - end do - - return - end subroutine geopotential_dse !=============================================================================== subroutine geopotential_t( & @@ -217,7 +124,7 @@ subroutine geopotential_t( & ! in Lauritzen et al. (2018); https://doi.org/10.1029/2017MS001257) ! - ! Compute factor for converting wet to dry mixing ratio + ! Compute factor for converting wet to dry mixing ratio (eq.7) qfac = 1.0_r8 do idx = 1,thermodynamic_active_species_num do k = 1,pver diff --git a/src/physics/cam/physics_types.F90 b/src/physics/cam/physics_types.F90 index 32112761c0..eb14719330 100644 --- a/src/physics/cam/physics_types.F90 +++ b/src/physics/cam/physics_types.F90 @@ -6,7 +6,7 @@ module physics_types use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver use constituents, only: pcnst, qmin, cnst_name, cnst_get_ind - use geopotential, only: geopotential_dse, geopotential_t + use geopotential, only: geopotential_t use physconst, only: zvir, gravit, cpair, rair use air_composition, only: cpairv, rairv use phys_grid, only: get_ncols_p, get_rlon_all_p, get_rlat_all_p, get_gcol_all_p @@ -19,8 +19,6 @@ module physics_types implicit none private ! Make default type private to the module - logical, parameter :: adjust_te = .FALSE. - ! Public types: public physics_state @@ -1274,9 +1272,6 @@ subroutine physics_dme_adjust(state, tend, qini, liqini, iceini, dt) if (state%psetcols .ne. pcols) then call endrun('physics_dme_adjust: cannot pass in a state which has sub-columns') end if - if (adjust_te) then - call endrun('physics_dme_adjust: must update code based on the "correct" energy before turning on "adjust_te"') - end if lchnk = state%lchnk ncol = state%ncol @@ -1302,25 +1297,6 @@ subroutine physics_dme_adjust(state, tend, qini, liqini, iceini, dt) state%q(:ncol,k,m) = state%q(:ncol,k,m) / fdq(:ncol) end do - if (adjust_te) then - ! compute specific total energy of unadjusted state (J/kg) - te(:ncol) = state%s(:ncol,k) + 0.5_r8*(state%u(:ncol,k)**2 + state%v(:ncol,k)**2) - - ! recompute initial u,v from the new values and the tendencies - utmp(:ncol) = state%u(:ncol,k) - dt * tend%dudt(:ncol,k) - vtmp(:ncol) = state%v(:ncol,k) - dt * tend%dvdt(:ncol,k) - ! adjust specific total energy and specific momentum (velocity) to conserve each - te (:ncol) = te (:ncol) / fdq(:ncol) - state%u(:ncol,k) = state%u(:ncol,k ) / fdq(:ncol) - state%v(:ncol,k) = state%v(:ncol,k ) / fdq(:ncol) - ! compute adjusted u,v tendencies - tend%dudt(:ncol,k) = (state%u(:ncol,k) - utmp(:ncol)) / dt - tend%dvdt(:ncol,k) = (state%v(:ncol,k) - vtmp(:ncol)) / dt - - ! compute adjusted static energy - state%s(:ncol,k) = te(:ncol) - 0.5_r8*(state%u(:ncol,k)**2 + state%v(:ncol,k)**2) - end if - ! compute new total pressure variables state%pdel (:ncol,k ) = state%pdel(:ncol,k ) * fdq(:ncol) state%ps(:ncol) = state%ps(:ncol) + state%pdel(:ncol,k) @@ -1336,32 +1312,6 @@ subroutine physics_dme_adjust(state, tend, qini, liqini, iceini, dt) zvirv(:,:) = zvir endif -! compute new T,z from new s,q,dp - if (adjust_te) then - -! cpairv_loc needs to be allocated to a size which matches state and ptend -! If psetcols == pcols, cpairv is the correct size and just copy into cpairv_loc -! If psetcols > pcols and all cpairv match cpair, then assign the constant cpair - - allocate(cpairv_loc(state%psetcols,pver)) - if (state%psetcols == pcols) then - cpairv_loc(:,:) = cpairv(:,:,state%lchnk) - else if (state%psetcols > pcols .and. all(cpairv(:,:,:) == cpair)) then - cpairv_loc(:,:) = cpair - else - call endrun('physics_dme_adjust: cpairv is not allowed to vary when subcolumns are turned on') - end if - - call geopotential_dse(state%lnpint, state%lnpmid, state%pint, & - state%pmid , state%pdel , state%rpdel, & - state%s , state%q(:,:,1), state%phis , rairv(:,:,state%lchnk), & - gravit, cpairv_loc(:,:), zvirv, & - state%t , state%zi , state%zm , ncol) - - deallocate(cpairv_loc) - - end if - end subroutine physics_dme_adjust !----------------------------------------------------------------------- From 1b25f82f8f3dab553df14fafbcd8c1e6fd8c2f2a Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Mon, 9 Jan 2023 10:04:49 -0700 Subject: [PATCH 048/140] add budget calculation after number of steps,days,months,years,endofrun and some bugfixes --- bld/namelist_files/namelist_definition.xml | 25 ++ src/control/budgets.F90 | 346 +++++++++++++++++--- src/control/runtime_opts.F90 | 2 + src/dynamics/mpas/dyn_comp.F90 | 124 ++++--- src/dynamics/se/dycore/element_mod.F90 | 4 +- src/dynamics/se/dycore/prim_advance_mod.F90 | 122 +++---- src/dynamics/se/dycore_budget.F90 | 154 +++++---- src/dynamics/se/dyn_comp.F90 | 255 +++++++++------ src/physics/cam/cam_diagnostics.F90 | 45 --- src/physics/cam/check_energy.F90 | 291 +++++++++++----- src/physics/cam/physics_types.F90 | 10 +- src/physics/cam/physpkg.F90 | 51 +-- src/physics/cam_dev/physpkg.F90 | 74 ++--- src/utils/cam_thermo.F90 | 34 +- 14 files changed, 988 insertions(+), 549 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index b122a0d1b7..6e15203440 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -5008,6 +5008,31 @@ Default: 4 m/s + +Frequency that thermo budgets will be calculated and output: Valid values: 'NONE', 'NSTEP', 'NDAY', 'NMONTH', +'NYEAR', 'ENDOFRUN'. +Default: 'NONE' + + + +History tape number thermo budget output is written to. +Default: 1 + + + +History tape number thermo budget output is written to. +Default: 1 + + + +Produce output for the AMWG diagnostic package. +Default: .false. + + diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index 7ceea7633e..e1ed96f2f0 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -6,6 +6,7 @@ module budgets use spmd_utils, only: masterproc use cam_abortutils, only: endrun use cam_logfile, only: iulog +use cam_thermo, only: thermo_budget_num_vars implicit none private @@ -34,24 +35,25 @@ module budgets budget_info, &! return budget info by ind budget_info_byname, &! return budget info by name budget_cnt_adjust, &! advance or reset budget count - budget_count, &! return budget count - is_budget, &! return budget count - budget_get_global, &! return budget count - budget_put_global, &! return budget count + budget_count, &! return budget count + is_budget, &! return budget count + budget_get_global, &! return budget count + budget_put_global, &! return budget count + budget_write, &! write_budget: time to write global budget + + budget_readnl, &! budget_readnl: read cam thermo namelist budget_outfld ! Returns true if default CAM output was specified in the budget_stage_add calls. ! Public data -integer, parameter, public :: budget_array_max = 60 ! number of budget diffs -integer, parameter, public :: budget_me_varnum = 7 ! tot,se,ke,wv,wl,wi - +integer, parameter, public :: budget_array_max = 100 ! number of budget diffs integer, public :: budget_cnt(budget_array_max) ! budget counts for normalization logical, public :: budget_subcycle(budget_array_max) ! budget_subcycle counts -integer, public :: budget_num_dyn = 0 ! -integer, public :: budget_num_phy = 0 ! -integer, public :: budget_num = 0 ! -integer, public :: budget_state_ind(budget_array_max) ! +integer, public :: budget_num_dyn = 0 ! +integer, public :: budget_num_phy = 0 ! +integer, public :: budget_num = 0 ! +integer, public :: budget_state_ind(budget_array_max) ! logical, public, protected :: budget_out(budget_array_max) ! outfld this stage character(len=64), public, protected :: budget_name(budget_array_max) ! budget names character(len=128),public, protected :: budget_longname(budget_array_max) ! long name of budgets @@ -60,10 +62,14 @@ module budgets integer, public, protected :: budget_stg2index(budget_array_max) character(len=64), public, protected :: budget_stg1name(budget_array_max) character(len=64), public, protected :: budget_stg2name(budget_array_max) -character(len=64), public, protected :: budget_me_names(budget_me_varnum) integer, public, protected :: budget_stg1stateidx(budget_array_max) integer, public, protected :: budget_stg2stateidx(budget_array_max) -real(r8), public, protected :: budget_globals(budget_array_max,budget_me_varnum) +real(r8), public, protected :: budget_globals(budget_array_max,thermo_budget_num_vars) + +integer, public, protected :: thermo_budget_averaging_n = 1 +integer, public, protected :: thermo_budget_histfile_num = 1 +logical, public, protected :: thermo_budget_history = .false. +character(len=8), public, protected :: thermo_budget_averaging_option = 'NONE' ! ! Constants for each budget @@ -76,20 +82,6 @@ module budgets CONTAINS !============================================================================================== -subroutine budget_readnl(nlfile) - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn - character(len=*), parameter :: sub = 'budget_readnl' - - !----------------------------------------------------------------------------- - - -end subroutine budget_readnl - - subroutine budget_stage_add (name, pkgtype, longname, outfld, subcycle) ! Register a budget. @@ -135,7 +127,7 @@ subroutine budget_stage_add (name, pkgtype, longname, outfld, subcycle) budget_longname(budget_num) = name end if - ! set outfld type + ! set outfld type ! (false: the module declaring the budget is responsible for outfld calls) if (present(outfld)) then budget_out(budget_num) = outfld @@ -220,7 +212,7 @@ subroutine budget_diff_add (name, stg1name, stg2name, pkgtype, optype, longname, budget_stg2index(budget_num) = budget_ind_byname(trim(stg2name)) budget_stg1stateidx(budget_num) = budget_state_ind(budget_stg1index(budget_num)) budget_stg2stateidx(budget_num) = budget_state_ind(budget_stg2index(budget_num)) - ! set outfld type + ! set outfld type ! (false: the module declaring the budget is responsible for outfld calls) if (present(outfld)) then budget_out(budget_num) = outfld @@ -276,7 +268,7 @@ end function budget_type_byind subroutine budget_info_byname(name, budget_ind, longname, stg1name, stg1stateidx, stg1index, stg2name, stg2stateidx, stg2index, optype, pkgtype,state_ind,subcycle,outfld) - ! Return the mixing ratio name of a budget + ! Return the mixing ratio name of a budget !-----------------------------Arguments--------------------------------- character(len=*), intent(in) :: name @@ -286,7 +278,7 @@ subroutine budget_info_byname(name, budget_ind, longname, stg1name, stg1stateidx stg2name ! stage2 name value for difference budget integer, intent(out), optional :: & budget_ind, &! budget array index - state_ind, &! state budget array index + state_ind, &! state budget array index stg1stateidx, &! stage1 index for difference budget stg2stateidx, &! stage2 index for difference budget stg1index, &! stage1 budget index @@ -331,10 +323,9 @@ subroutine budget_info_byname(name, budget_ind, longname, stg1name, stg1stateidx end if end subroutine budget_info_byname -!jt subroutine budget_info_byind(budget_ind, name, longname, stg1name, stg1stateidx, stg1index, stg2name, stg2stateidx, stg2index, optype, pkgtype,state_ind,subcycle,outfld) subroutine budget_info(budget_ind, name, longname, stg1name, stg1stateidx, stg1index, stg2name, stg2stateidx, stg2index, optype, pkgtype,state_ind,subcycle,outfld) - ! Return the mixing ratio name of a budget + ! Return the mixing ratio name of a budget !-----------------------------Arguments--------------------------------- integer, intent(in) :: budget_ind @@ -344,7 +335,7 @@ subroutine budget_info(budget_ind, name, longname, stg1name, stg1stateidx, stg1i stg1name, &! stage1 name value for difference budget stg2name ! stage2 name value for difference budget integer, intent(out), optional :: & - state_ind, &! state budget array index + state_ind, &! state budget array index stg1stateidx,&! stage1 index for difference budget stg2stateidx,&! stage2 index for difference budget stg1index, &! stage1 budget index @@ -386,14 +377,13 @@ subroutine budget_info(budget_ind, name, longname, stg1name, stg1stateidx, stg1i call endrun(errmsg) end if -!jt end subroutine abudget_info_byind end subroutine budget_info !============================================================================================== subroutine budget_cnt_adjust(ind,reset) - ! Return the mixing ratio name of a budget + ! Return the mixing ratio name of a budget !-----------------------------Arguments--------------------------------- integer, intent(in) :: ind ! global budget index (in te array) @@ -421,14 +411,14 @@ end subroutine budget_cnt_adjust subroutine budget_init() ! Initial budget module variables. - + budget_cnt(:) = 0._r8 budget_subcycle(:) = .false. budget_num_dyn = 0 budget_num_phy = 0 budget_num = 0 - budget_state_ind(:) = 0 - budget_out(:) = .false. + budget_state_ind(:) = 0 + budget_out(:) = .false. budget_name(:) = 'UNSET' budget_longname(:)= 'UNSET' budget_stg1index(:) = 0 @@ -436,14 +426,14 @@ subroutine budget_init() budget_stg1name(:)= 'UNSET' budget_stg2name(:)= 'UNSET' budget_subcycle(:)= .false. - + end subroutine budget_init !============================================================================================== character*64 function budget_name_byind(ind) - ! Return the mixing ratio name of a budget + ! Return the mixing ratio name of a budget !-----------------------------Arguments--------------------------------- integer, intent(in) :: ind ! global budget index (in te array) @@ -466,7 +456,7 @@ end function budget_name_byind character*128 function budget_longname_byind(ind) - ! Return the mixing ratio name of a budget + ! Return the mixing ratio name of a budget !-----------------------------Arguments--------------------------------- integer, intent(in) :: ind ! global budget index (in te array) @@ -518,7 +508,7 @@ subroutine budget_get_global (name, me_idx, global, abort) ! Unrecognized name abort_on_error = .true. if (present(abort)) abort_on_error = abort - + if (abort_on_error) then write(errmsg,*) sub//': FATAL: name not found: ', trim(name) call endrun(errmsg) @@ -556,7 +546,7 @@ subroutine budget_put_global (name, me_idx, global, abort) ! Unrecognized name abort_on_error = .true. if (present(abort)) abort_on_error = abort - + if (abort_on_error) then call endrun(sub//': FATAL: name not found') end if @@ -592,7 +582,7 @@ subroutine budget_get_ind (name, budget_ind, abort) ! Unrecognized name abort_on_error = .true. if (present(abort)) abort_on_error = abort - + if (abort_on_error) then call endrun(sub//': FATAL: name not found') end if @@ -628,7 +618,7 @@ function budget_ind_byname (name) write(iulog,*)'ind_byname failed, name=',trim(name),'budget_name=' call endrun() end if - + !============================================================================== end function budget_ind_byname @@ -655,7 +645,7 @@ function budget_outfld(m) ! Query whether default CAM outfld calls should be made. - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- integer, intent(in) :: m ! budget index logical :: budget_outfld ! true => use default CAM outfld calls @@ -704,7 +694,7 @@ function budget_count(ind) ! Query whether default CAM outfld calls should be made. - !----------------------------------------------------------------------- + !----------------------------------------------------------------------- integer, intent(in) :: ind ! budget index integer :: budget_count ! true => use default CAM outfld calls @@ -723,6 +713,264 @@ function budget_count(ind) end function budget_count -!============================================================================== + !============================================================================== + + logical function budget_write (step_offset) + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Set flags that will initiate dump to IC file when OUTFLD and + ! WSHIST are called + ! + !----------------------------------------------------------------------- + ! + use shr_kind_mod, only: r8=>SHR_KIND_R8, cs=>SHR_KIND_CS, cl=>SHR_KIND_CL + use shr_string_mod, only: shr_string_toUpper + use time_manager, only: timemgr_time_ge, timemgr_time_inc, get_curr_date, is_first_restart_step + use time_manager, only: get_step_size, get_nstep, is_last_step, is_first_step + use time_manager, only: get_start_date, get_stop_date + use cam_abortutils, only: endrun + use spmd_utils, only: masterproc, mstrid=>masterprocid, mpicom + use spmd_utils, only: mpi_integer, mpi_real8, mpi_logical, mpi_character + use cam_logfile, only: iulog + use shr_cal_mod, only: shr_cal_ymd2date + ! + ! Input/Output arguments + !----------------------- + integer, optional, intent(in) :: step_offset + + ! Local values + !---------------- + character(len=*), parameter :: subname = 'budget_write :: ' + + integer, save :: YMD_Next,Sec_Next, & + YMD_Start,Sec_Start,YMD_Stop,Sec_Stop + logical, save :: initialized=.false. + integer :: YMD,Sec,YMD_Curr,Sec_Curr,YMD_Curr_woff,Sec_Curr_woff + integer :: Year,Month,Day + integer :: dtime ! timestep size + integer :: nstep ! current timestep number + integer :: offset ! offset for writing thermo budget. + logical :: Update_Budget + + !-------------------------------------------------------------- + + budget_write = .false. + if (trim(shr_string_toUpper(thermo_budget_averaging_option)) == 'NONE') return + + offset=0 + if (present(step_offset)) offset=step_offset + + nstep = get_nstep() + dtime = get_step_size() + + ! Get Current time + !-------------------- + call get_curr_date(Year,Month,Day,Sec_Curr) + call shr_cal_ymd2date(Year,Month,Day,YMD_Curr) + + call get_curr_date(Year,Month,Day,Sec_Curr_woff,offset=offset) + call shr_cal_ymd2date(Year,Month,Day,YMD_Curr_woff) + + if (masterproc) write(iulog,*)'budget_write YMD_Curr, Sec_Curr, offset',YMD_Curr,Sec_Curr,offset + + ! Initialize budget update times on first step + if (.not. initialized) then + ! Get Start time + !-------------------- + call get_start_date(Year,Month,Day,Sec_Start) + call shr_cal_ymd2date(Year,Month,Day,YMD_Start) + + ! Get End time + !-------------------- + call get_stop_date(Year,Month,Day,Sec_Stop) + call shr_cal_ymd2date(Year,Month,Day,YMD_Stop) + + ! Get Next Update time + !-------------------- + if (thermo_budget_averaging_option == 'ENDOFRUN') then + YMD_Next=YMD_Stop + Sec_Next=Sec_Stop + else + YMD=YMD_Curr + Sec=Sec_Curr + if (thermo_budget_averaging_option == 'NSTEP') then + call timemgr_time_inc(YMD,Sec, & + YMD_Next,Sec_Next,inc_s=dtime*thermo_budget_averaging_n) + elseif (thermo_budget_averaging_option == 'NHOUR') then + call timemgr_time_inc(YMD,Sec, & + YMD_Next,Sec_Next,inc_h=thermo_budget_averaging_n) + elseif(thermo_budget_averaging_option == 'NDAY' ) then + call timemgr_time_inc(YMD,Sec, & + YMD_Next,Sec_Next,inc_d=thermo_budget_averaging_n) + elseif(thermo_budget_averaging_option == 'NMONTH' ) then + call get_curr_date(Year,Month,Day,Sec_Curr) + if (thermo_budget_averaging_n+Month.gt.12) then + Year=Year+(thermo_budget_averaging_n+Month)/12 + Month=mod(thermo_budget_averaging_n+Month,12) + else + Month=thermo_budget_averaging_n+Month + end if + call shr_cal_ymd2date(Year,Month,Day,YMD_Next) + Sec_Next=Sec_Curr + elseif(thermo_budget_averaging_option == 'NYEAR' ) then + call get_curr_date(Year,Month,Day,Sec_Curr) + call shr_cal_ymd2date(Year+thermo_budget_averaging_n,Month,Day,YMD_Next) + Sec_Next=Sec_Curr + end if + + if (masterproc) write(iulog,*)'init calc of next budget write ymdc/secc/ymdn/secn:',YMD_Curr,Sec_Curr,YMD_Next,Sec_Next + end if + + initialized=.true. + end if + + + ! If an offset is present don't reset YMD_Next,Sec_Next just return budget_write using offset + !-------------------------------------------------------------- + if (present(step_offset)) then + + call timemgr_time_ge(YMD_Next,Sec_Next, & + YMD_Curr_woff ,Sec_Curr_woff ,update_budget) +!jt budget_write = ( nstep+(abs(offset/dtime))==1 .or. ((nstep /= 0).and.update_budget) ) + budget_write = ((nstep /= 0).and.update_budget) + if (masterproc) write(iulog,*)'checking for budget_write w/offset:',budget_write + + else + ! When past the NEXT time, Update budget + !-------------------------------------------------------------- + call timemgr_time_ge(YMD_Next,Sec_Next, & + YMD_Curr ,Sec_Curr ,Update_Budget) + if (masterproc) write(iulog,*)'checking for update_budget:',Update_Budget + + ! Reset YMD_Next and Sec_Next for next update + !-------------------------------------------------------------- + if (Update_Budget) then + if (thermo_budget_averaging_option == 'ENDOFRUN') then + YMD_Next=YMD_Stop + Sec_Next=Sec_Stop + else + YMD=YMD_Next + Sec=Sec_Next + if (thermo_budget_averaging_option == 'NSTEP') then + call timemgr_time_inc(YMD,Sec, & + YMD_Next,Sec_Next,inc_s=dtime*thermo_budget_averaging_n) + elseif (thermo_budget_averaging_option == 'NHOUR') then + call timemgr_time_inc(YMD,Sec, & + YMD_Next,Sec_Next,inc_h=thermo_budget_averaging_n) + elseif(thermo_budget_averaging_option == 'NDAY' ) then + call timemgr_time_inc(YMD,Sec, & + YMD_Next,Sec_Next,inc_d=thermo_budget_averaging_n) + elseif(thermo_budget_averaging_option == 'NMONTH' ) then + call get_curr_date(Year,Month,Day,Sec_Curr) + if (thermo_budget_averaging_n+Month.gt.12) then + Year=Year+(thermo_budget_averaging_n+Month)/12 + Month=mod(thermo_budget_averaging_n+Month,12) + else + Month=thermo_budget_averaging_n+Month + end if + call shr_cal_ymd2date(Year,Month,Day,YMD_Next) + Sec_Next=Sec_Curr + elseif(thermo_budget_averaging_option == 'NYEAR' ) then + call get_curr_date(Year,Month,Day,Sec_Curr) + call shr_cal_ymd2date(Year+thermo_budget_averaging_n,Month,Day,YMD_Next) + Sec_Next=Sec_Curr + end if + if (masterproc) write(iulog,*)'curr gt next, reset next,new values ymdn/secn',YMD_Next,Sec_Next + end if + end if +!jt budget_write = ( nstep+(abs(offset/dtime))==1 .or. ((nstep /= 0).and.update_budget) ) + budget_write = ((nstep /= 0).and.update_budget) + end if + + return + end function budget_write + + !=========================================================================== + ! Read namelist variables. + subroutine budget_readnl(nlfile) + use namelist_utils, only: find_group_name + use spmd_utils, only: masterproc, mpicom, masterprocid + use spmd_utils, only: mpi_character, mpi_logical, mpi_real8, mpi_integer + use cam_logfile, only: iulog + use shr_string_mod, only: shr_string_toUpper + + ! Dummy argument: filepath for file containing namelist input + character(len=*), intent(in) :: nlfile + + ! Local variables + integer :: unitn, ierr + integer, parameter :: lsize = 76 + integer, parameter :: fsize = 23 + character(len=*), parameter :: subname = 'budget_readnl :: ' + character(len=8) :: period + logical :: thermo_budgeting + + namelist /thermo_budget_nl/ thermo_budget_averaging_option, thermo_budget_averaging_n, & + thermo_budget_history, thermo_budget_histfile_num + !----------------------------------------------------------------------- + + if (masterproc) then + open(newunit=unitn, file=trim(nlfile), status='old') + call find_group_name(unitn, 'thermo_budget_nl', status=ierr) + if (ierr == 0) then + read(unitn, thermo_budget_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname//'ERROR reading namelist, thermo_budget_nl') + end if + end if + close(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast(thermo_budget_averaging_option, len(thermo_budget_averaging_option), mpi_character, masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_averaging_option") + call mpi_bcast(thermo_budget_history , 1 , mpi_logical , masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_history") + call mpi_bcast(thermo_budget_histfile_num , 1 , mpi_integer , masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_histfile_num") + call mpi_bcast(thermo_budget_averaging_n , 1 , mpi_integer , masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_averaging_n") + + if (trim(shr_string_toUpper(thermo_budget_averaging_option)) == 'NONE') then + thermo_budgeting=.false. + else + thermo_budgeting=.true. + end if + ! Write out thermo_budget options + if (masterproc) then + if (trim(thermo_budget_averaging_option) == 'NSTEP' ) then + period='step' + else if (trim(thermo_budget_averaging_option) == 'NHOUR' ) then + period='hour' + else if (trim(thermo_budget_averaging_option) == 'NDAY' ) then + period='day' + else if (trim(thermo_budget_averaging_option) == 'NMONTH' ) then + period='month' + else if (trim(thermo_budget_averaging_option) == 'NYEAR' ) then + period='year' + else + period='' + end if + + if (trim(thermo_budget_averaging_option) == 'ENDOFRUN' ) then + write(iulog,*)'Thermo thermo_budgets will be written at the end of the run' + else + if (thermo_budget_averaging_n == 1) then + write(iulog,*)'Thermo thermo_budgets will be written every ',period + else + write(iulog,*)'Thermo thermo_budgets will be written every ',thermo_budget_averaging_n,' ',trim(period)//'s' + end if + end if + + if(thermo_budget_history.and..not.thermo_budgeting) then + write(iulog,*)subname//": FATAL: thermo_budget_averaging_option =",thermo_budget_averaging_option + call endrun(subname//": FATAL: thermo_budget averaging option must not be set to NONE when requesting thermo_budget history output") + end if + + end if + + + end subroutine budget_readnl end module budgets diff --git a/src/control/runtime_opts.F90 b/src/control/runtime_opts.F90 index 50ee489e71..8ba778e9c3 100644 --- a/src/control/runtime_opts.F90 +++ b/src/control/runtime_opts.F90 @@ -97,6 +97,7 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) use qneg_module, only: qneg_readnl use lunar_tides, only: lunar_tides_readnl use upper_bc, only: ubc_readnl + use budgets, only: budget_readnl !---------------------------Arguments----------------------------------- @@ -195,6 +196,7 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) call dyn_readnl(nlfilename) call ionosphere_readnl(nlfilename) call qneg_readnl(nlfilename) + call budget_readnl(nlfilename) end subroutine read_namelist diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index d6fdc01c46..78b936719b 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -153,8 +153,8 @@ module dyn_comp ! ! Energy Budgets ! - real(r8), dimension(:,:), pointer :: budgets_global ! global averages (budget_array_max,9) - real(r8), dimension(:,:,:),pointer :: te_budgets ! Energy budgets (budget_array_max,9,ncells) + real(r8), dimension(:,:), pointer :: budgets_global ! global averages (budget_array_max,thermo_budget_num_vars) + real(r8), dimension(:,:,:),pointer :: te_budgets ! Energy budgets (budget_array_max,thermo_budget_num_vars,ncells) integer, dimension(:), pointer :: budgets_cnt ! budget counts (budget_array_max) integer, dimension(:), pointer :: budgets_subcycle_cnt ! subcycle count (budget_array_max) @@ -227,8 +227,8 @@ module dyn_comp ! ! Energy Budgets ! - real(r8), dimension(:,:), pointer :: budgets_global ! global averages (budget_array_max,9) - real(r8), dimension(:,:,:),pointer :: te_budgets ! Energy budgets (budget_array_max,9,ncells) + real(r8), dimension(:,:), pointer :: budgets_global ! global averages (budget_array_max,thermo_budget_num_vars) + real(r8), dimension(:,:,:),pointer :: te_budgets ! Energy budgets (budget_array_max,thermo_budget_num_vars,ncells) integer, dimension(:), pointer :: budgets_cnt ! budget counts (budget_array_max) integer, dimension(:), pointer :: budgets_subcycle_cnt ! subcycle count (budget_array_max) @@ -327,6 +327,7 @@ subroutine dyn_init(dyn_in, dyn_out) use air_composition, only : thermodynamic_active_species_liq_num, thermodynamic_active_species_ice_num use cam_mpas_subdriver, only : domain_ptr, cam_mpas_init_phase4 use cam_mpas_subdriver, only : cam_mpas_define_scalars + use cam_thermo, only : thermo_budget_num_vars use mpas_pool_routines, only : mpas_pool_get_subpool, mpas_pool_get_array, mpas_pool_get_dimension, & mpas_pool_get_config use mpas_timekeeping, only : MPAS_set_timeInterval @@ -518,7 +519,7 @@ subroutine dyn_init(dyn_in, dyn_out) allocate(dyn_out % pintdry(nVertLevels+1, nCells), stat=ierr) if( ierr /= 0 ) call endrun(subname//': failed to allocate dyn_out%pintdry array') - allocate(dyn_out % te_budgets(budget_array_max, 9, nCellsSolve), stat=ierr) + allocate(dyn_out % te_budgets(budget_array_max, thermo_budget_num_vars, nCellsSolve), stat=ierr) if( ierr /= 0 ) call endrun(subname//': failed to allocate dyn_out%budgets') allocate(dyn_out % budgets_cnt(budget_array_max), stat=ierr) @@ -527,7 +528,7 @@ subroutine dyn_init(dyn_in, dyn_out) allocate(dyn_out % budgets_subcycle_cnt(budget_array_max), stat=ierr) if( ierr /= 0 ) call endrun(subname//': failed to allocate dyn_out%budgets') - allocate(dyn_out % budgets_global(budget_array_max,9), stat=ierr) + allocate(dyn_out % budgets_global(budget_array_max,thermo_budget_num_vars), stat=ierr) if( ierr /= 0 ) call endrun(subname//': failed to allocate dyn_out%budgets') dyn_in % te_budgets => dyn_out % te_budgets @@ -635,18 +636,6 @@ subroutine dyn_init(dyn_in, dyn_out) call budget_add('mpas_dmea' ,'dAM','dAP',pkgtype='dyn',optype='dif',longname="dE/dt dry mass adjustment in dycore (dAM-dAP)",outfld=.false.) call budget_add('mpas_phys_total' ,'dAM','dBF',pkgtype='dyn',optype='dif',longname="dE/dt physics total in dycore (phys) (dAM-dBF)",outfld=.false.) -!!$ ! add all dynamic budget outfld calls -!!$ do m=1,budget_num -!!$ call budget_info(m,name=budget_name,longname=budget_longname,pkgtype=budget_pkgtype,outfld=budget_outfld) -!!$ write(iulog,*)'budget_info for ',budget_name,' pkg:',budget_pkgtype,' outfld:',budget_outfld -!!$ if (budget_outfld) then -!!$ if (trim(budget_pkgtype)=='dyn') then -!!$ write(iulog,*)'calling addfld for ',trim(budget_name) -!!$ call addfld(trim(budget_name), horiz_only, 'A', 'W/m2', trim(budget_longname)) -!!$ endif -!!$ end if -!!$ end do - end subroutine dyn_init !========================================================================================= @@ -688,19 +677,23 @@ subroutine dyn_run(dyn_in, dyn_out) ! update energy budgets calculated from snapshots (stages) - call budget_update(dyn_in%nCellsSolve,dyn_out) - + if(budget_write(step_offset=nint(dtime))) then + call budget_update(dyn_in%nCellsSolve,dyn_out) + else + call budget_update_dyn_cnts(dyn_in%nCellsSolve,dyn_out) + end if end subroutine dyn_run subroutine budget_update(nCells,dyn_out) - - use budgets, only : budget_num, budget_info, budget_me_varnum,budget_put_global + + use cam_thermo, only : thermo_budget_num_vars,thermo_budget_vars_massv,wvidx,wlidx,wiidx,seidx,keidx,moidx,mridx,ttidx,teidx + use budgets, only : budget_num, budget_info, budget_put_global use air_composition, only : thermodynamic_active_species_liq_num, thermodynamic_active_species_ice_num - + ! arguments integer, intent(in) :: nCells ! Number of cells, including halo cells type (dyn_export_t), intent(in) :: dyn_out - + ! Local variables real(r8), pointer :: te_budgets(:,:,:) ! energy/mass budgets se,ke,wv,liq,ice integer, pointer :: budgets_cnt(:) ! budget counts for normalizating sum @@ -708,32 +701,29 @@ subroutine budget_update(nCells,dyn_out) logical :: budget_outfld character(len=64) :: name_out1,name_out2,name_out3,name_out4,name_out5,budget_name character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn - real(r8) :: tmp(9,nCells) + real(r8) :: tmp(thermo_budget_num_vars,nCells) real(r8), pointer :: areaCell(:) ! cell area (m^2) real(r8), pointer :: budgets_global(:,:) real(r8) :: dtime real(r8) :: sphere_surface_area - real(r8), dimension(:) :: glob(nCells,9) - + real(r8), dimension(:) :: glob(nCells,thermo_budget_num_vars) + !-------------------------------------------------------------------------------------- - + te_budgets => dyn_out % te_budgets budgets_cnt => dyn_out % budgets_cnt - - + + do b_ind=1,budget_num call budget_info(b_ind,optype=budget_optype, pkgtype=budget_pkgtype,state_ind=s_ind,outfld=budget_outfld,name=budget_name) if (budget_pkgtype=='dyn') then - if (budget_optype=='stg') then - tmp(:,:)=te_budgets(s_ind,:,:) - else + if (budget_optype!='stg') then call budget_info(b_ind,stg1stateidx=is1, stg2stateidx=is2) if (budget_optype=='dif') then - tmp(:,:)=(te_budgets(is1,:,:)-te_budgets(is2,:,:)) + te_budgets(s_ind,:,:)=(te_budgets(is1,:,:)-te_budgets(is2,:,:)) else if (budget_optype=='sum') then - tmp(:,:)=(te_budgets(is1,:,:)+te_budgets(is2,:,:)) + te_budgets(s_ind,:,:)=(te_budgets(is1,:,:)+te_budgets(is2,:,:)) end if - te_budgets(s_ind,:,:)=tmp(:,:) ! ! Output energy diagnostics ! @@ -743,29 +733,26 @@ subroutine budget_update(nCells,dyn_out) name_out3 = 'WV_' //trim(budget_name) name_out4 = 'WL_' //trim(budget_name) name_out5 = 'WI_' //trim(budget_name) - call outfld(name_out1, te_budgets(s_ind,2,:), nCells, 1) - call outfld(name_out2, te_budgets(s_ind,3,:), nCells, 1) + call outfld(name_out1, te_budgets(s_ind,seidx,:), nCells, 1) + call outfld(name_out2, te_budgets(s_ind,keidx,:), nCells, 1) ! ! sum over vapor - call outfld(name_out3, te_budgets(s_ind,4,:), nCells, 1) + call outfld(name_out3, te_budgets(s_ind,wvidx,:), nCells, 1) ! ! sum over liquid water if (thermodynamic_active_species_liq_num>0) & - call outfld(name_out4, te_budgets(s_ind,5,:), nCells, 1) + call outfld(name_out4, te_budgets(s_ind,wlidx,:), nCells, 1) ! ! sum over ice water if (thermodynamic_active_species_ice_num>0) & - call outfld(name_out5, te_budgets(s_ind,6,:), nCells, 1) + call outfld(name_out5, te_budgets(s_ind,wiidx,:), nCells, 1) end if + budgets_cnt(b_ind)=budgets_cnt(b_ind)+1 end if - budgets_cnt(b_ind)=budgets_cnt(b_ind)+1 end if end do - areaCell => dyn_out % areaCell -!jt te_budgets => dyn_out % te_budgets -!jt budgets_cnt => dyn_out % budgets_cnt budgets_global => dyn_out % budgets_global ! Get CAM time step @@ -777,23 +764,62 @@ subroutine budget_update(nCells,dyn_out) ! Normalize energy sums and convert to W/s ! (3) compute average global integrals of budgets sphere_surface_area = cam_mpas_global_sum_real(areaCell(1:nCells)) - do i=1,budget_me_varnum + do i=1,thermo_budget_num_vars glob(1:nCells,i) = te_budgets(s_ind,i,1:nCells)*areaCell(1:nCells)/sphere_surface_area budgets_global(b_ind,i) = cam_mpas_global_sum_real(glob(1:nCells,i))/budgets_cnt(b_ind) ! divide by time for proper units if not a mass budget. - if (i.le.3) budgets_global(b_ind,i)=budgets_global(b_ind,i)/dtime + if (.not.thermo_budget_vars_massv(i)) & + budgets_global(b_ind,i)=budgets_global(b_ind,i)/dtime if (masterproc) & + write(iulog,*)"putting global ",trim(budget_name)," m_cnst=",n," ",budgets_global(b_ind,i)," cnt=",budgets_cnt(b_ind),budgets_subcycle_cnt(b_ind) call budget_put_global(trim(budget_name),i,budgets_global(b_ind,i)) end do - if (.true.) budgets_cnt(b_ind)=0 + ! reset dyn budget states and counts + te_budgets(s_ind,:,:)=0._r8 + budgets_cnt(b_ind)=0 + budgets_subcycle_cnt(b_ind)=0 end if end do end subroutine budget_update !========================================================================================= +subroutine budget_update_dyn_cnts(nCells,dyn_out) + + use budgets, only : budget_num, budget_info + + ! arguments + integer, intent(in) :: nCells ! Number of cells, including halo cells + type (dyn_export_t), intent(in) :: dyn_out + + ! Local variables + integer, pointer :: budgets_cnt(:) ! budget counts for normalizating sum + integer :: b_ind,s_ind + character(len=64) :: budget_name + character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn + + !-------------------------------------------------------------------------------------- + + if (thermo_budget_history) then + budgets_cnt => dyn_out % budgets_cnt + + + do b_ind=1,budget_num + call budget_info(b_ind,optype=budget_optype, pkgtype=budget_pkgtype,state_ind=s_ind,outfld=budget_outfld,name=budget_name) + if (budget_pkgtype=='dyn') then + ! subcycle cnt reset when cnt advanced, subcycles increase between cnts + budgets_subcycle_cnt(b_ind)=0 + ! need to update dif and sum budget_counts for normalization, stage cnt updates are done in tot_energy + if (budget_optype=='dif'.or.budget_optype=='sum') & + budgets_cnt(b_ind)=budgets_cnt(b_ind)+1 + end if + end do + end if + +end subroutine budget_update_dyn_cnts +!========================================================================================= subroutine dyn_final(dyn_in, dyn_out) - + use cam_mpas_subdriver, only : cam_mpas_finalize ! Deallocates the dynamics import and export states, and finalizes diff --git a/src/dynamics/se/dycore/element_mod.F90 b/src/dynamics/se/dycore/element_mod.F90 index c6ea483e98..6905c380bd 100644 --- a/src/dynamics/se/dycore/element_mod.F90 +++ b/src/dynamics/se/dycore/element_mod.F90 @@ -6,6 +6,8 @@ module element_mod use edgetype_mod, only: edgedescriptor_t use gridgraph_mod, only: gridvertex_t use budgets, only: budget_array_max + use cam_thermo, only: thermo_budget_num_vars + implicit none private integer, public, parameter :: timelevels = 3 @@ -79,7 +81,7 @@ module element_mod real (kind=r8) :: dp_ref(np,np,nlev) ! reference pressure level thickness ! budgets - real (kind=r8) :: budget(np,np,9,budget_array_max) ! budgets + real (kind=r8) :: budget(np,np,thermo_budget_num_vars,budget_array_max) ! budgets integer :: budget_cnt(budget_array_max) ! budget count for averaging integer :: budget_subcycle(budget_array_max) ! budget subcycle count diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index 60f1e3225c..6186ab9530 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -1457,7 +1457,7 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf use string_utils, only: strlist_get_ind use hycoef, only: hyai, ps0 use fvm_control_volume_mod, only: fvm_struct - use cam_thermo, only: get_dp, MASS_MIXING_RATIO + use cam_thermo, only: get_dp, MASS_MIXING_RATIO,wvidx,wlidx,wiidx,seidx,keidx,moidx,mridx,ttidx,teidx use air_composition, only: thermodynamic_active_species_idx_dycore, get_cp use air_composition, only: thermodynamic_active_species_liq_num,thermodynamic_active_species_liq_idx use air_composition, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_ice_idx @@ -1493,8 +1493,8 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf ! real(kind=r8) :: mr(npsq) ! wind AAM real(kind=r8) :: mo(npsq) ! mass AAM - real(kind=r8) :: mr_cnst, mo_cnst, cos_lat, mr_tmp, mo_tmp - real(kind=r8) :: cp(np,np,nlev) + real(kind=r8) :: mr_cnst, mo_cnst, cos_lat, mr_tmp, mo_tmp,inv_g + real(kind=r8) :: cp(np,np,nlev),btmp(np,np) integer :: ie,i,j,k,budget_ind,state_ind,idx integer :: ixwv,ixcldice, ixcldliq, ixtt ! CLDICE, CLDLIQ and test tracer indices @@ -1512,6 +1512,8 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2).or.hist_fld_active(name_out3).or.& hist_fld_active(name_out4).or.hist_fld_active(name_out5).or.hist_fld_active(name_out6)) then + inv_g = 1.0_r8/gravit + if (ntrac>0) then ixwv = 1 call cnst_get_ind('CLDLIQ' , ixcldliq, abort=.false.) @@ -1588,9 +1590,9 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf end if do j=1,np do i = 1, np - elem(ie)%derived%budget(i,j,1,state_ind) = elem(ie)%derived%budget(i,j,1,state_ind) + (se(i+(j-1)*np) + ke(i+(j-1)*np)) - elem(ie)%derived%budget(i,j,2,state_ind) = elem(ie)%derived%budget(i,j,2,state_ind) + se(i+(j-1)*np) - elem(ie)%derived%budget(i,j,3,state_ind) = elem(ie)%derived%budget(i,j,3,state_ind) + ke(i+(j-1)*np) + elem(ie)%derived%budget(i,j,teidx,state_ind) = elem(ie)%derived%budget(i,j,teidx,state_ind) + (se(i+(j-1)*np) + ke(i+(j-1)*np)) + elem(ie)%derived%budget(i,j,seidx,state_ind) = elem(ie)%derived%budget(i,j,seidx,state_ind) + se(i+(j-1)*np) + elem(ie)%derived%budget(i,j,keidx,state_ind) = elem(ie)%derived%budget(i,j,keidx,state_ind) + ke(i+(j-1)*np) end do end do ! @@ -1607,10 +1609,9 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf call util_function(cdp_fvm,nc,nlev,name_out3,ie) do j = 1, nc do i = 1, nc - fvm(ie)%budget(i,j,4,state_ind) = fvm(ie)%budget(i,j,4,state_ind) + sum(cdp_fvm(i,j,:)) + fvm(ie)%budget(i,j,wvidx,state_ind) = fvm(ie)%budget(i,j,wvidx,state_ind) + sum(cdp_fvm(i,j,:)*inv_g) end do end do - fvm(ie)%budget(1:nc,1:nc,4,state_ind)=fvm(ie)%budget(1:nc,1:nc,4,state_ind)/gravit end if ! ! sum over liquid water @@ -1624,10 +1625,9 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf call util_function(cdp_fvm,nc,nlev,name_out4,ie) do j = 1, nc do i = 1, nc - fvm(ie)%budget(i,j,5,state_ind) = fvm(ie)%budget(i,j,5,state_ind) + sum(cdp_fvm(i,j,:)) + fvm(ie)%budget(i,j,wlidx,state_ind) = fvm(ie)%budget(i,j,wlidx,state_ind) + sum(cdp_fvm(i,j,:)*inv_g) end do end do - fvm(ie)%budget(1:nc,1:nc,5,state_ind)=fvm(ie)%budget(1:nc,1:nc,5,state_ind)/gravit end if ! ! sum over ice water @@ -1642,69 +1642,67 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf do j = 1, nc do i = 1, nc - fvm(ie)%budget(i,j,6,state_ind) = fvm(ie)%budget(i,j,6,state_ind) + sum(cdp_fvm(i,j,:)) + fvm(ie)%budget(i,j,wiidx,state_ind) = fvm(ie)%budget(i,j,wiidx,state_ind) + sum(cdp_fvm(i,j,:)*inv_g) end do end do - fvm(ie)%budget(1:nc,1:nc,6,state_ind)=fvm(ie)%budget(1:nc,1:nc,6,state_ind)/gravit end if if (ixtt>0) then cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixtt)*fvm(ie)%dp_fvm(1:nc,1:nc,:) call util_function(cdp_fvm,nc,nlev,name_out6,ie) do j = 1, nc do i = 1, nc - fvm(ie)%budget(i,j,7,state_ind) = fvm(ie)%budget(i,j,7,state_ind) + sum(cdp_fvm(i,j,:)) + fvm(ie)%budget(i,j,ttidx,state_ind) = fvm(ie)%budget(i,j,ttidx,state_ind) + sum(cdp_fvm(i,j,:)*inv_g) end do end do - fvm(ie)%budget(1:nc,1:nc,7,state_ind)=fvm(ie)%budget(1:nc,1:nc,7,state_ind)/gravit end if else - cdp = elem(ie)%state%qdp(:,:,:,1,tl_qdp) + cdp = elem(ie)%state%qdp(:,:,:,1,tl_qdp) call util_function(cdp,np,nlev,name_out3,ie) do j = 1, np do i = 1, np - elem(ie)%derived%budget(i,j,4,state_ind) = elem(ie)%derived%budget(i,j,4,state_ind) + sum(cdp(i,j,:)/gravit) + elem(ie)%derived%budget(i,j,wvidx,state_ind) = elem(ie)%derived%budget(i,j,wvidx,state_ind) + sum(cdp(i,j,:)*inv_g) end do end do ! ! sum over liquid water ! if (thermodynamic_active_species_liq_num>0) then - cdp = 0.0_r8 - do idx = 1,thermodynamic_active_species_liq_num - cdp = cdp + elem(ie)%state%qdp(:,:,:,thermodynamic_active_species_liq_idx(idx),tl_qdp) - end do - call util_function(cdp,np,nlev,name_out4,ie) - do j = 1, np - do i = 1, np - elem(ie)%derived%budget(i,j,5,state_ind) = elem(ie)%derived%budget(i,j,5,state_ind) + sum(cdp(i,j,:)/gravit) - end do - end do + cdp = 0.0_r8 + do idx = 1,thermodynamic_active_species_liq_num + cdp = cdp + elem(ie)%state%qdp(:,:,:,thermodynamic_active_species_liq_idx(idx),tl_qdp) + end do + call util_function(cdp,np,nlev,name_out4,ie) + do j = 1, np + do i = 1, np + elem(ie)%derived%budget(i,j,wlidx,state_ind) = elem(ie)%derived%budget(i,j,wlidx,state_ind) + sum(cdp(i,j,:)*inv_g) + end do + end do end if ! ! sum over ice water ! if (thermodynamic_active_species_ice_num>0) then - cdp = 0.0_r8 - do idx = 1,thermodynamic_active_species_ice_num - cdp = cdp + elem(ie)%state%qdp(:,:,:,thermodynamic_active_species_ice_idx(idx),tl_qdp) - end do - call util_function(cdp,np,nlev,name_out5,ie) - do j = 1, np - do i = 1, np - elem(ie)%derived%budget(i,j,6,state_ind) = elem(ie)%derived%budget(i,j,6,state_ind) + sum(cdp(i,j,:)/gravit) - end do - end do + cdp = 0.0_r8 + do idx = 1,thermodynamic_active_species_ice_num + cdp = cdp + elem(ie)%state%qdp(:,:,:,thermodynamic_active_species_ice_idx(idx),tl_qdp) + end do + call util_function(cdp,np,nlev,name_out5,ie) + do j = 1, np + do i = 1, np + elem(ie)%derived%budget(i,j,wiidx,state_ind) = elem(ie)%derived%budget(i,j,wiidx,state_ind) + sum(cdp(i,j,:)*inv_g) + end do + end do end if if (ixtt>0) then - cdp = elem(ie)%state%qdp(:,:,:,ixtt ,tl_qdp) - call util_function(cdp,np,nlev,name_out6,ie) - do j = 1, np - do i = 1, np - elem(ie)%derived%budget(i,j,7,state_ind) = elem(ie)%derived%budget(i,j,7,state_ind) + sum(cdp(i,j,:)/gravit) - end do - end do + cdp = elem(ie)%state%qdp(:,:,:,ixtt ,tl_qdp) + call util_function(cdp,np,nlev,name_out6,ie) + do j = 1, np + do i = 1, np + elem(ie)%derived%budget(i,j,ttidx,state_ind) = elem(ie)%derived%budget(i,j,ttidx,state_ind) + sum(cdp(i,j,:)*inv_g) + end do + end do end if - end if + end if end do end if ! @@ -1749,8 +1747,8 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf call outfld(name_out2 ,mo ,npsq,ie) do j=1,np do i = 1, np - elem(ie)%derived%budget(i,j,8,state_ind) = elem(ie)%derived%budget(i,j,8,state_ind) + mr(i+(j-1)*np) - elem(ie)%derived%budget(i,j,9,state_ind) = elem(ie)%derived%budget(i,j,9,state_ind) + mo(i+(j-1)*np) + elem(ie)%derived%budget(i,j,mridx,state_ind) = elem(ie)%derived%budget(i,j,mridx,state_ind) + mr(i+(j-1)*np) + elem(ie)%derived%budget(i,j,moidx,state_ind) = elem(ie)%derived%budget(i,j,moidx,state_ind) + mo(i+(j-1)*np) end do end do end do @@ -1773,6 +1771,8 @@ subroutine calc_tot_energy_dynamics_diff(elem,fvm,nets,nete,tl,tl_qdp,outfld_nam use air_composition, only: thermodynamic_active_species_ice_idx use budgets, only: budget_info,budget_ind_byname + use cam_thermo, only: thermo_budget_num_vars, & + thermo_budget_vars_massv,wvidx,wlidx,wiidx,seidx,keidx,moidx,mridx,ttidx,teidx !------------------------------Arguments-------------------------------- type (element_t) , intent(inout) :: elem(:) @@ -1797,13 +1797,13 @@ subroutine calc_tot_energy_dynamics_diff(elem,fvm,nets,nete,tl,tl_qdp,outfld_nam !jt if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2).or.hist_fld_active(name_out3).or.& !jt hist_fld_active(name_out4).or.hist_fld_active(name_out5).or.hist_fld_active(name_out6)) then - call cnst_get_ind('TT_UN' , ixtt , abort=.false.) +!jt call cnst_get_ind('TT_UN' , ixtt , abort=.false.) ! ! Compute frozen static energy in 3 parts: KE, SE, and energy associated with vapor and liquid ! - allocate(tmp(np,np,9,nets:nete)) - allocate(tmp1(np,np,9,nets:nete)) - allocate(tmp2(np,np,9,nets:nete)) + allocate(tmp(np,np,thermo_budget_num_vars,nets:nete)) + allocate(tmp1(np,np,thermo_budget_num_vars,nets:nete)) + allocate(tmp2(np,np,thermo_budget_num_vars,nets:nete)) b_ind=budget_ind_byname(trim(outfld_name_suffix)) call budget_info(b_ind,stg1stateidx=is1, stg2stateidx=is2,stg1index=isb1, stg2index=isb2, optype=budget_optype, pkgtype=budget_pkgtype,state_ind=s_ind) do ie=nets,nete @@ -1844,35 +1844,35 @@ subroutine calc_tot_energy_dynamics_diff(elem,fvm,nets,nete,tl,tl_qdp,outfld_nam ! ! Output energy diagnostics on GLL grid ! -! call outfld(name_out1,elem(ie)%derived%budget(:,:,2,s_ind),npsq,ie) -! call outfld(name_out2,elem(ie)%derived%budget(:,:,3,s_ind),npsq,ie) +! call outfld(name_out1,elem(ie)%derived%budget(:,:,seidx,s_ind),npsq,ie) +! call outfld(name_out2,elem(ie)%derived%budget(:,:,keidx,s_ind),npsq,ie) ! ! mass variables are output on CSLAM grid if using CSLAM else GLL grid ! ! if (ntrac>0) then -! call outfld(name_out3,elem(ie)%derived%budget(:,:,4,s_ind),nc*nc,ie) +! call outfld(name_out3,elem(ie)%derived%budget(:,:,wvidx,s_ind),nc*nc,ie) ! ! sum over liquid water ! ! if (thermodynamic_active_species_liq_num>0) & -! call outfld(name_out4,elem(ie)%derived%budget(:,:,5,s_ind),nc*nc,ie) +! call outfld(name_out4,elem(ie)%derived%budget(:,:,wlidx,s_ind),nc*nc,ie) ! ! sum over ice water ! ! if (thermodynamic_active_species_ice_num>0) & -! call outfld(name_out5,elem(ie)%derived%budget(:,:,6,s_ind),nc*nc,ie) +! call outfld(name_out5,elem(ie)%derived%budget(:,:,wiidx,s_ind),nc*nc,ie) ! ! dry test tracer ! ! if (ixtt>0) & -! call outfld(name_out6,elem(ie)%derived%budget(:,:,7,s_ind),nc*nc,ie) +! call outfld(name_out6,elem(ie)%derived%budget(:,:,ttidx,s_ind),nc*nc,ie) ! else -! call outfld(name_out3,elem(ie)%derived%budget(:,:,4,s_ind),npsq,ie) +! call outfld(name_out3,elem(ie)%derived%budget(:,:,wvidx,s_ind),npsq,ie) ! ! sum over liquid water ! ! if (thermodynamic_active_species_liq_num>0) & -! call outfld(name_out4,elem(ie)%derived%budget(:,:,5,s_ind),npsq,ie) +! call outfld(name_out4,elem(ie)%derived%budget(:,:,wlidx,s_ind),npsq,ie) ! ! sum over ice water ! @@ -1882,7 +1882,7 @@ subroutine calc_tot_energy_dynamics_diff(elem,fvm,nets,nete,tl,tl_qdp,outfld_nam ! dry test tracer ! ! if (ixtt>0) & -! call outfld(name_out6,elem(ie)%derived%budget(:,:,7,s_ind),npsq,ie) +! call outfld(name_out6,elem(ie)%derived%budget(:,:,ttidx,s_ind),npsq,ie) ! end if end do !jt end if @@ -1907,8 +1907,8 @@ subroutine calc_tot_energy_dynamics_diff(elem,fvm,nets,nete,tl,tl_qdp,outfld_nam !!$ if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2)) then !!$ do ie=nets,nete -!!$ call outfld(name_out1 ,elem(ie)%derived%budget(:,:,8,s_ind) ,npsq,ie) -!!$ call outfld(name_out2 ,elem(ie)%derived%budget(:,:,9,s_ind) ,npsq,ie) +!!$ call outfld(name_out1 ,elem(ie)%derived%budget(:,:,mridx,s_ind) ,npsq,ie) +!!$ call outfld(name_out2 ,elem(ie)%derived%budget(:,:,moidx,s_ind) ,npsq,ie) !!$ end do !!$ end if diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index c370f58f16..9bd47eb140 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -21,13 +21,15 @@ subroutine print_budget() use budgets, only: budget_get_global, is_budget use dimensions_mod, only: lcp_moist,qsize use control_mod, only: ftype + use cam_thermo, only: teidx, thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv ! Local variables integer :: i character(len=*), parameter :: subname = 'check_energy:print_budgets' real(r8) :: ph_param,ph_EFIX,ph_DMEA,ph_phys_total real(r8) :: dy_param,dy_EFIX,dy_DMEA,dy_param_and_efix,dy_phys_total - real(r8) :: se_param,se_dmea,se_phys_total, dycore, err, param, pefix, & +!jt real(r8) :: se_param,se_dmea,se_phys_total, dycore, err, param, pefix, & + real(r8) :: dycore, err, param, pefix, & pdmea, phys_total, dyn_total, dyn_phys_total, & rate_of_change_2D_dyn, rate_of_change_vertical_remapping, & diffusion_del4, diffusion_fric, diffusion_del4_tot, diffusion_sponge, & @@ -45,34 +47,29 @@ subroutine print_budget() !-------------------------------------------------------------------------------------- if (masterproc) then - call budget_get_global('phAP-phBP',1,ph_param) - call budget_get_global('phBP-phBF',1,ph_EFIX) - call budget_get_global('phAM-phAP',1,ph_DMEA) - call budget_get_global('phAM-phBF',1,ph_phys_total) + call budget_get_global('phAP-phBP',teidx,ph_param) + call budget_get_global('phBP-phBF',teidx,ph_EFIX) + call budget_get_global('phAM-phAP',teidx,ph_DMEA) + call budget_get_global('phAM-phBF',teidx,ph_phys_total) - call budget_get_global('dyAP-dyBP',1,dy_param) - call budget_get_global('dyBP-dyBF',1,dy_EFIX) - call budget_get_global('dyAM-dyAP',1,dy_DMEA) - call budget_get_global('dyAP-dyBF',1,dy_param_and_efix) - call budget_get_global('dyAM-dyBF',1,dy_phys_total) + call budget_get_global('dyAP-dyBP',teidx,dy_param) + call budget_get_global('dyBP-dyBF',teidx,dy_EFIX) + call budget_get_global('dyAM-dyAP',teidx,dy_DMEA) + call budget_get_global('dyAP-dyBF',teidx,dy_param_and_efix) + call budget_get_global('dyAM-dyBF',teidx,dy_phys_total) -!jt call budget_get_global('dAP-dBP',1,se_param) -!jt call budget_get_global('dAM-dAP',1,se_dmea) -!jt call budget_get_global('dAM-dBF',1,se_phys_total) - - call budget_get_global('dBF-dED',1,dyn_total) -!jt call budget_get_global('dAD-dAF',1,dyn_phys_total) - call budget_get_global('dAD-dBD',1,rate_of_change_2D_dyn) - call budget_get_global('dAR-dAD',1,rate_of_change_vertical_remapping) + call budget_get_global('dBF-dED',teidx,dyn_total) + call budget_get_global('dAD-dBD',teidx,rate_of_change_2D_dyn) + call budget_get_global('dAR-dAD',teidx,rate_of_change_vertical_remapping) dADIA = rate_of_change_2D_dyn+rate_of_change_vertical_remapping - call budget_get_global('dCH-dBH',1,diffusion_del4) - call budget_get_global('dAH-dCH',1,diffusion_fric) - call budget_get_global('dAH-dBH',1,diffusion_del4_tot) - call budget_get_global('dAS-dBS',1,diffusion_sponge) + call budget_get_global('dCH-dBH',teidx,diffusion_del4) + call budget_get_global('dAH-dCH',teidx,diffusion_fric) + call budget_get_global('dAH-dBH',teidx,diffusion_del4_tot) + call budget_get_global('dAS-dBS',teidx,diffusion_sponge) diffusion_total = diffusion_del4_tot+diffusion_sponge - call budget_get_global('dBD-dAF',1,rate_of_change_physics) + call budget_get_global('dBD-dAF',teidx,rate_of_change_physics) rate_of_change_heating_term_put_back_in = diffusion_fric rate_of_change_hvis_sponge = diffusion_sponge @@ -206,8 +203,8 @@ subroutine print_budget() write(iulog,*) "Is globally integrated total energy of state at the end of dynamics (dBF)" write(iulog,*) "and beginning of physics (phBF) the same?" write(iulog,*) "" - call budget_get_global('dBF',1,E_dBF) !state passed to physics - call budget_get_global('phBF',1,E_phBF)!state beginning physics + call budget_get_global('dBF',teidx,E_dBF) !state passed to physics + call budget_get_global('phBF',teidx,E_phBF)!state beginning physics if (abs(E_phBF)>eps) then diff = abs_diff(E_dBF,E_phBF) if (abs(diff)1.E-12_r8) then - write(iulog,*) "Error: mass non-conservation in dynamical core" - - write(iulog,*)"dMASS/dt 2D dynamics (dAD-dBD) ",mass_change__2D_dyn," Pa" - if (is_budget('dAR').and.is_budget('dAD')) then - call budget_get_global('dAR',m_cnst,dar) - call budget_get_global('dAD',m_cnst,dad) - call budget_get_global('dAR-dAD',m_cnst,mass_change__vertical_remapping) - write(iulog,*)"dE/dt vertical remapping (dAR-dAD) ",mass_change__vertical_remapping + do m_cnst=1,thermo_budget_num_vars + if (thermo_budget_vars_massv(m_cnst)) then + + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)thermo_budget_vars_descriptor(m_cnst)//" budget" + write(iulog,*)"------------------------------------------------------------" + call budget_get_global('phBP-phBF',m_cnst,pEFIX) + call budget_get_global('phAM-phAP',m_cnst,pDMEA) + call budget_get_global('phAP-phBP',m_cnst,param) + call budget_get_global('phAM-phBF',m_cnst,phys_total) + + write(iulog,*)"dMASS/dt energy fixer (pBP-pBF) ",pEFIX," Pa" + write(iulog,*)"dMASS/dt parameterizations (pAP-pBP) ",param," Pa" + write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",pDMEA," Pa" + write(iulog,*)"dMASS/dt physics total (pAM-pBF) ",phys_total," Pa" + write(iulog,*)" " + if (is_budget('dAD').and.is_budget('dBD').and.is_budget('dAR').and.is_budget('dCH')) then + call budget_get_global('dAD-dBD',m_cnst,mass_change__2D_dyn) + call budget_get_global('dAR-dAD',m_cnst,mass_change__vertical_remapping) + diff = mass_change__2D_dyn+mass_change__vertical_remapping + write(iulog,*)"dMASS/dt total adiabatic dynamics ",diff," Pa" + if (abs(diff)>1.E-12_r8) then + write(iulog,*) "Error: mass non-conservation in dynamical core" + + write(iulog,*)"dMASS/dt 2D dynamics (dAD-dBD) ",mass_change__2D_dyn," Pa" + if (is_budget('dAR').and.is_budget('dAD')) then + call budget_get_global('dAR',m_cnst,dar) + call budget_get_global('dAD',m_cnst,dad) + call budget_get_global('dAR-dAD',m_cnst,mass_change__vertical_remapping) + write(iulog,*)"dE/dt vertical remapping (dAR-dAD) ",mass_change__vertical_remapping + end if + write(iulog,*)" " + write(iulog,*)"Breakdown of 2D dynamics:" + write(iulog,*)" " + call budget_get_global('dAH-dCH',m_cnst,mass_change__heating_term_put_back_in) + call budget_get_global('dAH-dBH',m_cnst,mass_change__hypervis_total) + write(iulog,*)"dMASS/dt hypervis (dAH-dBH) ",mass_change__hypervis_total," Pa" + write(iulog,*)"dMASS/dt frictional heating (dAH-dCH) ",mass_change__heating_term_put_back_in," Pa" + error = mass_change__2D_dyn-mass_change__hypervis_total + write(iulog,*)"dMASS/dt residual (time truncation errors)",error," Pa" + end if end if write(iulog,*)" " - write(iulog,*)"Breakdown of 2D dynamics:" - write(iulog,*)" " - call budget_get_global('dAH-dCH',m_cnst,mass_change__heating_term_put_back_in) - call budget_get_global('dAH-dBH',m_cnst,mass_change__hypervis_total) - write(iulog,*)"dMASS/dt hypervis (dAH-dBH) ",mass_change__hypervis_total," Pa" - write(iulog,*)"dMASS/dt frictional heating (dAH-dCH) ",mass_change__heating_term_put_back_in," Pa" - error = mass_change__2D_dyn-mass_change__hypervis_total - write(iulog,*)"dMASS/dt residual (time truncation errors)",error," Pa" - end if - end if - write(iulog,*)" " - if (is_budget('dBD').and.is_budget('dAF')) then - call budget_get_global('dBD',m_cnst,dbd) - call budget_get_global('dAF',m_cnst,daf) - call budget_get_global('dBD-dAF',m_cnst,mass_change__physics) - write(iulog,*)"dMASS/dt physics tendency in dynamics (dBD-dAF) ",mass_change__physics," Pa" - val = phys_total-mass_change__physics - write(iulog,*) "Mass physics dynamics coupling error:",val - end if - write(iulog,*)"" - end do - ! + if (is_budget('dBD').and.is_budget('dAF')) then + call budget_get_global('dBD',m_cnst,dbd) + call budget_get_global('dAF',m_cnst,daf) + call budget_get_global('dBD-dAF',m_cnst,mass_change__physics) + write(iulog,*)"dMASS/dt physics tendency in dynamics (dBD-dAF) ",mass_change__physics," Pa" + val = phys_total-mass_change__physics + write(iulog,*) "Mass physics dynamics coupling error:",val + end if + write(iulog,*)"" + end if + end do + ! ! save adiabatic dycore dE/dt and dry-mass adjustment to avoid samping error ! previous_dEdt_adiabatic_dycore = dADIA diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 52c50ef5df..69b85c07be 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -609,7 +609,9 @@ subroutine dyn_init(dyn_in, dyn_out) use control_mod, only: vert_remap_uvTq_alg, vert_remap_tracer_alg use std_atm_profile, only: std_atm_height use dyn_tests_utils, only: vc_dycore, vc_dry_pressure, string_vc, vc_str_lgth - use budgets, only: budget_num, budget_outfld, budget_info + use budgets, only: thermo_budget_history, budget_num, budget_outfld, budget_info + use cam_thermo, only: thermo_budget_vars, thermo_budget_vars_descriptor, & + thermo_budget_vars_unit, thermo_budget_vars_massv, thermo_budget_num_vars ! Dummy arguments: type(dyn_import_t), intent(out) :: dyn_in type(dyn_export_t), intent(out) :: dyn_out @@ -625,7 +627,7 @@ subroutine dyn_init(dyn_in, dyn_out) integer :: m_cnst, m ! variables for initializing energy and axial angular momentum diagnostics - integer, parameter :: num_stages = 12, num_vars = 8 + integer, parameter :: num_stages = 12 character (len = 3), dimension(num_stages) :: stage = (/"dED","dAF","dBD","dAD","dAR","dBF","dBH","dCH","dAH",'dBS','dAS','p2d'/) character (len = 70),dimension(num_stages) :: stage_txt = (/& " end of previous dynamics ",& !dED @@ -641,22 +643,6 @@ subroutine dyn_init(dyn_in, dyn_out) " state after sponge layer diffusion ",& !dAS - state after sponge del2 " phys2dyn mapping errors (requires ftype-1) " & !p2d - for assessing phys2dyn mapping errors /) - character (len = 2) , dimension(num_vars) :: vars = (/"WV" ,"WL" ,"WI" ,"SE" ,"KE" ,"MR" ,"MO" ,"TT" /) - !if ntrac>0 then tracers should be output on fvm grid but not energy (SE+KE) and AAM diags - logical , dimension(num_vars) :: massv = (/.true.,.true.,.true.,.false.,.false.,.false.,.false.,.false./) - character (len = 70) , dimension(num_vars) :: vars_descriptor = (/& - "Total column water vapor ",& - "Total column cloud water ",& - "Total column cloud ice ",& - "Total column static energy ",& - "Total column kinetic energy ",& - "Total column wind axial angular momentum",& - "Total column mass axial angular momentum",& - "Total column test tracer "/) - character (len = 14), dimension(num_vars) :: & - vars_unit = (/& - "kg/m2 ","kg/m2 ","kg/m2 ","J/m2 ",& - "J/m2 ","kg*m2/s*rad2 ","kg*m2/s*rad2 ","kg/m2 "/) integer :: istage, ivars character (len=108) :: str1, str2, str3 @@ -670,6 +656,7 @@ subroutine dyn_init(dyn_in, dyn_out) real(r8) :: km_sponge_factor_local(nlev+1) character(len=64) :: budget_name ! budget names character(len=3) :: budget_pkgtype ! budget type phy or dyn + character(len=3) :: budget_optype ! budget type phy or dyn character(len=128) :: budget_longname ! long name of budgets !---------------------------------------------------------------------------- vc_dycore = vc_dry_pressure @@ -923,44 +910,34 @@ subroutine dyn_init(dyn_in, dyn_out) end if do istage = 1, num_stages - do ivars=1, num_vars - write(str1,*) TRIM(ADJUSTL(vars(ivars))),"_",TRIM(ADJUSTL(stage(istage))) - write(str2,*) TRIM(ADJUSTL(vars_descriptor(ivars)))," ", & - TRIM(ADJUSTL(stage_txt(istage))) - write(str3,*) TRIM(ADJUSTL(vars_unit(ivars))) - if (ntrac>0.and.massv(ivars)) then - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='FVM') + do ivars=1, thermo_budget_num_vars + write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stage(istage))) + write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & + TRIM(ADJUSTL(stage_txt(istage))) + write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) + if (ntrac>0.and.thermo_budget_vars_massv(ivars)) then + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='FVM') else - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='GLL') + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='GLL') end if end do - end do + do ivars=1, 1 + write(str1,*) "WX","_",TRIM(ADJUSTL(stage(istage))) + write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & + TRIM(ADJUSTL(stage_txt(istage))) + write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) + if (ntrac>0.and.thermo_budget_vars_massv(ivars)) then + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='FVM') + else + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='GLL') + end if + end do + ! Register stages for budgets + call budget_add(TRIM(ADJUSTL(stage(istage))), pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) + end do - ! Register stages for budgets - istage=1 - call budget_add('dED', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) - istage=istage+1 - call budget_add('dAF', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) - istage=istage+1 - call budget_add('dBD', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) - istage=istage+1 - call budget_add('dAD', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) - istage=istage+1 - call budget_add('dAR', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) - istage=istage+1 - call budget_add('dBF', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) - istage=istage+1 - call budget_add('dBH', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) - istage=istage+1 - call budget_add('dCH', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) - istage=istage+1 - call budget_add('dAH', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) - istage=istage+1 - call budget_add('dBS', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) - istage=istage+1 - call budget_add('dAS', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) ! - ! Register budgets. + ! Register dif/sum budgets. ! call budget_add('BD_dyn_total','dBF','dED',pkgtype='dyn',optype='dif',longname="dE/dt dyn total (dycore+phys tendency (dBF-dED)",outfld=.true.) @@ -991,15 +968,24 @@ subroutine dyn_init(dyn_in, dyn_out) call budget_add('hrate','dAH','dCH',pkgtype='dyn',optype='dif',longname="rate of change heating term put back in (dAH-dCH)",outfld=.false.) ! register history budget variables + if (thermo_budget_history) then do m=1,budget_num - if (budget_outfld(m)) then - call budget_info(m,name=budget_name,longname=budget_longname,pkgtype=budget_pkgtype) - - if (trim(budget_pkgtype)=='dyn') then - call addfld(trim(budget_name), horiz_only, 'A', 'W/m2', trim(budget_longname)) + call budget_info(m,name=budget_name,longname=budget_longname,pkgtype=budget_pkgtype,optype=budget_optype) + if (trim(budget_pkgtype)=='dyn'.and.(trim(budget_optype)=='dif'.or.trim(budget_optype)=='sum')) then + do ivars=1, thermo_budget_num_vars + write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(budget_name)) + write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & + TRIM(ADJUSTL(budget_longname)) + write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) + if (ntrac>0.and.thermo_budget_vars_massv(ivars)) then + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='FVM') + else + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='GLL') endif + end do end if end do + end if ! add dynamical core tracer tendency output ! @@ -1040,9 +1026,10 @@ subroutine dyn_run(dyn_state) use thread_mod, only: horz_num_threads use time_mod, only: tevolve use budgets, only: budget_cnt,budget_num,& - budget_outfld,budget_count + budget_outfld,budget_count, budget_write use global_norms_mod, only: global_integral, wrap_repro_sum use parallel_mod, only: global_shared_buf, global_shared_sum + use dycore_budget, only: print_budget type(dyn_export_t), intent(inout) :: dyn_state @@ -1055,9 +1042,9 @@ subroutine dyn_run(dyn_state) logical :: ldiag real(r8) :: ftmp(npsq,nlev,3) - real(r8) :: dtime real(r8) :: global_ave real(r8) :: rec2dt, pdel + real(r8) :: dtime real(r8), allocatable, dimension(:,:,:) :: tmp,tmptot,tmpse,tmpke,tmp1,tmp2 real(r8), allocatable, dimension(:,:,:) :: ps_before @@ -1215,8 +1202,11 @@ subroutine dyn_run(dyn_state) ! output vars on CSLAM fvm grid call write_dyn_vars(dyn_state) + if(budget_write(step_offset=nint(dtime))) then call budget_update(dyn_state%elem,dyn_state%fvm, nets, nete, TimeLevel%n0, n0_qdp, hybrid) - + else + call budget_update_dyn_cnts(dyn_state%elem,dyn_state%fvm, nets, nete, TimeLevel%n0, n0_qdp, hybrid) + end if end subroutine dyn_run !=============================================================================== @@ -2403,103 +2393,162 @@ end subroutine write_dyn_vars !========================================================================================= subroutine budget_update(elem,fvm,nets,nete,n0,n0_qdp,hybrid) - - use budgets, only: budget_num, budget_info, budget_me_varnum,budget_put_global + + use budgets, only: budget_write, thermo_budget_history, budget_num, budget_info, budget_put_global use element_mod, only: element_t use fvm_control_volume_mod, only: fvm_struct use global_norms_mod, only: global_integral use air_composition, only: thermodynamic_active_species_liq_num, thermodynamic_active_species_ice_num use prim_advance_mod, only: calc_tot_energy_dynamics_diff use time_manager, only: get_step_size - + use cam_thermo, only: thermo_budget_num_vars, & + thermo_budget_vars_massv,wvidx,wlidx,wiidx,seidx,keidx,moidx,mridx,ttidx,teidx ! arguments type (element_t) , intent(inout) :: elem(:) type(fvm_struct) , intent(in) :: fvm(:) type(hybrid_t) , intent(in) :: hybrid integer , intent(in) :: n0, n0_qdp,nets,nete - + ! Local variables character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn character(len=64) :: name_out1,name_out2,name_out3,name_out4,name_out5,budget_name integer :: budget_state_ind,s_ind,b_ind,i,n,ie logical :: budget_outfld - real(r8) :: budgets_global(budget_num,budget_me_varnum) + real(r8) :: budgets_global(budget_num,thermo_budget_num_vars) real(r8), allocatable, dimension(:,:,:) :: tmp real(r8) :: dtime - + !-------------------------------------------------------------------------------------- - - - ! update energy budget differences and outfld + + + ! update energy budget differences and outfld dtime = get_step_size() do b_ind = 1,budget_num call budget_info(b_ind,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=s_ind,outfld=budget_outfld) - if (budget_pkgtype=='dyn'.and.(budget_optype=='dif'.or.budget_optype=='sum')) & + if (budget_pkgtype=='dyn'.and.(budget_optype=='dif'.or.budget_optype=='sum')) then call calc_tot_energy_dynamics_diff(elem,fvm, nets, nete, n0, n0_qdp,trim(budget_name)) ! ! Output energy diagnostics ! - if (budget_outfld) then + if (thermo_budget_history) then name_out1 = 'SE_' //trim(budget_name) name_out2 = 'KE_' //trim(budget_name) name_out3 = 'WV_' //trim(budget_name) name_out4 = 'WL_' //trim(budget_name) name_out5 = 'WI_' //trim(budget_name) -!!$ do ie=nets,nete -!!$ call outfld(name_out1, elem(ie)%derived%budget(:,:,2,s_ind), nc*nc, ie) -!!$ call outfld(name_out2, elem(ie)%derived%budget(:,:,3,s_ind), nc*nc, ie) -!!$ ! -!!$ ! sum over vapor -!!$ call outfld(name_out3, elem(ie)%derived%budget(:,:,4,s_ind), nc*nc, ie) -!!$ ! -!!$ ! sum over liquid water -!!$ if (thermodynamic_active_species_liq_num>0) & -!!$ call outfld(name_out4, elem(ie)%derived%budget(:,:,5,s_ind), nc*nc, ie) -!!$ ! -!!$ ! sum over ice water -!!$ if (thermodynamic_active_species_ice_num>0) & -!!$ call outfld(name_out5, elem(ie)%derived%budget(:,:,6,s_ind), nc*nc, ie) -!!$ end do + do ie=nets,nete + call outfld(name_out1, elem(ie)%derived%budget(:,:,seidx,s_ind), npsq, ie) + call outfld(name_out2, elem(ie)%derived%budget(:,:,keidx,s_ind), npsq, ie) + ! + ! sum over vapor + call outfld(name_out3, elem(ie)%derived%budget(:,:,wvidx,s_ind), npsq, ie) + ! + ! sum over liquid water + if (thermodynamic_active_species_liq_num>0) & + call outfld(name_out4, elem(ie)%derived%budget(:,:,wlidx,s_ind), npsq, ie) + ! + ! sum over ice water + if (thermodynamic_active_species_ice_num>0) & + call outfld(name_out5, elem(ie)%derived%budget(:,:,wiidx,s_ind), npsq, ie) + end do + end if end if end do - + ! update energy budget globals - + allocate(tmp(np,np,nets:nete)) tmp=0._r8 - + do b_ind=1,budget_num call budget_info(b_ind,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=s_ind) if (budget_pkgtype=='dyn') then - do n=1,budget_me_varnum + do n=1,thermo_budget_num_vars ! Normalize energy sums and convert to W/s - if (elem(nets)%derived%budget_cnt(s_ind).gt.0.) then + tmp=0._r8 + if (elem(nets)%derived%budget_cnt(b_ind).gt.0.) then do ie=nets,nete - tmp(:,:,ie)=elem(ie)%derived%budget(:,:,n,s_ind)/elem(ie)%derived%budget_cnt(s_ind) + tmp(:,:,ie)=elem(ie)%derived%budget(:,:,n,s_ind)/elem(ie)%derived%budget_cnt(b_ind) enddo - else - tmp=0._r8 end if - budgets_global(b_ind,n) = global_integral(elem, tmp(:,:,nets:nete),hybrid,np,nets,nete) + budgets_global(b_ind,n) = global_integral(elem, tmp(:,:,nets:nete),hybrid,np,nets,nete) ! divide by time for proper units if not a mass budget. - if (n.le.3) & - budgets_global(b_ind,n)=budgets_global(b_ind,n)/dtime - if (masterproc) & - call budget_put_global(trim(budget_name),n,budgets_global(b_ind,n)) + if (.not.thermo_budget_vars_massv(n)) & + budgets_global(b_ind,n)=budgets_global(b_ind,n)/dtime + if (masterproc) then + write(iulog,*)"putting global ",trim(budget_name)," m_cnst=",n," ",budgets_global(b_ind,n)," cnt/subcyc/sum_tmp=",elem(nets)%derived%budget_cnt(b_ind),elem(nets)%derived%budget_subcycle(b_ind),sum(tmp(:,:,nets)) + call budget_put_global(trim(budget_name),n,budgets_global(b_ind,n)) + end if end do - - ! reset dyn budget states - ! reset budget counts - stage or diff budget will just be i. If difference must reset components of diff + end if + end do + deallocate(tmp) + + ! reset dyn budget states and counts + do b_ind=1,budget_num + call budget_info(b_ind,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=s_ind) + if (budget_pkgtype=='dyn') then + if (masterproc) & + write(iulog,*)"resetting %budget for ",trim(budget_name) do ie=nets,nete elem(ie)%derived%budget(:,:,:,s_ind)=0._r8 - elem(ie)%derived%budget_cnt(s_ind)=0 + elem(ie)%derived%budget_cnt(b_ind)=0 + elem(ie)%derived%budget_subcycle(b_ind)=0 end do end if end do - + end subroutine budget_update !========================================================================================= +subroutine budget_update_dyn_cnts(elem,fvm,nets,nete,n0,n0_qdp,hybrid) + + use budgets, only: thermo_budget_history, budget_num, budget_info, budget_put_global + use element_mod, only: element_t + use fvm_control_volume_mod, only: fvm_struct + use global_norms_mod, only: global_integral + use air_composition, only: thermodynamic_active_species_liq_num, thermodynamic_active_species_ice_num + use prim_advance_mod, only: calc_tot_energy_dynamics_diff + use time_manager, only: get_step_size + use cam_thermo, only: thermo_budget_num_vars, & + thermo_budget_vars_massv,wvidx,wlidx,wiidx,seidx,keidx,moidx,mridx,ttidx,teidx + ! arguments + type (element_t) , intent(inout) :: elem(:) + type(fvm_struct) , intent(in) :: fvm(:) + type(hybrid_t) , intent(in) :: hybrid + integer , intent(in) :: n0, n0_qdp,nets,nete + + ! Local variables + character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn + character(len=64) :: name_out1,name_out2,name_out3,name_out4,name_out5,budget_name + integer :: budget_state_ind,s_ind,b_ind,i,n,ie + logical :: budget_outfld + + real(r8) :: budgets_global(budget_num,thermo_budget_num_vars) + real(r8), allocatable, dimension(:,:,:) :: tmp + + !-------------------------------------------------------------------------------------- + + + ! update energy budget differences and outfld + + if (thermo_budget_history) then + do b_ind = 1,budget_num + call budget_info(b_ind,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=s_ind,outfld=budget_outfld) + if (budget_pkgtype=='dyn') then + do ie=nets,nete + ! stage budget counts updated in calc_te on the first subcycle need to reset the subcycle count + elem(ie)%derived%budget_subcycle(b_ind)=0 + ! need to update dif and sum budget_counts for normalization + if (budget_optype=='dif'.or.budget_optype=='sum') & + elem(ie)%derived%budget_cnt(b_ind)=elem(ie)%derived%budget_cnt(b_ind)+1 + end do + end if + end do + end if + +end subroutine budget_update_dyn_cnts +!========================================================================================= end module dyn_comp diff --git a/src/physics/cam/cam_diagnostics.F90 b/src/physics/cam/cam_diagnostics.F90 index 94f2192737..a11b95c1a4 100644 --- a/src/physics/cam/cam_diagnostics.F90 +++ b/src/physics/cam/cam_diagnostics.F90 @@ -184,38 +184,6 @@ subroutine diag_init_dry(pbuf2d) integer :: k, m integer :: ierr - ! - ! variables for energy diagnostics - ! - integer :: istage, ivars - character (len=108) :: str1, str2, str3 - integer, parameter :: num_stages = 8, num_vars = 8 - character (len = 4), dimension(num_stages) :: stage = (/"phBF","phBP","phAP","phAM","dyBF","dyBP","dyAP","dyAM"/) - character (len = 45),dimension(num_stages) :: stage_txt = (/& - " before energy fixer ",& !phBF - physics energy - " before parameterizations ",& !phBF - physics energy - " after parameterizations ",& !phAP - physics energy - " after dry mass correction ",& !phAM - physics energy - " before energy fixer (dycore) ",& !dyBF - dynamics energy - " before parameterizations (dycore) ",& !dyBF - dynamics energy - " after parameterizations (dycore) ",& !dyAP - dynamics energy - " after dry mass correction (dycore) " & !dyAM - dynamics energy - /) - character (len = 2) , dimension(num_vars) :: vars = (/"WV" ,"WL" ,"WI" ,"SE" ,"KE" ,"MR" ,"MO" ,"TT" /) - character (len = 45) , dimension(num_vars) :: vars_descriptor = (/& - "Total column water vapor ",& - "Total column liquid water ",& - "Total column frozen water ",& - "Total column dry static energy ",& - "Total column kinetic energy ",& - "Total column wind axial angular momentum",& - "Total column mass axial angular momentum",& - "Total column test tracer "/) - character (len = 14), dimension(num_vars) :: & - vars_unit = (/& - "kg/m2 ","kg/m2 ","kg/m2 ","J/m2 ",& - "J/m2 ","kg*m2/s*rad2 ","kg*m2/s*rad2 ","kg/m2 "/) - ! outfld calls in diag_phys_writeout call addfld (cnst_name(1), (/ 'lev' /), 'A', 'kg/kg', cnst_longname(1)) call addfld ('NSTEP', horiz_only, 'A', 'timestep', 'Model timestep') @@ -412,19 +380,6 @@ subroutine diag_init_dry(pbuf2d) ! and semidiurnal tide in T, U, V, and Z3 call tidal_diag_init() - ! - ! energy diagnostics - ! - do istage = 1, num_stages - do ivars=1, num_vars - write(str1,*) TRIM(ADJUSTL(vars(ivars))),"_",TRIM(ADJUSTL(stage(istage))) - write(str2,*) TRIM(ADJUSTL(vars_descriptor(ivars)))," ", & - TRIM(ADJUSTL(stage_txt(istage))) - write(str3,*) TRIM(ADJUSTL(vars_unit(ivars))) - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2))) - end do - end do - call addfld( 'CPAIRV', (/ 'lev' /), 'I', 'J/K/kg', 'Variable specific heat cap air' ) call addfld( 'RAIRV', (/ 'lev' /), 'I', 'J/K/kg', 'Variable dry air gas constant' ) diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index f82188e42a..14b21755f6 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -1,3 +1,4 @@ + module check_energy !--------------------------------------------------------------------------------- @@ -45,14 +46,29 @@ module check_energy public :: check_energy_timestep_init ! timestep initialization of energy integrals and cumulative boundary fluxes public :: check_energy_chng ! check changes in integrals against cumulative boundary fluxes public :: check_energy_gmean ! global means of physics input and output total energy - public :: check_energy_budget_init ! initialization of energy budget integrals - public :: check_energy_budget ! global budgets of physics energies + public :: check_energy_budgets_init ! initialization of energy budgets (addflds and budget_adds) + public :: check_energy_budget_state_init ! initialization of energy budget integrals + public :: check_energy_phys_budget_update ! global budgets of physics energies + public :: check_energy_phys_cnt_update ! global budgets of physics energies public :: check_energy_fix ! add global mean energy difference as a heating public :: check_tracers_init ! initialize tracer integrals and cumulative boundary fluxes public :: check_tracers_chng ! check changes in integrals against cumulative boundary fluxes public :: calc_te_and_aam_budgets ! calculate and output total energy and axial angular momentum diagnostics + integer, public, parameter :: num_stages = 8 + character (len = 4), dimension(num_stages) :: stage = (/"phBF","phBP","phAP","phAM","dyBF","dyBP","dyAP","dyAM"/) + character (len = 45),dimension(num_stages) :: stage_txt = (/& + " before energy fixer ",& !phBF - physics energy + " before parameterizations ",& !phBF - physics energy + " after parameterizations ",& !phAP - physics energy + " after dry mass correction ",& !phAM - physics energy + " before energy fixer (dycore) ",& !dyBF - dynamics energy + " before parameterizations (dycore) ",& !dyBF - dynamics energy + " after parameterizations (dycore) ",& !dyAP - dynamics energy + " after dry mass correction (dycore) " & !dyAM - dynamics energy + /) + ! Private module data logical :: print_energy_errors = .false. @@ -187,7 +203,6 @@ subroutine check_energy_init() !----------------------------------------------------------------------- use cam_history, only: addfld, add_default, horiz_only use phys_control, only: phys_getopts - use budgets, only: budget_num, budget_outfld, budget_info implicit none @@ -218,24 +233,6 @@ subroutine check_energy_init() call add_default ('DTCORE', 1, ' ') end if -! register history budget variables - do m=1,budget_num - if (budget_outfld(m)) then - call budget_info(m,name=budget_name,longname=budget_longname,pkgtype=budget_pkgtype) - if (trim(budget_pkgtype)=='phy') then - call addfld(trim(budget_name), horiz_only, 'A', 'W/m2', trim(budget_longname)) - endif - end if - end do -!!$ call addfld('BP_phy_params', horiz_only, 'A', 'W/m2', 'dE/dt CAM physics parameterizations (phAP-phBP)') -!!$ call addfld('BD_phy_params', horiz_only, 'A', 'W/m2', 'dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)') -!!$ call addfld('BP_pwork', horiz_only, 'A', 'W/m2', 'dE/dt dry mass adjustment (phAM-phAP)') -!!$ call addfld('BD_pwork', horiz_only, 'A', 'W/m2', 'dE/dt dry mass adjustment using dycore E (dyAM-dyAP)') -!!$ call addfld('BP_efix', horiz_only, 'A', 'W/m2', 'dE/dt energy fixer (phBP-phBF)') -!!$ call addfld('BD_efix', horiz_only, 'A', 'W/m2', 'dE/dt energy fixer using dycore E (dyBP-dyBF)') -!!$ call addfld('BP_phys_tot', horiz_only, 'A', 'W/m2', 'dE/dt physics total (phAM-phBF)') -!!$ call addfld('BD_phys_tot', horiz_only, 'A', 'W/m2', 'dE/dt physics total using dycore E (dyAM-dyBF)') - end subroutine check_energy_init !=============================================================================== @@ -260,7 +257,6 @@ subroutine check_energy_timestep_init(state, tend, pbuf, col_type) real(r8) :: cp_or_cv(state%psetcols,pver) integer lchnk ! chunk identifier integer ncol ! number of atmospheric columns -!jt integer i,k ! column, level indices !----------------------------------------------------------------------- lchnk = state%lchnk @@ -329,7 +325,7 @@ end subroutine check_energy_timestep_init !=============================================================================== - subroutine check_energy_budget_init(state) + subroutine check_energy_budget_state_init(state) !----------------------------------------------------------------------- ! Compute initial values of energy and water integrals, ! zero cumulative tendencies @@ -338,14 +334,86 @@ subroutine check_energy_budget_init(state) !------------------------------Arguments-------------------------------- type(physics_state), intent(inout) :: state -!---------------------------Local storage------------------------------- - integer ncol ! number of atmospheric columns !----------------------------------------------------------------------- -!jt ncol = state%ncol ! zero cummulative boundary fluxes state%te_budgets(:,:,:) = 0._r8 - end subroutine check_energy_budget_init + + end subroutine check_energy_budget_state_init + +!=============================================================================== + + subroutine check_energy_budgets_init() +!----------------------------------------------------------------------- +! Compute initial values of energy and water integrals, +! zero cumulative tendencies +!----------------------------------------------------------------------- + use budgets, only: budget_add, budget_info, budget_num + use cam_history, only: addfld, horiz_only + use cam_thermo, only: thermo_budget_num_vars,thermo_budget_vars, & + thermo_budget_vars_descriptor,thermo_budget_vars_unit +!---------------------------Local storage------------------------------- + ! + ! variables for energy diagnostics + ! + integer :: istage, ivars, i + character (len=256) :: str1, str2, str3 + character(len=32) :: budget_name ! budget names + character(len=3) :: budget_pkgtype,budget_optype + character(len=128) :: budget_longname ! long name of budgets +!----------------------------------------------------------------------- + +! +! energy diagnostics addflds for vars_stage combinations plus budget_adds for +! just the stages as the vars portion is accounted for via an extra array +! dimension in the state%te_budgets array. +! + do istage = 1, num_stages + do ivars=1, thermo_budget_num_vars + write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stage(istage))) + write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & + TRIM(ADJUSTL(stage_txt(istage))) + write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2))) + end do + call budget_add(TRIM(ADJUSTL(stage(istage))),'phy',longname=TRIM(ADJUSTL(stage_txt(istage))),outfld=.true.) + write(iulog,*)'Calling addfld for ',TRIM(ADJUSTL(stage(istage))) + call addfld (TRIM(ADJUSTL(stage(istage))), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(stage_txt(istage)))) + end do + + ! Create budgets that are a sum/dif of 2 stages + + call budget_add('BP_param_and_efix','phAP','phBF','phy','dif',longname='dE/dt CAM physics parameterizations + efix dycore E (phAP-phBF)',outfld=.true.) + call budget_add('BD_param_and_efix','dyAP','dyBF','phy','dif',longname='dE/dt CAM physics parameterizations + efix dycore E (dyAP-dyBF)',outfld=.true.) + call budget_add('BP_phy_params','phAP','phBP','phy','dif',longname='dE/dt CAM physics parameterizations (phAP-phBP)',outfld=.true.) + call budget_add('BD_phy_params','dyAP','dyBP','phy','dif',longname='dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)',outfld=.true.) + call budget_add('BP_pwork','phAM','phAP','phy','dif',longname='dE/dt dry mass adjustment (phAM-phAP)',outfld=.true.) + call budget_add('BD_pwork','dyAM','dyAP','phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)',outfld=.true.) + call budget_add('BP_efix','phBP','phBF','phy','dif',longname='dE/dt energy fixer (phBP-phBF)',outfld=.true.) + call budget_add('BD_efix','dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E (dyBP-dyBF)',outfld=.true.) + call budget_add('BP_phys_tot','phAM','phBF','phy','dif',longname='dE/dt physics total (phAM-phBF)',outfld=.true.) + call budget_add('BD_phys_tot','dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)',outfld=.true.) + + ! create addfld calls for all two stage budgets + do i=1,budget_num + call budget_info(i,name=budget_name,longname=budget_longname,pkgtype=budget_pkgtype,optype=budget_optype) + if (budget_pkgtype=='phy'.and.(budget_optype=='dif'.or.budget_optype=='sum')) then + do ivars=1, thermo_budget_num_vars + write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(budget_name)) + write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & + TRIM(ADJUSTL(budget_longname)) + write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) + write(iulog,*)'Calling addfld for ',TRIM(ADJUSTL(str1)) + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2))) + if (TRIM(ADJUSTL(thermo_budget_vars(ivars)))=='TE') then + write(iulog,*)'Calling addfld for ',TRIM(ADJUSTL(budget_name)) + call addfld (TRIM(ADJUSTL(budget_name)), horiz_only, 'A', 'J/m2',TRIM(ADJUSTL(budget_longname))) + end if + end do + end if + end do + + end subroutine check_energy_budgets_init !=============================================================================== @@ -403,7 +471,6 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & integer lchnk ! chunk identifier integer ncol ! number of atmospheric columns - !jt integer i,k ! column, level indices integer i ! column !----------------------------------------------------------------------- @@ -519,7 +586,6 @@ end subroutine check_energy_chng subroutine check_energy_gmean(state, pbuf2d, dtime, nstep) use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_chunk -!jt use dyn_tests_utils, only: vc_dycore, vc_height use physics_types, only: dyn_te_idx !----------------------------------------------------------------------- ! Compute global mean total energy of physics input and output states @@ -582,15 +648,13 @@ subroutine check_energy_gmean(state, pbuf2d, dtime, nstep) end subroutine check_energy_gmean - subroutine check_energy_budget(state, dtime, nstep) + subroutine check_energy_phys_budget_update(state, dtime, nstep) use cam_history, only: outfld -!jt use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_chunk -!jt use dyn_tests_utils, only: vc_dycore, vc_height -!jt use physics_types, only: phys_te_idx, dyn_te_idx use budgets, only: budget_num, budget_info, & budget_outfld, budget_num_phy, & - budget_me_varnum, budget_put_global + budget_put_global + use cam_thermo, only: thermo_budget_num_vars, thermo_budget_vars_massv use cam_abortutils, only: endrun use dycore_budget, only: print_budget !----------------------------------------------------------------------- @@ -609,20 +673,18 @@ subroutine check_energy_budget(state, dtime, nstep) integer :: ncol ! number of active columns integer :: lchnk ! chunk index -!jt real(r8),allocatable :: te(pcols,begchunk:endchunk,budget_num_phy) real(r8),allocatable :: te(:,:,:,:) ! total energy of input/output states (copy) -!jt real(r8),allocatable :: te_glob(budget_num_phy) ! global means of total energy real(r8),allocatable :: te_glob(:,:) ! global means of total energy - integer :: i,ii,ind,is1,is2,is1b,is2b + integer :: i,ii,s_ind,is1,is2,is1b,is2b character*32 :: budget_name ! parameterization name for fluxes character*3 :: budget_pkgtype ! parameterization type phy or dyn character*3 :: budget_optype ! dif or stg !----------------------------------------------------------------------- if (.not.allocated (te)) then - allocate( te(pcols,begchunk:endchunk,budget_num_phy,budget_me_varnum)) + allocate( te(pcols,begchunk:endchunk,budget_num_phy,thermo_budget_num_vars)) end if if (.not.allocated (te_glob)) then - allocate( te_glob(budget_num_phy,budget_me_varnum)) + allocate( te_glob(budget_num_phy,thermo_budget_num_vars)) else write(iulog,*)'no alloc call shape te_glob=',shape(te_glob) end if @@ -638,60 +700,108 @@ subroutine check_energy_budget(state, dtime, nstep) if (budget_optype=='dif') then call budget_info(ii,stg1stateidx=is1, stg2stateidx=is2,stg1index=is1b,stg2index=is2b) if (state(lchnk)%budget_cnt(is1b).ne.state(lchnk)%budget_cnt(is2b)) then - write(iulog,*)'budget_cnt mismatch stage1=',state(lchnk)%budget_cnt(is1b),'stage2=',state(lchnk)%budget_cnt(is2b) + if (lchnk==begchunk.and.masterproc) write(iulog,*)'budget_cnt mismatch stage1=',state(lchnk)%budget_cnt(is1b),'stage2=',state(lchnk)%budget_cnt(is2b) call endrun() end if if (state(lchnk)%budget_cnt(is1b)==0.or.state(lchnk)%budget_cnt(is2b)==0) then te(:,lchnk,i,:)=0._r8 - else + if (lchnk==begchunk.and.masterproc) write(iulog,*)'zeroing:',budget_name,' cnt1:',state(lchnk)%budget_cnt(is1b),' cnt2 ',state(lchnk)%budget_cnt(is2b) + else + if (lchnk==begchunk.and.masterproc) write(iulog,*)'dif and norm into te:',budget_name,' cnt:',state(lchnk)%budget_cnt(ii),' cnt1:',state(lchnk)%budget_cnt(is1b),'budget index ii/is1b=',ii,'/',is1b te(:,lchnk,i,:) = (state(lchnk)%te_budgets(:,:,is1)-state(lchnk)%te_budgets(:,:,is2))/state(lchnk)%budget_cnt(is1b) end if else if (budget_optype=='sum') then call budget_info(ii,stg1stateidx=is1, stg2stateidx=is2,stg1index=is1b,stg2index=is2b) if (state(lchnk)%budget_cnt(is1b).ne.state(lchnk)%budget_cnt(is2b)) then - write(iulog,*)'budget_cnt mismatch stage1=',state(lchnk)%budget_cnt(is1b),'stage2=',state(lchnk)%budget_cnt(is2b) + if (lchnk==begchunk.and.masterproc) write(iulog,*)'budget_cnt mismatch stage1=',state(lchnk)%budget_cnt(is1b),'stage2=',state(lchnk)%budget_cnt(is2b) call endrun() end if if (state(lchnk)%budget_cnt(is1b)==0.or.state(lchnk)%budget_cnt(is2b)==0) then te(:,lchnk,i,:)=0._r8 else + if (lchnk==begchunk.and.masterproc) write(iulog,*)'sum and norm into te:',budget_name,' cnt:',state(lchnk)%budget_cnt(ii),' cnt1:',state(lchnk)%budget_cnt(is1b),'budget index ii/is1b=',ii,'/',is1b te(:,lchnk,i,:) = (state(lchnk)%te_budgets(:,:,is1)+state(lchnk)%te_budgets(:,:,is2))/state(lchnk)%budget_cnt(is1b) end if else - te(:,lchnk,i,:)=state(lchnk)%te_budgets(:,:,i) + if (state(lchnk)%budget_cnt(ii)==0) then + te(:,lchnk,i,:)=0._r8 + if (lchnk==begchunk.and.masterproc) write(iulog,*)'zeroing:',budget_name,' cnt:',state(lchnk)%budget_cnt(ii),' ii=',ii,"current vals=",state(lchnk)%te_budgets(:,:,ii) + else + if (lchnk==begchunk.and.masterproc) write(iulog,*)'norm and read into te:',budget_name,' cnt:',state(lchnk)%budget_cnt(ii),'budget index=',ii + te(:,lchnk,i,:)=state(lchnk)%te_budgets(:,:,i)/state(lchnk)%budget_cnt(ii) + end if end if if (budget_outfld(i).and.budget_pkgtype=='phy') call outfld(trim(budget_name), te(:ncol,lchnk,i,1), pcols, lchnk) end if end do end do ! Compute global means of budgets - do i=1,budget_me_varnum + do i=1,thermo_budget_num_vars call gmean(te(:,:,:,i), te_glob(:,i), budget_num_phy) !divide by time to get flux if not a mass budget - if (i.le.3) te_glob(:,i)=te_glob(:,i)/dtime - end do - do ii=1,budget_num - call budget_info(ii,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=i) - if (budget_pkgtype=='phy') then - do lchnk = begchunk, endchunk - state(lchnk)%budget_cnt(ii)=0 - end do - end if + if (.not.thermo_budget_vars_massv(i)) te_glob(:,i)=te_glob(:,i)/dtime end do if (masterproc) then do ii=1,budget_num - call budget_info(ii,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=ind) + call budget_info(ii,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=s_ind) if (budget_pkgtype=='phy') then - do i=1,budget_me_varnum - call budget_put_global(trim(budget_name),i,te_glob(ind,i)) -!jt write(iulog,*)"putting global ",trim(budget_name)," m_cnst=",i," ",te_glob(ind,i) + do i=1,thermo_budget_num_vars + call budget_put_global(trim(budget_name),i,te_glob(s_ind,i)) + if (budget_optype=='dif'.or.budget_optype=='sum') then + call budget_info(ii,stg1index=is1b) + write(iulog,*)"putting global ",trim(budget_name)," m_cnst=",i," ",te_glob(s_ind,i)," cnt=",state(begchunk)%budget_cnt(is1b),"is1b=",is1b + else + write(iulog,*)"putting global ",trim(budget_name)," m_cnst=",i," ",te_glob(s_ind,i)," cnt=",state(begchunk)%budget_cnt(ii),"ii=",ii + end if end do end if end do end if call print_budget() - end subroutine check_energy_budget + do lchnk = begchunk, endchunk + state(lchnk)%budget_cnt(:)=0._r8 + state(lchnk)%te_budgets(:,:,:)=0._r8 + end do + + end subroutine check_energy_phys_budget_update + subroutine check_energy_phys_cnt_update(state) + + use budgets, only: budget_num, budget_info, & + budget_outfld, budget_num_phy, & + budget_put_global + use cam_abortutils, only: endrun + use dycore_budget, only: print_budget +!----------------------------------------------------------------------- +! Compute global mean total energy of physics input and output states +! computed consistently with dynamical core vertical coordinate +! (under hydrostatic assumption) +!----------------------------------------------------------------------- +!------------------------------Arguments-------------------------------- + + type(physics_state), intent(inout ), dimension(begchunk:endchunk) :: state + +!---------------------------Local storage------------------------------- + integer :: ncol ! number of active columns + integer :: lchnk ! chunk index + + integer :: i,ii,s_ind,is1,is2,is1b,is2b + character*32 :: budget_name ! parameterization name for fluxes + character*3 :: budget_pkgtype ! parameterization type phy or dyn + character*3 :: budget_optype ! dif or stg +!----------------------------------------------------------------------- + do lchnk = begchunk, endchunk + ncol = state(lchnk)%ncol + do ii=1,budget_num + call budget_info(ii,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=i) + if (budget_pkgtype=='phy'.and.(budget_optype=='dif'.or.budget_optype=='sub')) then + state(lchnk)%budget_cnt(ii)=state(lchnk)%budget_cnt(ii)+1 + call budget_info(ii,stg1index=is1b,stg2index=is2b) + if (lchnk==begchunk .and. masterproc) write(iulog,*)trim(budget_name)," cnt(",ii,") updated to ",state(lchnk)%budget_cnt(ii),'stage1=',state(lchnk)%budget_cnt(is1b),'stage2=',state(lchnk)%budget_cnt(is2b),' is1b/is2b=',is1b,'/',is2b + end if + end do + end do + end subroutine check_energy_phys_cnt_update !=============================================================================== subroutine check_energy_fix(state, ptend, nstep, eshflx) @@ -943,11 +1053,13 @@ end subroutine check_tracers_chng subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) use physconst, only: gravit,cpair,pi,rearth,omega - use cam_thermo, only: get_hydrostatic_energy + use cam_thermo, only: get_hydrostatic_energy,thermo_budget_num_vars,thermo_budget_vars, & + wvidx,wlidx,wiidx,seidx,keidx,moidx,mridx,ttidx,teidx,poidx use cam_history, only: hist_fld_active, outfld use dyn_tests_utils, only: vc_physics, vc_height use cam_abortutils, only: endrun use budgets, only: budget_info_byname + use cam_history_support, only: max_fieldname_len !------------------------------Arguments-------------------------------- type(physics_state), intent(inout) :: state @@ -956,7 +1068,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) !---------------------------Local storage------------------------------- real(r8) :: se(pcols) ! Dry Static energy (J/m2) - real(r8) :: po(pcols) ! Dry Static energy (J/m2) + real(r8) :: po(pcols) ! surface potential or potential energy (J/m2) real(r8) :: ke(pcols) ! kinetic energy (J/m2) real(r8) :: wv(pcols) ! column integrated vapor (kg/m2) real(r8) :: liq(pcols) ! column integrated liquid (kg/m2) @@ -974,20 +1086,24 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) integer :: ncol ! number of atmospheric columns integer :: i,k ! column, level indices integer :: vc_loc ! local vertical coordinate variable - integer :: s_ind,b_ind ! budget array index + integer :: s_ind,b_ind ! budget array index integer :: ixtt ! test tracer index - character(len=32) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 + character(len=32) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6,name_out7 + character(len=max_fieldname_len) :: name_out(thermo_budget_num_vars) + !----------------------------------------------------------------------- + + do i=1,thermo_budget_num_vars + name_out(i)=trim(thermo_budget_vars(i))//'_'//trim(outfld_name_suffix) + end do name_out1 = 'SE_' //trim(outfld_name_suffix) name_out2 = 'KE_' //trim(outfld_name_suffix) name_out3 = 'WV_' //trim(outfld_name_suffix) name_out4 = 'WL_' //trim(outfld_name_suffix) name_out5 = 'WI_' //trim(outfld_name_suffix) name_out6 = 'TT_' //trim(outfld_name_suffix) - -!jt if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2).or.hist_fld_active(name_out3).or.& -!jt hist_fld_active(name_out4).or.hist_fld_active(name_out5).or.hist_fld_active(name_out6)) then + name_out7 = 'TE_' //trim(outfld_name_suffix) lchnk = state%lchnk ncol = state%ncol @@ -1051,24 +1167,33 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) end if end if - state%te_budgets(1:ncol,1,s_ind)=(se(1:ncol)+ke(1:ncol)+po(1:ncol)) - state%te_budgets(1:ncol,2,s_ind)=se(1:ncol) - state%te_budgets(1:ncol,3,s_ind)=ke(1:ncol) - state%te_budgets(1:ncol,4,s_ind)=wv(1:ncol) - state%te_budgets(1:ncol,5,s_ind)=liq(1:ncol) - state%te_budgets(1:ncol,6,s_ind)=ice(1:ncol) - state%te_budgets(1:ncol,7,s_ind)=tt(1:ncol) + state%te_budgets(1:ncol,teidx,s_ind)=state%te_budgets(1:ncol,teidx,s_ind)+(se(1:ncol)+ke(1:ncol)+po(1:ncol)) + state%te_budgets(1:ncol,seidx,s_ind)= state%te_budgets(1:ncol,seidx,s_ind)+se(1:ncol) + state%te_budgets(1:ncol,poidx,s_ind)= state%te_budgets(1:ncol,poidx,s_ind)+po(1:ncol) + state%te_budgets(1:ncol,keidx,s_ind)= state%te_budgets(1:ncol,keidx,s_ind)+ke(1:ncol) + state%te_budgets(1:ncol,wvidx,s_ind)= state%te_budgets(1:ncol,wvidx,s_ind)+wv(1:ncol) + state%te_budgets(1:ncol,wlidx,s_ind)= state%te_budgets(1:ncol,wlidx,s_ind)+liq(1:ncol) + state%te_budgets(1:ncol,wiidx,s_ind)= state%te_budgets(1:ncol,wiidx,s_ind)+ice(1:ncol) + state%te_budgets(1:ncol,ttidx,s_ind)= state%te_budgets(1:ncol,ttidx,s_ind)+tt(1:ncol) state%budget_cnt(b_ind)=state%budget_cnt(b_ind)+1 - ! Output energy diagnostics - call outfld(name_out1 ,se , pcols ,lchnk ) - call outfld(name_out2 ,ke , pcols ,lchnk ) - call outfld(name_out3 ,wv , pcols ,lchnk ) - call outfld(name_out4 ,liq , pcols ,lchnk ) - call outfld(name_out5 ,ice , pcols ,lchnk ) - call outfld(name_out6 ,tt , pcols ,lchnk ) -!!jt end if + call outfld(name_out1 ,se+po ,pcols ,lchnk ) + call outfld(name_out2 ,ke ,pcols ,lchnk ) + call outfld(name_out3 ,wv ,pcols ,lchnk ) + call outfld(name_out4 ,liq ,pcols ,lchnk ) + call outfld(name_out5 ,ice ,pcols ,lchnk ) + call outfld(name_out6 ,tt ,pcols ,lchnk ) + call outfld(name_out7 ,se+ke+po ,pcols ,lchnk ) + +!!$ call outfld(name_out(seidx) ,se , pcols ,lchnk ) +!!$ call outfld(name_out(keidx) ,ke , pcols ,lchnk ) +!!$ call outfld(name_out(wiidx) ,wv , pcols ,lchnk ) +!!$ call outfld(name_out(wlidx) ,liq , pcols ,lchnk ) +!!$ call outfld(name_out(wiidx) ,ice , pcols ,lchnk ) +!!$ call outfld(name_out(ttidx) ,tt , pcols ,lchnk ) +!!$ call outfld(name_out(teidx) ,te , pcols ,lchnk ) + ! ! Axial angular momentum diagnostics ! @@ -1104,9 +1229,15 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) mo(i) = mo(i) + mo_tmp end do end do + state%te_budgets(1:ncol,moidx,s_ind)=mo(1:ncol) + state%te_budgets(1:ncol,mridx,s_ind)=mr(1:ncol) + call outfld(name_out(mridx) ,mr, pcols,lchnk ) + call outfld(name_out(moidx) ,mo, pcols,lchnk ) + call outfld(name_out1 ,mr, pcols,lchnk ) call outfld(name_out2 ,mo, pcols,lchnk ) !!jt end if end subroutine calc_te_and_aam_budgets + end module check_energy diff --git a/src/physics/cam/physics_types.F90 b/src/physics/cam/physics_types.F90 index eb14719330..ace701d4bd 100644 --- a/src/physics/cam/physics_types.F90 +++ b/src/physics/cam/physics_types.F90 @@ -14,7 +14,7 @@ module physics_types use cam_abortutils, only: endrun use phys_control, only: waccmx_is use shr_const_mod, only: shr_const_rwv - use budgets, only: budget_array_max,budget_name,budget_me_varnum + use budgets, only: budget_array_max,budget_name implicit none private ! Make default type private to the module @@ -1320,6 +1320,7 @@ subroutine physics_state_copy(state_in, state_out) use ppgrid, only: pver, pverp use constituents, only: pcnst + use cam_thermo, only: thermo_budget_num_vars implicit none @@ -1410,7 +1411,7 @@ subroutine physics_state_copy(state_in, state_out) end do do m = 1, budget_array_max - do k = 1, budget_me_varnum + do k = 1, thermo_budget_num_vars do i = 1, ncol state_out%te_budgets(i,k,m) = state_in%te_budgets(i,k,m) end do @@ -1537,7 +1538,8 @@ end subroutine set_dry_to_wet subroutine physics_state_alloc(state,lchnk,psetcols) - use infnan, only : inf, assignment(=) + use infnan, only: inf, assignment(=) + use cam_thermo, only: thermo_budget_num_vars ! allocate the individual state components @@ -1628,7 +1630,7 @@ subroutine physics_state_alloc(state,lchnk,psetcols) allocate(state%q(psetcols,pver,pcnst), stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%q') - allocate(state%te_budgets(psetcols,7,budget_array_max), stat=ierr) + allocate(state%te_budgets(psetcols,thermo_budget_num_vars,budget_array_max), stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%te_budgets') allocate(state%budget_cnt(budget_array_max), stat=ierr) diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 89bca4fc8e..46528f4694 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -157,7 +157,6 @@ subroutine phys_register use dyn_comp, only: dyn_register use spcam_drivers, only: spcam_register use offline_driver, only: offline_driver_reg - use budgets, only: budget_add use upper_bc, only: ubc_fixed_conc !---------------------------Local variables----------------------------- @@ -189,38 +188,6 @@ subroutine phys_register ! Register the subcol scheme call subcol_register() - ! Register stages for budgets. - call budget_add('phAP','phy',longname='vertically integrated phys energy after physics',outfld=.true.) - call budget_add('dyAP','phy',longname='vertically integrated dyn energy after physics',outfld=.true.) - call budget_add('phBP','phy',longname='vertically integrated phys energy before physics',outfld=.true.) - call budget_add('dyBP','phy',longname='vertically integrated dyn energy before physics',outfld=.true.) - call budget_add('phBF','phy',longname='vertically integrated phys energy before fixer',outfld=.true.) - call budget_add('dyBF','phy',longname='vertically integrated dyn energy before fixer',outfld=.true.) - call budget_add('phAM','phy',longname='vertically integrated phys energy after dry mass adj',outfld=.true.) - call budget_add('dyAM','phy',longname='vertically integrated dyn energy after dry mass adj',outfld=.true.) - - ! Register budgets. -!!$ call budget_add('BP_phy_params',iphAP,iphBP,'phy','dif',longname='dE/dt CAM physics parameterizations (phAP-phBP)',outfld=.true.) -!!$ call budget_add('BD_phy_params',idyAP,idyBP,'phy','dif',longname='dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)',outfld=.true.) -!!$ call budget_add('BP_pwork',iphAM,iphAP,'phy','dif',longname='dE/dt dry mass adjustment (phAM-phAP)',outfld=.true.) -!!$ call budget_add('BD_pwork',idyAM,idyAP,'phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)',outfld=.true.) -!!$ call budget_add('BP_efix',iphBP,iphBF,'phy','dif',longname='dE/dt energy fixer (phBP-phBF)',outfld=.true.) -!!$ call budget_add('BD_efix',idyBP,idyBF,'phy','dif',longname='dE/dt energy fixer using dycore E (dyBP-dyBF)',outfld=.true.) -!!$ call budget_add('BP_phys_tot',iphAM,iphBF,'phy','dif',longname='dE/dt physics total (phAM-phBF)',outfld=.true.) -!!$ call budget_add('BD_phys_tot',idyAM,idyBF,'phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)',outfld=.true.) - - ! Register budgets. - call budget_add('BP_param_and_efix','phAP','phBF','phy','dif',longname='dE/dt CAM physics parameterizations + efix dycore E (phAP-phBF)',outfld=.true.) - call budget_add('BP_phy_params','phAP','phBP','phy','dif',longname='dE/dt CAM physics parameterizations (phAP-phBP)',outfld=.true.) - call budget_add('BD_phy_params','dyAP','dyBP','phy','dif',longname='dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)',outfld=.true.) - call budget_add('BP_pwork','phAM','phAP','phy','dif',longname='dE/dt dry mass adjustment (phAM-phAP)',outfld=.true.) - call budget_add('BD_pwork','dyAM','dyAP','phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)',outfld=.true.) - call budget_add('BP_efix','phBP','phBF','phy','dif',longname='dE/dt energy fixer (phBP-phBF)',outfld=.true.) - call budget_add('BD_efix','dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E (dyBP-dyBF)',outfld=.true.) - call budget_add('BP_phys_tot','phAM','phBF','phy','dif',longname='dE/dt physics total (phAM-phBF)',outfld=.true.) - call budget_add('BD_phys_tot','dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)',outfld=.true.) - call budget_add('BD_param_and_efix','dyAP','dyBF','phy','dif',longname='dE/dt parameterizations + efix dycore E (dyAP-dyBF)',outfld=.true.) - ! Register water vapor. ! ***** N.B. ***** This must be the first call to cnst_add so that ! water vapor is constituent 1. @@ -809,7 +776,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use cam_snapshot, only: cam_snapshot_init use cam_history, only: addfld, register_vector_field, add_default, horiz_only use phys_control, only: phys_getopts - use check_energy, only: check_energy_budget_init + use check_energy, only: check_energy_budgets_init, check_energy_budget_state_init ! Input/output arguments type(physics_state), pointer :: phys_state(:) @@ -821,7 +788,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! local variables integer :: lchnk - integer :: i,ierr + integer :: ierr logical :: history_budget ! output tendencies and state variables for ! temperature, water vapor, cloud @@ -836,8 +803,9 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) do lchnk = begchunk, endchunk call physics_state_set_grid(lchnk, phys_state(lchnk)) - call check_energy_budget_init(phys_state(lchnk)) + call check_energy_budget_state_init(phys_state(lchnk)) end do + call check_energy_budgets_init() !------------------------------------------------------------------------------------------- ! Initialize any variables in cam_thermo which are not temporally and/or spatially constant @@ -1093,9 +1061,10 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) ! First part of atmospheric physics package before updating of surface models ! !----------------------------------------------------------------------- + use budgets, only: budget_write use time_manager, only: get_nstep use cam_diagnostics,only: diag_allocate, diag_physvar_ic - use check_energy, only: check_energy_gmean, check_energy_budget + use check_energy, only: check_energy_gmean, check_energy_phys_budget_update, check_energy_phys_cnt_update use phys_control, only: phys_getopts use spcam_drivers, only: tphysbc_spcam use spmd_utils, only: mpicom @@ -1148,8 +1117,14 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) ! Compute total energy of input state and previous output state call t_startf ('chk_en_gmean') call check_energy_gmean(phys_state, pbuf2d, ztodt, nstep) - call check_energy_budget(phys_state, ztodt, nstep) call t_stopf ('chk_en_gmean') + call t_startf ('chk_en_p_budget_update') + if(budget_write()) then + call check_energy_phys_budget_update(phys_state, ztodt, nstep) + else + call check_energy_phys_cnt_update(phys_state) + end if + call t_stopf ('chk_en_p_budget_update') call t_stopf ('physpkg_st1') diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index 2f4fec52e8..8155ea45f8 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -177,37 +177,27 @@ subroutine phys_register ! Register the subcol scheme call subcol_register() - ! Register stages for budgets. - call budget_add('phAP','phy',longname='vertically integrated phys energy after physics',outfld=.true.) - call budget_add('dyAP','phy',longname='vertically integrated dyn energy after physics',outfld=.true.) - call budget_add('phBP','phy',longname='vertically integrated phys energy before physics',outfld=.true.) - call budget_add('dyBP','phy',longname='vertically integrated dyn energy before physics',outfld=.true.) - call budget_add('phBF','phy',longname='vertically integrated phys energy before fixer',outfld=.true.) - call budget_add('dyBF','phy',longname='vertically integrated dyn energy before fixer',outfld=.true.) - call budget_add('phAM','phy',longname='vertically integrated phys energy after dry mass adj',outfld=.true.) - call budget_add('dyAM','phy',longname='vertically integrated dyn energy after dry mass adj',outfld=.true.) - - ! Register budgets. -!!$ call budget_add('BP_phy_params',iphAP,iphBP,'phy','dif',longname='dE/dt CAM physics parameterizations (phAP-phBP)',outfld=.true.) -!!$ call budget_add('BD_phy_params',idyAP,idyBP,'phy','dif',longname='dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)',outfld=.true.) -!!$ call budget_add('BP_pwork',iphAM,iphAP,'phy','dif',longname='dE/dt dry mass adjustment (phAM-phAP)',outfld=.true.) -!!$ call budget_add('BD_pwork',idyAM,idyAP,'phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)',outfld=.true.) -!!$ call budget_add('BP_efix',iphBP,iphBF,'phy','dif',longname='dE/dt energy fixer (phBP-phBF)',outfld=.true.) -!!$ call budget_add('BD_efix',idyBP,idyBF,'phy','dif',longname='dE/dt energy fixer using dycore E (dyBP-dyBF)',outfld=.true.) -!!$ call budget_add('BP_phys_tot',iphAM,iphBF,'phy','dif',longname='dE/dt physics total (phAM-phBF)',outfld=.true.) -!!$ call budget_add('BD_phys_tot',idyAM,idyBF,'phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)',outfld=.true.) - - ! Register budgets. - call budget_add('BP_param_and_efix','phAP','phBF','phy','dif',longname='dE/dt CAM physics parameterizations + efix dycore E (phAP-phBF)',outfld=.true.) - call budget_add('BP_phy_params','phAP','phBP','phy','dif',longname='dE/dt CAM physics parameterizations (phAP-phBP)',outfld=.true.) - call budget_add('BD_phy_params','dyAP','dyBP','phy','dif',longname='dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)',outfld=.true.) - call budget_add('BP_pwork','phAM','phAP','phy','dif',longname='dE/dt dry mass adjustment (phAM-phAP)',outfld=.true.) - call budget_add('BD_pwork','dyAM','dyAP','phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)',outfld=.true.) - call budget_add('BP_efix','phBP','phBF','phy','dif',longname='dE/dt energy fixer (phBP-phBF)',outfld=.true.) - call budget_add('BD_efix','dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E (dyBP-dyBF)',outfld=.true.) - call budget_add('BP_phys_tot','phAM','phBF','phy','dif',longname='dE/dt physics total (phAM-phBF)',outfld=.true.) - call budget_add('BD_phys_tot','dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)',outfld=.true.) - call budget_add('BD_param_and_efix','dyAP','dyBF','phy','dif',longname='dE/dt parameterizations + efix dycore E (dyAP-dyBF)',outfld=.true.) +!!$ ! Register stages for budgets. +!!$ call budget_add('phAP','phy',longname='vertically integrated phys energy after physics',outfld=.true.) +!!$ call budget_add('dyAP','phy',longname='vertically integrated dyn energy after physics',outfld=.true.) +!!$ call budget_add('phBP','phy',longname='vertically integrated phys energy before physics',outfld=.true.) +!!$ call budget_add('dyBP','phy',longname='vertically integrated dyn energy before physics',outfld=.true.) +!!$ call budget_add('phBF','phy',longname='vertically integrated phys energy before fixer',outfld=.true.) +!!$ call budget_add('dyBF','phy',longname='vertically integrated dyn energy before fixer',outfld=.true.) +!!$ call budget_add('phAM','phy',longname='vertically integrated phys energy after dry mass adj',outfld=.true.) +!!$ call budget_add('dyAM','phy',longname='vertically integrated dyn energy after dry mass adj',outfld=.true.) +!!$ +!!$ ! Register budgets. +!!$ call budget_add('BP_param_and_efix','phAP','phBF','phy','dif',longname='dE/dt CAM physics parameterizations + efix dycore E (phAP-phBF)',outfld=.true.) +!!$ call budget_add('BP_phy_params','phAP','phBP','phy','dif',longname='dE/dt CAM physics parameterizations (phAP-phBP)',outfld=.true.) +!!$ call budget_add('BD_phy_params','dyAP','dyBP','phy','dif',longname='dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)',outfld=.true.) +!!$ call budget_add('BP_pwork','phAM','phAP','phy','dif',longname='dE/dt dry mass adjustment (phAM-phAP)',outfld=.true.) +!!$ call budget_add('BD_pwork','dyAM','dyAP','phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)',outfld=.true.) +!!$ call budget_add('BP_efix','phBP','phBF','phy','dif',longname='dE/dt energy fixer (phBP-phBF)',outfld=.true.) +!!$ call budget_add('BD_efix','dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E (dyBP-dyBF)',outfld=.true.) +!!$ call budget_add('BP_phys_tot','phAM','phBF','phy','dif',longname='dE/dt physics total (phAM-phBF)',outfld=.true.) +!!$ call budget_add('BD_phys_tot','dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)',outfld=.true.) +!!$ call budget_add('BD_param_and_efix','dyAP','dyBF','phy','dif',longname='dE/dt parameterizations + efix dycore E (dyAP-dyBF)',outfld=.true.) ! Register water vapor. ! ***** N.B. ***** This must be the first call to cnst_add so that @@ -787,7 +777,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use cam_snapshot, only: cam_snapshot_init use cam_history, only: addfld, register_vector_field, add_default use budgets, only: budget_num, budget_info, budget_outfld, budget_init - use check_energy, only: check_energy_budget_init + use check_energy, only: check_energy_budgets_init, check_energy_budget_state_init ! Input/output arguments type(physics_state), pointer :: phys_state(:) @@ -799,7 +789,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! local variables integer :: lchnk - integer :: i,ierr + integer :: ierr logical :: history_budget ! output tendencies and state variables for ! temperature, water vapor, cloud @@ -814,8 +804,9 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) do lchnk = begchunk, endchunk call physics_state_set_grid(lchnk, phys_state(lchnk)) - call check_energy_budget_init(phys_state(lchnk)) + call check_energy_budget_state_init(phys_state(lchnk)) end do + call check_energy_budgets_init() !------------------------------------------------------------------------------------------- ! Initialize any variables in cam_thermo which are not temporally and/or spatially constant @@ -1056,9 +1047,10 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) ! First part of atmospheric physics package before updating of surface models ! !----------------------------------------------------------------------- + use budgets, only: budget_write use time_manager, only: get_nstep use cam_diagnostics,only: diag_allocate, diag_physvar_ic - use check_energy, only: check_energy_gmean, check_energy_budget + use check_energy, only: check_energy_gmean, check_energy_phys_budget_update, check_energy_phys_cnt_update use spmd_utils, only: mpicom use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_allocate #if (defined BFB_CAM_SCAM_IOP ) @@ -1108,8 +1100,14 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) ! Compute total energy of input state and previous output state call t_startf ('chk_en_gmean') call check_energy_gmean(phys_state, pbuf2d, ztodt, nstep) - call check_energy_budget(phys_state, ztodt, nstep) call t_stopf ('chk_en_gmean') + call t_startf ('chk_en_p_budget_update') + if(budget_write()) then + call check_energy_phys_budget_update(phys_state, ztodt, nstep) + else + call check_energy_phys_cnt_update(phys_state) + end if + call t_stopf ('chk_en_p_budget_update') call pbuf_allocate(pbuf2d, 'physpkg') call diag_allocate() @@ -2362,7 +2360,7 @@ subroutine tphysac (ztodt, cam_in, & call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) call calc_te_and_aam_budgets(state, 'phAM') - call calc_te_and_aam_budgets(state, 'dyAM',vc=vc_dycore) + call calc_te_and_aam_budgets(state, 'dyAM', vc=vc_dycore) ! Restore pre-"physics_dme_adjust" tracers state%q(:ncol,:pver,:pcnst) = tmp_trac(:ncol,:pver,:pcnst) state%pdel(:ncol,:pver) = tmp_pdel(:ncol,:pver) @@ -2384,7 +2382,7 @@ subroutine tphysac (ztodt, cam_in, & end if call calc_te_and_aam_budgets(state, 'phAM') - call calc_te_and_aam_budgets(state, 'dyAM',vc=vc_dycore) + call calc_te_and_aam_budgets(state, 'dyAM', vc=vc_dycore) endif !!! REMOVE THIS CALL, SINCE ONLY Q IS BEING ADJUSTED. WON'T BALANCE ENERGY. TE IS SAVED BEFORE THIS diff --git a/src/utils/cam_thermo.F90 b/src/utils/cam_thermo.F90 index 41cd560dbe..113636e237 100644 --- a/src/utils/cam_thermo.F90 +++ b/src/utils/cam_thermo.F90 @@ -170,6 +170,38 @@ module cam_thermo ! 2-d interface is not needed (but can easily be added) end interface get_hydrostatic_energy + integer, public, parameter :: thermo_budget_num_vars = 10 + integer, public, parameter :: wvidx = 1 + integer, public, parameter :: wlidx = 2 + integer, public, parameter :: wiidx = 3 + integer, public, parameter :: seidx = 4 ! enthalpy or internal energy (J/m2) index + integer, public, parameter :: poidx = 5 ! surface potential or potential energy index + integer, public, parameter :: keidx = 6 ! kinetic energy index + integer, public, parameter :: mridx = 7 + integer, public, parameter :: moidx = 8 + integer, public, parameter :: ttidx = 9 + integer, public, parameter :: teidx = 10 + character (len = 2) ,public, dimension(thermo_budget_num_vars) :: thermo_budget_vars = & + (/"WV" ,"WL" ,"WI" ,"SE" ,"PO" ,"KE" ,"MR" ,"MO" ,"TT" ,"TE" /) + character (len = 46) ,public, dimension(thermo_budget_num_vars) :: thermo_budget_vars_descriptor = (/& + "Total column water vapor ",& + "Total column liquid water ",& + "Total column frozen water ",& + "Total column enthalpy or internal energy ",& + "Total column srf potential or potential energy",& + "Total column kinetic energy ",& + "Total column wind axial angular momentum ",& + "Total column mass axial angular momentum ",& + "Total column test_tracer ",& + "Total column energy (ke + se + po) "/) + + character (len = 14), public, dimension(thermo_budget_num_vars) :: & + thermo_budget_vars_unit = (/& + "kg/m2 ","kg/m2 ","kg/m2 ","J/m2 ",& + "J/m2 ","J/m2 ","kg*m2/s*rad2 ","kg*m2/s*rad2 ",& + "kg/m2 ","J/m2 "/) + logical ,public, dimension(thermo_budget_num_vars) :: thermo_budget_vars_massv = (/& + .true.,.true.,.true.,.false.,.false.,.false.,.false.,.false.,.true.,.false./) CONTAINS !=========================================================================== @@ -1743,6 +1775,4 @@ subroutine get_hydrostatic_energy_1hd(tracer, pdel, cp_or_cv, U, V, T, & end subroutine get_hydrostatic_energy_1hd - !=========================================================================== - end module cam_thermo From 28cee0c3dbe65299518c748e3fbbf281fae0a0ed Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Mon, 9 Jan 2023 13:37:53 -0700 Subject: [PATCH 049/140] fix for budget_write functionality when budgeting every timestep --- src/control/budgets.F90 | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index e1ed96f2f0..a23870f2e8 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -832,8 +832,11 @@ logical function budget_write (step_offset) call timemgr_time_ge(YMD_Next,Sec_Next, & YMD_Curr_woff ,Sec_Curr_woff ,update_budget) -!jt budget_write = ( nstep+(abs(offset/dtime))==1 .or. ((nstep /= 0).and.update_budget) ) - budget_write = ((nstep /= 0).and.update_budget) + if (thermo_budget_averaging_option == 'NSTEP'.and.thermo_budget_averaging_n==1) then + budget_write = ( nstep+(abs(offset/dtime))==1 .or. ((nstep /= 0).and.update_budget) ) + else + budget_write = ((nstep /= 0).and.update_budget) + end if if (masterproc) write(iulog,*)'checking for budget_write w/offset:',budget_write else @@ -879,8 +882,11 @@ logical function budget_write (step_offset) if (masterproc) write(iulog,*)'curr gt next, reset next,new values ymdn/secn',YMD_Next,Sec_Next end if end if -!jt budget_write = ( nstep+(abs(offset/dtime))==1 .or. ((nstep /= 0).and.update_budget) ) - budget_write = ((nstep /= 0).and.update_budget) + if (thermo_budget_averaging_option == 'NSTEP'.and.thermo_budget_averaging_n==1) then + budget_write = ( nstep+(abs(offset/dtime))==1 .or. ((nstep /= 0).and.update_budget) ) + else + budget_write = ((nstep /= 0).and.update_budget) + end if end if return From 6cf10ce51d50ded5da0076ba044da4c79c15a67f Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Mon, 9 Jan 2023 14:06:20 -0700 Subject: [PATCH 050/140] get rid of WX test variable --- src/dynamics/se/dyn_comp.F90 | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 69b85c07be..69e411bc8b 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -921,17 +921,6 @@ subroutine dyn_init(dyn_in, dyn_out) call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='GLL') end if end do - do ivars=1, 1 - write(str1,*) "WX","_",TRIM(ADJUSTL(stage(istage))) - write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & - TRIM(ADJUSTL(stage_txt(istage))) - write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) - if (ntrac>0.and.thermo_budget_vars_massv(ivars)) then - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='FVM') - else - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='GLL') - end if - end do ! Register stages for budgets call budget_add(TRIM(ADJUSTL(stage(istage))), pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) end do From d5539bfc216c1663c82daade7d30dcaeeb82a9a3 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Mon, 9 Jan 2023 17:41:22 -0700 Subject: [PATCH 051/140] mpas bug fixes --- src/dynamics/mpas/dp_coupling.F90 | 26 +++++----- src/dynamics/mpas/dycore_budget.F90 | 79 +++++++++++++++-------------- src/dynamics/mpas/dyn_comp.F90 | 57 ++++++++++----------- src/dynamics/se/dyn_comp.F90 | 2 +- 4 files changed, 81 insertions(+), 83 deletions(-) diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index ec2fb8f5ed..1676692d0b 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -826,6 +826,8 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t use air_composition, only: thermodynamic_active_species_ice_idx_dycore,thermodynamic_active_species_liq_idx_dycore use air_composition, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_liq_num use budgets, only: budget_array_max,budget_info_byname + use cam_thermo, only: wvidx,wlidx,wiidx,seidx,poidx,keidx,moidx,mridx,ttidx,teidx,thermo_budget_num_vars + ! Arguments integer, intent(in) :: nCells integer, intent(in) :: nVertLevels @@ -838,7 +840,7 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t real(r8), dimension(qsize,nVertLevels, nCells), intent(in) :: q ! tracer array real(r8), dimension(nVertLevels, nCells), intent(in) :: ux ! A-grid zonal velocity component real(r8), dimension(nVertLevels, nCells), intent(in) :: uy ! A-grid meridional velocity component - real(r8), dimension(budget_array_max, 9, nCells), intent(inout) :: te_budgets ! energy/mass budget arrays + real(r8), dimension(budget_array_max, thermo_budget_num_vars, nCells), intent(inout) :: te_budgets ! energy/mass budget arrays integer, dimension(budget_array_max), intent(inout) :: budgets_cnt ! budget counts for normalization integer, dimension(budget_array_max), intent(inout) :: budgets_subcycle_cnt ! budget counts for normalization character*(*), intent(in) :: outfld_name_suffix ! suffix for "outfld" names @@ -854,16 +856,17 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t real(r8), dimension(nCells) :: liq !total column integrated liquid real(r8), dimension(nCells) :: ice !total column integrated ice - character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5 + character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 name_out1 = 'SE_' //trim(outfld_name_suffix) name_out2 = 'KE_' //trim(outfld_name_suffix) name_out3 = 'WV_' //trim(outfld_name_suffix) name_out4 = 'WL_' //trim(outfld_name_suffix) name_out5 = 'WI_' //trim(outfld_name_suffix) + name_out6 = 'PO_' //trim(outfld_name_suffix) if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2).or.hist_fld_active(name_out3).or.& - hist_fld_active(name_out4).or.hist_fld_active(name_out5)) then + hist_fld_active(name_out4).or.hist_fld_active(name_out5).or.hist_fld_active(name_out6)) then kinetic_energy = 0.0_r8 potential_energy = 0.0_r8 @@ -899,11 +902,10 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t call outfld(name_out1,internal_energy,ncells,1) call outfld(name_out2,kinetic_energy ,ncells,1) call outfld(name_out3,water_vapor ,ncells,1) + call outfld(name_out6,potential_energy ,ncells,1) call budget_info_byname(trim(outfld_name_suffix),budget_ind=b_ind,state_ind=s_ind,subcycle=b_subcycle) ! reset all when cnt is 0 - write(iulog,*)'dpc calc se,ke ',s_ind,',1:3,1 is ',internal_energy(1),' ',kinetic_energy(1) - write(iulog,*)'dpc budgets initial ',s_ind,',1:3,1 is ',te_budgets(s_ind,1,1),' ',te_budgets(s_ind,2,1),' ',te_budgets(s_ind,3,1) if (budgets_cnt(b_ind) == 0) then budgets_subcycle_cnt(b_ind) = 0 te_budgets(s_ind,:,:)=0.0_r8 @@ -920,12 +922,12 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t te_budgets(s_ind,:,:)=0._r8 end if - te_budgets(s_ind,1,:)=te_budgets(s_ind,1,:)+potential_energy+internal_energy+kinetic_energy - te_budgets(s_ind,2,:)=te_budgets(s_ind,2,:)+internal_energy - te_budgets(s_ind,3,:)=te_budgets(s_ind,3,:)+kinetic_energy - write(iulog,*)'tot_e te_budget for this proc ',s_ind,',1:3,1 is ',te_budgets(s_ind,1,1),' ',te_budgets(s_ind,2,1),' ',te_budgets(s_ind,3,1) + te_budgets(s_ind,teidx,:)=te_budgets(s_ind,teidx,:)+potential_energy+internal_energy+kinetic_energy + te_budgets(s_ind,seidx,:)=te_budgets(s_ind,seidx,:)+internal_energy + te_budgets(s_ind,keidx,:)=te_budgets(s_ind,keidx,:)+kinetic_energy + te_budgets(s_ind,poidx,:)=te_budgets(s_ind,poidx,:)+potential_energy - te_budgets(s_ind,4,:)=te_budgets(s_ind,4,:)+water_vapor + te_budgets(s_ind,wvidx,:)=te_budgets(s_ind,wvidx,:)+water_vapor ! ! vertical integral of total liquid water @@ -941,7 +943,7 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t end do end do call outfld(name_out4,liq,ncells,1) - te_budgets(s_ind,5,:)=te_budgets(s_ind,5,:)+liq + te_budgets(s_ind,wlidx,:)=te_budgets(s_ind,wlidx,:)+liq end if ! ! vertical integral of total frozen (ice) water @@ -957,7 +959,7 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t end do end do call outfld(name_out5,ice,ncells,1) - te_budgets(s_ind,6,:)=te_budgets(s_ind,6,:)+ice + te_budgets(s_ind,wiidx,:)=te_budgets(s_ind,wiidx,:)+ice end if end if end subroutine tot_energy diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index b54e8274f8..ada3f2ab49 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -15,6 +15,7 @@ subroutine print_budget() use spmd_utils, only: masterproc use cam_logfile, only: iulog use cam_abortutils, only: endrun + use cam_thermo, only: teidx, thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv ! Local variables integer :: b_ind,s_ind,is1,is2 logical :: budget_outfld @@ -38,21 +39,21 @@ subroutine print_budget() !-------------------------------------------------------------------------------------- if (masterproc) then - call budget_get_global('phAP-phBP',1,ph_param) - call budget_get_global('phBP-phBF',1,ph_EFIX) - call budget_get_global('phAM-phAP',1,ph_dmea) - call budget_get_global('phAP-phBF',1,ph_param_and_efix) - call budget_get_global('phAM-phBF',1,ph_phys_total) + call budget_get_global('phAP-phBP',teidx,ph_param) + call budget_get_global('phBP-phBF',teidx,ph_EFIX) + call budget_get_global('phAM-phAP',teidx,ph_dmea) + call budget_get_global('phAP-phBF',teidx,ph_param_and_efix) + call budget_get_global('phAM-phBF',teidx,ph_phys_total) - call budget_get_global('dyAP-dyBP',1,dy_param) - call budget_get_global('dyBP-dyBF',1,dy_EFIX) - call budget_get_global('dyAM-dyAP',1,dy_dmea) - call budget_get_global('dyAP-dyBF',1,dy_param_and_efix) - call budget_get_global('dyAM-dyBF',1,dy_phys_total) + call budget_get_global('dyAP-dyBP',teidx,dy_param) + call budget_get_global('dyBP-dyBF',teidx,dy_EFIX) + call budget_get_global('dyAM-dyAP',teidx,dy_dmea) + call budget_get_global('dyAP-dyBF',teidx,dy_param_and_efix) + call budget_get_global('dyAM-dyBF',teidx,dy_phys_total) - call budget_get_global('dAP-dBF',1,mpas_param) - call budget_get_global('dAM-dAP',1,mpas_dmea) - call budget_get_global('dAM-dBF',1,mpas_phys_total) + call budget_get_global('dAP-dBF',teidx,mpas_param) + call budget_get_global('dAM-dAP',teidx,mpas_dmea) + call budget_get_global('dAM-dBF',teidx,mpas_phys_total) write(iulog,*)" " write(iulog,*)"======================================================================" @@ -169,8 +170,8 @@ subroutine print_budget() write(iulog,*) "Is globally integrated total energy of state at the end of dynamics (dBF)" write(iulog,*) "and beginning of physics (dyBF) the same?" write(iulog,*) "" - call budget_get_global('dBF',1,E_dBF) !state passed to physics - call budget_get_global('dyBF',1,E_dyBF)!state beginning physics + call budget_get_global('dBF',teidx,E_dBF) !state passed to physics + call budget_get_global('dyBF',teidx,E_dyBF)!state beginning physics if (abs(E_dyBF)>eps) then diff = abs_diff(E_dBF,E_dyBF) if (abs(diff)eps) write(iulog,*)" MASS BUDGET ERROR" + do m_cnst=1,thermo_budget_num_vars + if (thermo_budget_vars_massv(m_cnst)) then + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)thermo_budget_vars_descriptor(m_cnst)//" budget" + write(iulog,*)"------------------------------------------------------------" + call budget_get_global('phAP-phBP',m_cnst,param) + call budget_get_global('phBP-phBF',m_cnst,pEFIX) + call budget_get_global('phAM-phAP',m_cnst,pdmea) + + call budget_get_global('dAM-dBF',m_cnst,param_mpas) + call budget_get_global('phAM-phBF',m_cnst,phys_total) + + write(iulog,fmt2)"dMASS/dt energy fixer (pBP-pBF) ",pEFIX," Pa" + write(iulog,fmt2)"dMASS/dt parameterizations (pAP-pBP) ",param," Pa" + write(iulog,fmt2)"dMASS/dt dry mass adjustment (pAM-pAP) ",pdmea," Pa" + write(iulog,fmt2)"dMass/dt physics total in MPAS (dAM-dBF) ",param_mpas," Pa" + err = (param_mpas-param) + write(iulog,*)"" + write(iulog,*)"Is mass budget closed? (pAP-pBP)-(dAM-dBF) ",err + write(iulog,*)"-----------------------------------------------------------------" + write(iulog,*)" " + if (err>eps) write(iulog,*)" MASS BUDGET ERROR" + end if end do - end if + end if end subroutine print_budget !========================================================================================= function abs_diff(a,b,pf) diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index 78b936719b..b539b1361c 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -327,7 +327,8 @@ subroutine dyn_init(dyn_in, dyn_out) use air_composition, only : thermodynamic_active_species_liq_num, thermodynamic_active_species_ice_num use cam_mpas_subdriver, only : domain_ptr, cam_mpas_init_phase4 use cam_mpas_subdriver, only : cam_mpas_define_scalars - use cam_thermo, only : thermo_budget_num_vars + use cam_thermo, only: thermo_budget_vars, thermo_budget_vars_descriptor, & + thermo_budget_vars_unit, thermo_budget_vars_massv, thermo_budget_num_vars use mpas_pool_routines, only : mpas_pool_get_subpool, mpas_pool_get_array, mpas_pool_get_dimension, & mpas_pool_get_config use mpas_timekeeping, only : MPAS_set_timeInterval @@ -367,7 +368,7 @@ subroutine dyn_init(dyn_in, dyn_out) character(len=*), parameter :: subname = 'dyn_comp::dyn_init' ! variables for initializing energy and axial angular momentum diagnostics - integer, parameter :: num_stages = 6, num_vars = 5 + integer, parameter :: num_stages = 6 character (len = 8), dimension(num_stages) :: stage = (/"dBF ","dAP ","dAM ","BD_dparm","BD_DMEA ","BD_phys "/) character (len = 55),dimension(num_stages) :: stage_txt = (/& " dynamics state before physics (d_p_coupling) ",& @@ -378,21 +379,6 @@ subroutine dyn_init(dyn_in, dyn_out) "dE/dt physics total in dycore (phys) (dAM-dBF)" & /) - - - - character (len = 2) , dimension(num_vars) :: vars = (/"WV" ,"WL" ,"WI" ,"SE" ,"KE"/) - character (len = 45) , dimension(num_vars) :: vars_descriptor = (/& - "Total column water vapor ",& - "Total column cloud water ",& - "Total column cloud ice ",& - "Total column static energy ",& - "Total column kinetic energy "/) - character (len = 14), dimension(num_vars) :: & - vars_unit = (/& - "kg/m2 ","kg/m2 ","kg/m2 ","J/m2 ",& - "J/m2 "/) - integer :: istage, ivars, m character (len=108) :: str1, str2, str3 character (len=vc_str_lgth) :: vc_str @@ -587,11 +573,11 @@ subroutine dyn_init(dyn_in, dyn_out) call MPAS_set_timeInterval(integrationLength, S=nint(dtime), S_n=0, S_d=1) do istage = 1, num_stages - do ivars=1, num_vars - write(str1,*) TRIM(ADJUSTL(vars(ivars))),"_",TRIM(ADJUSTL(stage(istage))) - write(str2,*) TRIM(ADJUSTL(vars_descriptor(ivars)))," ", & + do ivars=1, thermo_budget_num_vars + write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stage(istage))) + write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & TRIM(ADJUSTL(stage_txt(istage))) - write(str3,*) TRIM(ADJUSTL(vars_unit(ivars))) + write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), gridname='mpas_cell') end do end do @@ -646,6 +632,7 @@ subroutine dyn_run(dyn_in, dyn_out) use cam_mpas_subdriver, only : domain_ptr use mpas_pool_routines, only : mpas_pool_get_subpool, mpas_pool_get_array use mpas_derived_types, only : mpas_pool_type + use budgets, only : budget_write ! Advances the dynamics state provided in dyn_in by one physics ! timestep to produce dynamics state held in dyn_out. @@ -656,6 +643,7 @@ subroutine dyn_run(dyn_in, dyn_out) ! Local variables type(mpas_pool_type), pointer :: state_pool character(len=*), parameter :: subname = 'dyn_comp:dyn_run' + real(r8) :: dtime !---------------------------------------------------------------------------- @@ -677,6 +665,7 @@ subroutine dyn_run(dyn_in, dyn_out) ! update energy budgets calculated from snapshots (stages) + dtime = get_step_size() if(budget_write(step_offset=nint(dtime))) then call budget_update(dyn_in%nCellsSolve,dyn_out) else @@ -686,7 +675,7 @@ end subroutine dyn_run subroutine budget_update(nCells,dyn_out) - use cam_thermo, only : thermo_budget_num_vars,thermo_budget_vars_massv,wvidx,wlidx,wiidx,seidx,keidx,moidx,mridx,ttidx,teidx + use cam_thermo, only : thermo_budget_num_vars,thermo_budget_vars_massv,wvidx,wlidx,wiidx,seidx,keidx,poidx,moidx,mridx,ttidx,teidx use budgets, only : budget_num, budget_info, budget_put_global use air_composition, only : thermodynamic_active_species_liq_num, thermodynamic_active_species_ice_num @@ -697,9 +686,10 @@ subroutine budget_update(nCells,dyn_out) ! Local variables real(r8), pointer :: te_budgets(:,:,:) ! energy/mass budgets se,ke,wv,liq,ice integer, pointer :: budgets_cnt(:) ! budget counts for normalizating sum + integer, pointer :: budgets_subcycle_cnt(:) ! budget counts for normalizating sum integer :: b_ind,s_ind,is1,is2,i logical :: budget_outfld - character(len=64) :: name_out1,name_out2,name_out3,name_out4,name_out5,budget_name + character(len=64) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6,budget_name character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn real(r8) :: tmp(thermo_budget_num_vars,nCells) real(r8), pointer :: areaCell(:) ! cell area (m^2) @@ -710,14 +700,14 @@ subroutine budget_update(nCells,dyn_out) !-------------------------------------------------------------------------------------- - te_budgets => dyn_out % te_budgets - budgets_cnt => dyn_out % budgets_cnt - + te_budgets => dyn_out % te_budgets + budgets_cnt => dyn_out % budgets_cnt + budgets_subcycle_cnt => dyn_out % budgets_subcycle_cnt do b_ind=1,budget_num call budget_info(b_ind,optype=budget_optype, pkgtype=budget_pkgtype,state_ind=s_ind,outfld=budget_outfld,name=budget_name) if (budget_pkgtype=='dyn') then - if (budget_optype!='stg') then + if (budget_optype /= 'stg') then call budget_info(b_ind,stg1stateidx=is1, stg2stateidx=is2) if (budget_optype=='dif') then te_budgets(s_ind,:,:)=(te_budgets(is1,:,:)-te_budgets(is2,:,:)) @@ -733,8 +723,10 @@ subroutine budget_update(nCells,dyn_out) name_out3 = 'WV_' //trim(budget_name) name_out4 = 'WL_' //trim(budget_name) name_out5 = 'WI_' //trim(budget_name) + name_out6 = 'PO_' //trim(budget_name) call outfld(name_out1, te_budgets(s_ind,seidx,:), nCells, 1) call outfld(name_out2, te_budgets(s_ind,keidx,:), nCells, 1) + call outfld(name_out6, te_budgets(s_ind,poidx,:), nCells, 1) ! ! sum over vapor call outfld(name_out3, te_budgets(s_ind,wvidx,:), nCells, 1) @@ -771,7 +763,7 @@ subroutine budget_update(nCells,dyn_out) if (.not.thermo_budget_vars_massv(i)) & budgets_global(b_ind,i)=budgets_global(b_ind,i)/dtime if (masterproc) & - write(iulog,*)"putting global ",trim(budget_name)," m_cnst=",n," ",budgets_global(b_ind,i)," cnt=",budgets_cnt(b_ind),budgets_subcycle_cnt(b_ind) + write(iulog,*)"putting global ",trim(budget_name)," m_cnst=",i," ",budgets_global(b_ind,i)," cnt=",budgets_cnt(b_ind),budgets_subcycle_cnt(b_ind) call budget_put_global(trim(budget_name),i,budgets_global(b_ind,i)) end do ! reset dyn budget states and counts @@ -793,14 +785,17 @@ subroutine budget_update_dyn_cnts(nCells,dyn_out) ! Local variables integer, pointer :: budgets_cnt(:) ! budget counts for normalizating sum + integer, pointer :: budgets_subcycle_cnt(:) ! budget subcycle counts integer :: b_ind,s_ind + logical :: budget_outfld character(len=64) :: budget_name character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn !-------------------------------------------------------------------------------------- - if (thermo_budget_history) then - budgets_cnt => dyn_out % budgets_cnt +!jt if (thermo_budget_history) then + budgets_cnt => dyn_out % budgets_cnt + budgets_subcycle_cnt => dyn_out % budgets_subcycle_cnt do b_ind=1,budget_num @@ -813,7 +808,7 @@ subroutine budget_update_dyn_cnts(nCells,dyn_out) budgets_cnt(b_ind)=budgets_cnt(b_ind)+1 end if end do - end if +!jt end if end subroutine budget_update_dyn_cnts !========================================================================================= diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 69e411bc8b..897242272d 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -1192,7 +1192,7 @@ subroutine dyn_run(dyn_state) call write_dyn_vars(dyn_state) if(budget_write(step_offset=nint(dtime))) then - call budget_update(dyn_state%elem,dyn_state%fvm, nets, nete, TimeLevel%n0, n0_qdp, hybrid) + call budget_update(dyn_state%elem,dyn_state%fvm, nets, nete, TimeLevel%n0, n0_qdp, hybrid) else call budget_update_dyn_cnts(dyn_state%elem,dyn_state%fvm, nets, nete, TimeLevel%n0, n0_qdp, hybrid) end if From a380cb4de78e065789aff8c3ce42c33a809b8044 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Mon, 9 Jan 2023 18:32:06 -0700 Subject: [PATCH 052/140] addfld calls for stages and differences for all thermodynamic categories --- src/dynamics/mpas/dyn_comp.F90 | 48 ++++++++++++++++++++++------------ 1 file changed, 31 insertions(+), 17 deletions(-) diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index b539b1361c..57fbf4fc72 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -336,7 +336,7 @@ subroutine dyn_init(dyn_in, dyn_out) use mpas_constants, only : mpas_constants_compute_derived use dyn_tests_utils, only : vc_dycore, vc_height, string_vc, vc_str_lgth use constituents, only : cnst_get_ind - use budgets, only : budget_array_max, budget_info, budget_add, budget_num + use budgets, only : budget_array_max, budget_info, budget_add, budget_num, thermo_budget_history ! arguments: type(dyn_import_t), intent(inout) :: dyn_in type(dyn_export_t), intent(inout) :: dyn_out @@ -572,6 +572,10 @@ subroutine dyn_init(dyn_in, dyn_out) ! Set the interval over which the dycore should integrate during each call to dyn_run. call MPAS_set_timeInterval(integrationLength, S=nint(dtime), S_n=0, S_d=1) + ! + ! initialize history for MPAS energy budgets + ! call addfld for every thermo_budget_category and stage as well as calling add_budget for each stage + ! do istage = 1, num_stages do ivars=1, thermo_budget_num_vars write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stage(istage))) @@ -580,6 +584,8 @@ subroutine dyn_init(dyn_in, dyn_out) write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), gridname='mpas_cell') end do + ! Register stages for budgets + call budget_add(TRIM(ADJUSTL(stage(istage))), pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) end do ! @@ -606,22 +612,28 @@ subroutine dyn_init(dyn_in, dyn_out) ! ! initialize MPAS energy budgets - ! - ! add budget snapshots (stages) - istage=1 - call budget_add('dBF', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.false., subcycle=.false.) - istage=istage+1 - call budget_add('dAP', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.false., subcycle=.false.) - istage=istage+1 - call budget_add('dAM', pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.false., subcycle=.false.) - ! ! add budgets that are derived from stages ! - call budget_add('mpas_param','dAP','dBF',pkgtype='dyn',optype='dif',longname="dE/dt parameterizations+efix in dycore (dparam)(dAP-dBF)",outfld=.false.) - call budget_add('mpas_dmea' ,'dAM','dAP',pkgtype='dyn',optype='dif',longname="dE/dt dry mass adjustment in dycore (dAM-dAP)",outfld=.false.) - call budget_add('mpas_phys_total' ,'dAM','dBF',pkgtype='dyn',optype='dif',longname="dE/dt physics total in dycore (phys) (dAM-dBF)",outfld=.false.) - + call budget_add('mpas_param','dAP','dBF',pkgtype='dyn',optype='dif',longname="dE/dt parameterizations+efix in dycore (dparam)(dAP-dBF)",outfld=.false.) + call budget_add('mpas_dmea' ,'dAM','dAP',pkgtype='dyn',optype='dif',longname="dE/dt dry mass adjustment in dycore (dAM-dAP)",outfld=.false.) + call budget_add('mpas_phys_total' ,'dAM','dBF',pkgtype='dyn',optype='dif',longname="dE/dt physics total in dycore (phys) (dAM-dBF)",outfld=.false.) + + ! call addfield for budget diff/sum that we just added above + if (thermo_budget_history) then + do m=1,budget_num + call budget_info(m,name=budget_name,longname=budget_longname,pkgtype=budget_pkgtype,optype=budget_optype) + if (trim(budget_pkgtype)=='dyn'.and.(trim(budget_optype)=='dif'.or.trim(budget_optype)=='sum')) then + do ivars=1, thermo_budget_num_vars + write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(budget_name)) + write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & + TRIM(ADJUSTL(budget_longname)) + write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='mpas_cell') + end do + end if + end do + end if end subroutine dyn_init !========================================================================================= @@ -689,7 +701,7 @@ subroutine budget_update(nCells,dyn_out) integer, pointer :: budgets_subcycle_cnt(:) ! budget counts for normalizating sum integer :: b_ind,s_ind,is1,is2,i logical :: budget_outfld - character(len=64) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6,budget_name + character(len=64) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6,name_out7,budget_name character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn real(r8) :: tmp(thermo_budget_num_vars,nCells) real(r8), pointer :: areaCell(:) ! cell area (m^2) @@ -717,16 +729,18 @@ subroutine budget_update(nCells,dyn_out) ! ! Output energy diagnostics ! - if (budget_outfld) then +!jt if (budget_outfld) then name_out1 = 'SE_' //trim(budget_name) name_out2 = 'KE_' //trim(budget_name) name_out3 = 'WV_' //trim(budget_name) name_out4 = 'WL_' //trim(budget_name) name_out5 = 'WI_' //trim(budget_name) name_out6 = 'PO_' //trim(budget_name) + name_out7 = 'TE_' //trim(budget_name) call outfld(name_out1, te_budgets(s_ind,seidx,:), nCells, 1) call outfld(name_out2, te_budgets(s_ind,keidx,:), nCells, 1) call outfld(name_out6, te_budgets(s_ind,poidx,:), nCells, 1) + call outfld(name_out7, te_budgets(s_ind,teidx,:), nCells, 1) ! ! sum over vapor call outfld(name_out3, te_budgets(s_ind,wvidx,:), nCells, 1) @@ -738,7 +752,7 @@ subroutine budget_update(nCells,dyn_out) ! sum over ice water if (thermodynamic_active_species_ice_num>0) & call outfld(name_out5, te_budgets(s_ind,wiidx,:), nCells, 1) - end if +!jt end if budgets_cnt(b_ind)=budgets_cnt(b_ind)+1 end if end if From 795015070a1d78240d761203747a79f06ff918a5 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Tue, 10 Jan 2023 16:08:46 -0700 Subject: [PATCH 053/140] bug fixes for CSLAM --- .../se/dycore/fvm_control_volume_mod.F90 | 2 - src/dynamics/se/dycore/global_norms_mod.F90 | 60 +++++- src/dynamics/se/dycore/prim_advance_mod.F90 | 187 +++++------------- src/dynamics/se/dyn_comp.F90 | 51 +++-- 4 files changed, 142 insertions(+), 158 deletions(-) diff --git a/src/dynamics/se/dycore/fvm_control_volume_mod.F90 b/src/dynamics/se/dycore/fvm_control_volume_mod.F90 index ea4f536ace..91e25975a0 100644 --- a/src/dynamics/se/dycore/fvm_control_volume_mod.F90 +++ b/src/dynamics/se/dycore/fvm_control_volume_mod.F90 @@ -157,8 +157,6 @@ module fvm_control_volume_mod real (kind=r8) , allocatable :: fm(:,:,:,:) real (kind=r8) , allocatable :: dp_phys(:,:,:) real (kind=r8) , allocatable :: budget(:,:,:,:) ! budgets - integer :: budget_cnt(budget_array_max) ! budget count for averaging - integer :: budget_subcycle(budget_array_max) ! budget subcycle count end type fvm_struct public :: fvm_mesh, fvm_set_cubeboundary, allocate_physgrid_vars diff --git a/src/dynamics/se/dycore/global_norms_mod.F90 b/src/dynamics/se/dycore/global_norms_mod.F90 index 28810fbe47..4ec5143e34 100644 --- a/src/dynamics/se/dycore/global_norms_mod.F90 +++ b/src/dynamics/se/dycore/global_norms_mod.F90 @@ -24,6 +24,11 @@ module global_norms_mod private :: global_maximum type (EdgeBuffer_t), private :: edgebuf + interface global_integral + module procedure global_integral_elem + module procedure global_integral_fvm + end interface global_integral + contains @@ -133,7 +138,7 @@ end subroutine global_integrals_general ! ! ================================ ! -------------------------- - function global_integral(elem, h,hybrid,npts,nets,nete) result(I_sphere) + function global_integral_elem(elem, h,hybrid,npts,nets,nete) result(I_sphere) use hybrid_mod, only: hybrid_t use element_mod, only: element_t use dimensions_mod, only: np, nelemd @@ -183,7 +188,58 @@ function global_integral(elem, h,hybrid,npts,nets,nete) result(I_sphere) !JMD print *,'global_integral: after global_shared_sum' I_sphere = I_tmp(1)/(4.0_r8*PI) - end function global_integral + end function global_integral_elem + + function global_integral_fvm(fvm, h,hybrid,npts,nets,nete) result(I_sphere) + use hybrid_mod, only: hybrid_t + use fvm_control_volume_mod, only: fvm_struct + use physconst, only: pi + use parallel_mod, only: global_shared_buf, global_shared_sum + + type (fvm_struct) , intent(in) :: fvm(:) + integer , intent(in) :: npts,nets,nete + real (kind=r8), intent(in) :: h(npts,npts,nets:nete) + type (hybrid_t) , intent(in) :: hybrid + + real (kind=r8) :: I_sphere + + real (kind=r8) :: I_priv + real (kind=r8) :: I_shared + common /gblintcom/I_shared + + ! Local variables + + integer :: ie,j,i + real(kind=r8) :: I_tmp(1) + + real (kind=r8) :: da + real (kind=r8) :: J_tmp(nets:nete) +! +! This algorythm is independent of thread count and task count. +! This is a requirement of consistancy checking in cam. +! + J_tmp = 0.0_r8 + +!JMD print *,'global_integral: before loop' + do ie=nets,nete + do j=1,npts + do i=1,npts + da = fvm(ie)%area_sphere(i,j) + J_tmp(ie) = J_tmp(ie) + da*h(i,j,ie) + end do + end do + end do + do ie=nets,nete + global_shared_buf(ie,1) = J_tmp(ie) + enddo +!JMD print *,'global_integral: before wrap_repro_sum' + call wrap_repro_sum(nvars=1, comm=hybrid%par%comm) +!JMD print *,'global_integral: after wrap_repro_sum' + I_tmp = global_shared_sum(1) +!JMD print *,'global_integral: after global_shared_sum' + I_sphere = I_tmp(1)/(4.0_r8*PI) + + end function global_integral_fvm !------------------------------------------------------------------------------------ diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index 6186ab9530..6696ffd532 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -1565,7 +1565,7 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf end do end do -! could store pointer to dyn/phys state index inside of budget and call budget_state_update pass in se,ke etc. + ! could store pointer to dyn/phys state index inside of budget and call budget_state_update pass in se,ke etc. call budget_info_byname(trim(outfld_name_suffix),budget_ind=budget_ind,state_ind=state_ind) ! reset all when cnt is 0 @@ -1573,6 +1573,7 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf if (ie.eq.nets) write(iulog,*)'cnt = 0;resetting :',trim(outfld_name_suffix) elem(ie)%derived%budget_subcycle(budget_ind) = 0 elem(ie)%derived%budget(:,:,:,state_ind)=0.0_r8 + if (ntrac>0) fvm(ie)%budget(:,:,:,state_ind)=0.0_r8 end if if (present(subcycle)) then if (subcycle) then @@ -1588,12 +1589,13 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf elem(ie)%derived%budget_cnt(budget_ind) = elem(ie)%derived%budget_cnt(budget_ind) + 1 elem(ie)%derived%budget_subcycle(budget_ind) = 1 end if + do j=1,np - do i = 1, np - elem(ie)%derived%budget(i,j,teidx,state_ind) = elem(ie)%derived%budget(i,j,teidx,state_ind) + (se(i+(j-1)*np) + ke(i+(j-1)*np)) - elem(ie)%derived%budget(i,j,seidx,state_ind) = elem(ie)%derived%budget(i,j,seidx,state_ind) + se(i+(j-1)*np) - elem(ie)%derived%budget(i,j,keidx,state_ind) = elem(ie)%derived%budget(i,j,keidx,state_ind) + ke(i+(j-1)*np) - end do + do i = 1, np + elem(ie)%derived%budget(i,j,teidx,state_ind) = elem(ie)%derived%budget(i,j,teidx,state_ind) + (se(i+(j-1)*np) + ke(i+(j-1)*np)) + elem(ie)%derived%budget(i,j,seidx,state_ind) = elem(ie)%derived%budget(i,j,seidx,state_ind) + se(i+(j-1)*np) + elem(ie)%derived%budget(i,j,keidx,state_ind) = elem(ie)%derived%budget(i,j,keidx,state_ind) + ke(i+(j-1)*np) + end do end do ! ! Output energy diagnostics on GLL grid @@ -1639,7 +1641,7 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf *fvm(ie)%dp_fvm(1:nc,1:nc,:) end do call util_function(cdp_fvm,nc,nlev,name_out5,ie) - + do j = 1, nc do i = 1, nc fvm(ie)%budget(i,j,wiidx,state_ind) = fvm(ie)%budget(i,j,wiidx,state_ind) + sum(cdp_fvm(i,j,:)*inv_g) @@ -1758,162 +1760,77 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf end subroutine calc_tot_energy_dynamics - subroutine calc_tot_energy_dynamics_diff(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suffix, subcycle) - use dimensions_mod, only: np,nc,ntrac,npsq + subroutine calc_tot_energy_dynamics_diff(elem,fvm,nets,nete,tl,tl_qdp,budget_name, subcycle) + use dimensions_mod, only: ntrac use element_mod, only: element_t - use cam_history, only: hist_fld_active,outfld use constituents, only: cnst_get_ind use fvm_control_volume_mod, only: fvm_struct - use air_composition, only: thermodynamic_active_species_idx_dycore - use air_composition, only: thermodynamic_active_species_ice_num - use air_composition, only: thermodynamic_active_species_liq_num - use air_composition, only: thermodynamic_active_species_liq_idx - use air_composition, only: thermodynamic_active_species_ice_idx - use budgets, only: budget_info,budget_ind_byname use cam_thermo, only: thermo_budget_num_vars, & thermo_budget_vars_massv,wvidx,wlidx,wiidx,seidx,keidx,moidx,mridx,ttidx,teidx !------------------------------Arguments-------------------------------- type (element_t) , intent(inout) :: elem(:) - type(fvm_struct) , intent(in) :: fvm(:) + type(fvm_struct) , intent(inout) :: fvm(:) integer , intent(in) :: tl, tl_qdp,nets,nete - character*(*) , intent(in) :: outfld_name_suffix ! suffix for "outfld" names + character*(*) , intent(in) :: budget_name ! suffix for "outfld" names logical, optional, intent(in) :: subcycle ! true if called inside subcycle loop !---------------------------Local storage------------------------------- - integer :: ie,ixtt,b_ind,s_ind,is1,is2,isb1,isb2 - character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 - real(r8), allocatable, dimension(:,:,:,:) :: tmp,tmp1,tmp2 - character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn + integer :: ie,ixtt,b_ind,s_ind,is1,is2,isb1,isb2,n + character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn !----------------------------------------------------------------------- - name_out1 = 'SE_' //trim(outfld_name_suffix) - name_out2 = 'KE_' //trim(outfld_name_suffix) - name_out3 = 'WV_' //trim(outfld_name_suffix) - name_out4 = 'WL_' //trim(outfld_name_suffix) - name_out5 = 'WI_' //trim(outfld_name_suffix) - name_out6 = 'TT_' //trim(outfld_name_suffix) + b_ind=budget_ind_byname(trim(budget_name)) + call budget_info(b_ind,stg1stateidx=is1, stg2stateidx=is2,stg1index=isb1, stg2index=isb2, optype=budget_optype, pkgtype=budget_pkgtype,state_ind=s_ind) -!jt if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2).or.hist_fld_active(name_out3).or.& -!jt hist_fld_active(name_out4).or.hist_fld_active(name_out5).or.hist_fld_active(name_out6)) then -!jt call cnst_get_ind('TT_UN' , ixtt , abort=.false.) - ! - ! Compute frozen static energy in 3 parts: KE, SE, and energy associated with vapor and liquid - ! - allocate(tmp(np,np,thermo_budget_num_vars,nets:nete)) - allocate(tmp1(np,np,thermo_budget_num_vars,nets:nete)) - allocate(tmp2(np,np,thermo_budget_num_vars,nets:nete)) - b_ind=budget_ind_byname(trim(outfld_name_suffix)) - call budget_info(b_ind,stg1stateidx=is1, stg2stateidx=is2,stg1index=isb1, stg2index=isb2, optype=budget_optype, pkgtype=budget_pkgtype,state_ind=s_ind) - do ie=nets,nete - ! advance budget_cnt - if (present(subcycle)) then - if (subcycle) then - ! reset subcycle when cnt is 0 - if (elem(ie)%derived%budget_cnt(b_ind) == 0) then - elem(ie)%derived%budget_subcycle(b_ind) = 0 - elem(ie)%derived%budget(:,:,:,s_ind)=0.0_r8 - end if - elem(ie)%derived%budget_subcycle(b_ind) = elem(ie)%derived%budget_subcycle(b_ind) + 1 - if (elem(ie)%derived%budget_subcycle(b_ind) == 1) then - elem(ie)%derived%budget_cnt(b_ind) = elem(ie)%derived%budget_cnt(b_ind) + 1 - end if - else + do ie=nets,nete + ! advance budget_cnt + if (present(subcycle)) then + if (subcycle) then + ! reset subcycle when cnt is 0 + if (elem(ie)%derived%budget_cnt(b_ind) == 0) then + elem(ie)%derived%budget_subcycle(b_ind) = 0 + elem(ie)%derived%budget(:,:,:,s_ind)=0._r8 + if (ntrac>0) fvm(ie)%budget(:,:,:,s_ind)=0._r8 + end if + elem(ie)%derived%budget_subcycle(b_ind) = elem(ie)%derived%budget_subcycle(b_ind) + 1 + if (elem(ie)%derived%budget_subcycle(b_ind) == 1) then elem(ie)%derived%budget_cnt(b_ind) = elem(ie)%derived%budget_cnt(b_ind) + 1 - elem(ie)%derived%budget_subcycle(b_ind) = 1 end if else elem(ie)%derived%budget_cnt(b_ind) = elem(ie)%derived%budget_cnt(b_ind) + 1 elem(ie)%derived%budget_subcycle(b_ind) = 1 end if - if (elem(ie)%derived%budget_cnt(isb1)==0.or.elem(ie)%derived%budget_cnt(isb2)==0) then - tmp(:,:,:,ie)=0._r8 - else - tmp1(:,:,:,ie)=elem(ie)%derived%budget(:,:,:,is1) - tmp2(:,:,:,ie)=elem(ie)%derived%budget(:,:,:,is2) + else + elem(ie)%derived%budget_cnt(b_ind) = elem(ie)%derived%budget_cnt(b_ind) + 1 + elem(ie)%derived%budget_subcycle(b_ind) = 1 + end if + + if (elem(ie)%derived%budget_cnt(isb1)==0.or.elem(ie)%derived%budget_cnt(isb2)==0) then + elem(ie)%derived%budget(:,:,:,s_ind)=0._r8 + else + do n=1,thermo_budget_num_vars if (budget_optype=='dif') then - tmp(:,:,:,ie)=(tmp1(:,:,:,ie)-tmp2(:,:,:,ie)) + if (ntrac>0.and.thermo_budget_vars_massv(n)) then + fvm(ie)%budget(:,:,n,s_ind)=(fvm(ie)%budget(:,:,n,is1)-fvm(ie)%budget(:,:,n,is2)) + else + elem(ie)%derived%budget(:,:,n,s_ind)=(elem(ie)%derived%budget(:,:,n,is1)-elem(ie)%derived%budget(:,:,n,is2)) + end if else if (budget_optype=='sum') then - tmp(:,:,:,ie)=(tmp1(:,:,:,ie)+tmp2(:,:,:,ie)) + if (ntrac>0.and.thermo_budget_vars_massv(n)) then + fvm(ie)%budget(:,:,n,s_ind)=(fvm(ie)%budget(:,:,n,is1)+fvm(ie)%budget(:,:,n,is2)) + else + elem(ie)%derived%budget(:,:,n,s_ind)=(elem(ie)%derived%budget(:,:,n,is1)+elem(ie)%derived%budget(:,:,n,is2)) + end if else call endrun('dyn_readnl: ERROR: budget_optype unknown:'//budget_optype) end if - end if - elem(ie)%derived%budget(:,:,:,s_ind)=tmp(:,:,:,ie) - ! - ! Output energy diagnostics on GLL grid - ! -! call outfld(name_out1,elem(ie)%derived%budget(:,:,seidx,s_ind),npsq,ie) -! call outfld(name_out2,elem(ie)%derived%budget(:,:,keidx,s_ind),npsq,ie) - ! - ! mass variables are output on CSLAM grid if using CSLAM else GLL grid - ! -! if (ntrac>0) then -! call outfld(name_out3,elem(ie)%derived%budget(:,:,wvidx,s_ind),nc*nc,ie) - ! - ! sum over liquid water - ! -! if (thermodynamic_active_species_liq_num>0) & -! call outfld(name_out4,elem(ie)%derived%budget(:,:,wlidx,s_ind),nc*nc,ie) - ! - ! sum over ice water - ! -! if (thermodynamic_active_species_ice_num>0) & -! call outfld(name_out5,elem(ie)%derived%budget(:,:,wiidx,s_ind),nc*nc,ie) - ! - ! dry test tracer - ! -! if (ixtt>0) & -! call outfld(name_out6,elem(ie)%derived%budget(:,:,ttidx,s_ind),nc*nc,ie) -! else -! call outfld(name_out3,elem(ie)%derived%budget(:,:,wvidx,s_ind),npsq,ie) - ! - ! sum over liquid water - ! -! if (thermodynamic_active_species_liq_num>0) & -! call outfld(name_out4,elem(ie)%derived%budget(:,:,wlidx,s_ind),npsq,ie) - ! - ! sum over ice water - ! -! if (thermodynamic_active_species_ice_num>0) & -! call outfld(name_out5,elem(ie)%derived%budget(:,:,6,s_ind),npsq,ie) - ! - ! dry test tracer - ! -! if (ixtt>0) & -! call outfld(name_out6,elem(ie)%derived%budget(:,:,ttidx,s_ind),npsq,ie) -! end if - end do -!jt end if - deallocate(tmp) - deallocate(tmp1) - deallocate(tmp2) - ! - ! Axial angular momentum diagnostics - ! - ! Code follows - ! - ! Lauritzen et al., (2014): Held-Suarez simulations with the Community Atmosphere Model - ! Spectral Element (CAM-SE) dynamical core: A global axial angularmomentum analysis using Eulerian - ! and floating Lagrangian vertical coordinates. J. Adv. Model. Earth Syst. 6,129-140, - ! doi:10.1002/2013MS000268 - ! - ! MR is equation (6) without \Delta A and sum over areas (areas are in units of radians**2) - ! MO is equation (7) without \Delta A and sum over areas (areas are in units of radians**2) - ! - name_out1 = 'MR_' //trim(outfld_name_suffix) - name_out2 = 'MO_' //trim(outfld_name_suffix) - -!!$ if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2)) then -!!$ do ie=nets,nete -!!$ call outfld(name_out1 ,elem(ie)%derived%budget(:,:,mridx,s_ind) ,npsq,ie) -!!$ call outfld(name_out2 ,elem(ie)%derived%budget(:,:,moidx,s_ind) ,npsq,ie) -!!$ end do -!!$ end if - + end do + end if + end do end subroutine calc_tot_energy_dynamics_diff - + subroutine output_qdp_var_dynamics(qdp,nx,num_trac,nets,nete,outfld_name) use dimensions_mod, only: nlev,ntrac use cam_history , only: outfld, hist_fld_active diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 897242272d..8c9183c1cd 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -1031,11 +1031,9 @@ subroutine dyn_run(dyn_state) logical :: ldiag real(r8) :: ftmp(npsq,nlev,3) - real(r8) :: global_ave real(r8) :: rec2dt, pdel real(r8) :: dtime - real(r8), allocatable, dimension(:,:,:) :: tmp,tmptot,tmpse,tmpke,tmp1,tmp2 real(r8), allocatable, dimension(:,:,:) :: ps_before real(r8), allocatable, dimension(:,:,:) :: abs_ps_tend @@ -2394,7 +2392,7 @@ subroutine budget_update(elem,fvm,nets,nete,n0,n0_qdp,hybrid) thermo_budget_vars_massv,wvidx,wlidx,wiidx,seidx,keidx,moidx,mridx,ttidx,teidx ! arguments type (element_t) , intent(inout) :: elem(:) - type(fvm_struct) , intent(in) :: fvm(:) + type(fvm_struct) , intent(inout) :: fvm(:) type(hybrid_t) , intent(in) :: hybrid integer , intent(in) :: n0, n0_qdp,nets,nete @@ -2405,7 +2403,7 @@ subroutine budget_update(elem,fvm,nets,nete,n0,n0_qdp,hybrid) logical :: budget_outfld real(r8) :: budgets_global(budget_num,thermo_budget_num_vars) - real(r8), allocatable, dimension(:,:,:) :: tmp + real(r8), allocatable, dimension(:,:,:) :: tmpgll,tmpfvm real(r8) :: dtime !-------------------------------------------------------------------------------------- @@ -2449,43 +2447,61 @@ subroutine budget_update(elem,fvm,nets,nete,n0,n0_qdp,hybrid) ! update energy budget globals - allocate(tmp(np,np,nets:nete)) - tmp=0._r8 + allocate(tmpgll(np,np,nets:nete)) + if (ntrac>0) allocate(tmpfvm(nc,nc,nets:nete)) do b_ind=1,budget_num call budget_info(b_ind,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=s_ind) if (budget_pkgtype=='dyn') then do n=1,thermo_budget_num_vars ! Normalize energy sums and convert to W/s - tmp=0._r8 - if (elem(nets)%derived%budget_cnt(b_ind).gt.0.) then - do ie=nets,nete - tmp(:,:,ie)=elem(ie)%derived%budget(:,:,n,s_ind)/elem(ie)%derived%budget_cnt(b_ind) - enddo + if (ntrac>0.and.thermo_budget_vars_massv(n)) then + tmpfvm=0._r8 + if (elem(nets)%derived%budget_cnt(b_ind).gt.0.) then + do ie=nets,nete + tmpfvm(:,:,ie)=fvm(ie)%budget(:,:,n,s_ind)/elem(ie)%derived%budget_cnt(b_ind) + enddo + end if + else + tmpgll=0._r8 + if (elem(nets)%derived%budget_cnt(b_ind).gt.0.) then + do ie=nets,nete + tmpgll(:,:,ie)=elem(ie)%derived%budget(:,:,n,s_ind)/elem(ie)%derived%budget_cnt(b_ind) + end do + end if + end if + if (ntrac>0.and.thermo_budget_vars_massv(n)) then + budgets_global(b_ind,n) = global_integral(fvm, tmpfvm(:,:,nets:nete),hybrid,nc,nets,nete) + else + budgets_global(b_ind,n) = global_integral(elem, tmpgll(:,:,nets:nete),hybrid,np,nets,nete) end if - budgets_global(b_ind,n) = global_integral(elem, tmp(:,:,nets:nete),hybrid,np,nets,nete) ! divide by time for proper units if not a mass budget. if (.not.thermo_budget_vars_massv(n)) & budgets_global(b_ind,n)=budgets_global(b_ind,n)/dtime if (masterproc) then - write(iulog,*)"putting global ",trim(budget_name)," m_cnst=",n," ",budgets_global(b_ind,n)," cnt/subcyc/sum_tmp=",elem(nets)%derived%budget_cnt(b_ind),elem(nets)%derived%budget_subcycle(b_ind),sum(tmp(:,:,nets)) + if (ntrac>0.and.thermo_budget_vars_massv(n)) then + write(iulog,*)"putting global from fvm ",trim(budget_name)," m_cnst=",n," ",budgets_global(b_ind,n)," cnt/subcyc/sum_tmp=",elem(nets)%derived%budget_cnt(b_ind),elem(nets)%derived%budget_subcycle(b_ind),sum(tmpfvm(:,:,nets)) + else + write(iulog,*)"putting global from elem ",trim(budget_name)," m_cnst=",n," ",budgets_global(b_ind,n)," cnt/subcyc/sum_tmp=",elem(nets)%derived%budget_cnt(b_ind),elem(nets)%derived%budget_subcycle(b_ind),sum(tmpgll(:,:,nets)) + end if call budget_put_global(trim(budget_name),n,budgets_global(b_ind,n)) end if end do end if end do - deallocate(tmp) + deallocate(tmpgll) + if (ntrac > 0) deallocate(tmpfvm) ! reset dyn budget states and counts do b_ind=1,budget_num call budget_info(b_ind,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=s_ind) if (budget_pkgtype=='dyn') then - if (masterproc) & - write(iulog,*)"resetting %budget for ",trim(budget_name) + if (masterproc) write(iulog,*)"resetting %budget for ",trim(budget_name) do ie=nets,nete elem(ie)%derived%budget(:,:,:,s_ind)=0._r8 elem(ie)%derived%budget_cnt(b_ind)=0 elem(ie)%derived%budget_subcycle(b_ind)=0 + if (ntrac>0) fvm(ie)%budget(:,:,:,s_ind)=0._r8 end do end if end do @@ -2516,11 +2532,8 @@ subroutine budget_update_dyn_cnts(elem,fvm,nets,nete,n0,n0_qdp,hybrid) logical :: budget_outfld real(r8) :: budgets_global(budget_num,thermo_budget_num_vars) - real(r8), allocatable, dimension(:,:,:) :: tmp !-------------------------------------------------------------------------------------- - - ! update energy budget differences and outfld if (thermo_budget_history) then From a9eb66000174c656ac3bcb0ae596d20f92040549 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Tue, 10 Jan 2023 16:35:25 -0700 Subject: [PATCH 054/140] fix bug in call to get_hydrostatic_energy in energy diagnostics --- src/physics/cam/check_energy.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 14b21755f6..86434cbb93 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -1137,8 +1137,8 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) ! scale accumulated temperature increment for constant volume (otherwise effectively do nothing) temp(1:ncol,:) = state%temp_ini(1:ncol,:)+scaling(1:ncol,:)*(state%T(1:ncol,:)- state%temp_ini(1:ncol,:)) - call get_hydrostatic_energy(state%q(1:ncol,1:pver,1:pcnst),& - state%pdel(1:ncol,1:pver), cp_or_cv, & + call get_hydrostatic_energy(state%q(1:ncol,1:pver,1:pcnst), & + state%pdel(1:ncol,1:pver), cp_or_cv(1:ncol,1:pver), & state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), temp(1:ncol,1:pver), & vc_loc, ps = state%ps(1:ncol), phis = state%phis(1:ncol), & z_mid = state%z_ini(1:ncol,:), se = se, po = po, ke = ke, wv = wv, liq = liq, ice = ice) From 43828170ac3efa314dc5d4636b894ec45d68172b Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Wed, 11 Jan 2023 12:55:34 -0700 Subject: [PATCH 055/140] fix bug in dimension size --- src/physics/cam/check_energy.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 86434cbb93..06e86035fd 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -1141,7 +1141,9 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) state%pdel(1:ncol,1:pver), cp_or_cv(1:ncol,1:pver), & state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), temp(1:ncol,1:pver), & vc_loc, ps = state%ps(1:ncol), phis = state%phis(1:ncol), & - z_mid = state%z_ini(1:ncol,:), se = se, po = po, ke = ke, wv = wv, liq = liq, ice = ice) + z_mid = state%z_ini(1:ncol,:), se = se(1:ncol), & + po = po(1:ncol), ke = ke(1:ncol), wv = wv(1:ncol), liq = liq(1:ncol), & + ice = ice(1:ncol)) call cnst_get_ind('TT_LW' , ixtt , abort=.false.) From d77c7a584c80c11f6c76b6a4dfb7cd57fc02ea15 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Wed, 11 Jan 2023 14:57:23 -0700 Subject: [PATCH 056/140] another index bug --- src/physics/cam/check_energy.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 06e86035fd..c67ee71892 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -492,7 +492,8 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & state%pdel(1:ncol,1:pver), cp_or_cv(1:ncol,1:pver), & state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), state%T(1:ncol,1:pver), & vc_physics, ps = state%ps(1:ncol), phis = state%phis(1:ncol), & - te = te, H2O = tw, se=se,po=po,ke=ke,wv=wv,liq=liq,ice=ice) + te = te(1:ncol), H2O = tw(1:ncol), se=se(1:ncol),po=po(1:ncol), & + ke=ke(1:ncol),wv=wv(1:ncol),liq=liq(1:ncol),ice=ice(1:ncol)) ! compute expected values and tendencies do i = 1, ncol ! change in static energy and total water From 75d2280609182e2ea4ad4539af488c71c9c41bc6 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 16 Jan 2023 18:34:26 -0700 Subject: [PATCH 057/140] updates to log file --- src/dynamics/se/dycore_budget.F90 | 32 +++++++++++++++++++++++++------ 1 file changed, 26 insertions(+), 6 deletions(-) diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index 9bd47eb140..550f1f3655 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -3,7 +3,8 @@ module dycore_budget implicit none public :: print_budget -real(r8), parameter :: eps = 1.0E-9_r8 +real(r8), parameter :: eps = 1.0E-9_r8 +real(r8), parameter :: eps_mass = 1.0E-12_r8 real(r8), save :: previous_dEdt_adiabatic_dycore = 0.0_r8 real(r8), save :: previous_dEdt_dry_mass_adjust = 0.0_r8 @@ -134,7 +135,7 @@ subroutine print_budget() dycore = -ph_EFIX-previous_dEdt_dry_mass_adjust write(iulog,*) "" write(iulog,*) "Dycore TE dissipation estimated from physics in pressure coordinate:" - write(iulog,*) "(note to avoid sampling error we need dE/dt from previous time-step)" + write(iulog,*) "(note: to avoid sampling error we need dE/dt from previous time-step)" write(iulog,*) "" write(iulog,*) "dE/dt adiabatic dycore estimated from physics (t=n-1) = " write(iulog,'(a58,F6.2,a6)') "-dE/dt energy fixer(t=n)-dE/dt dry-mass adjust(t=n-1) = ",dycore," W/M^2" @@ -232,19 +233,38 @@ subroutine print_budget() call budget_get_global('phAP-phBP',m_cnst,param) call budget_get_global('phAM-phBF',m_cnst,phys_total) - write(iulog,*)"dMASS/dt energy fixer (pBP-pBF) ",pEFIX," Pa" + if (abs(pEFIX)>eps_mass) then + write(iulog,*) "dMASS/dt energy fixer (pBP-pBF) ",pEFIX," Pa" + write(iulog,*) "ERROR: Mass not conserved in energy fixer. ABORT" + call endrun('dycore_budget module: Mass not conserved in energy fixer. See atm.log') + endif + if (abs(pDMEA)>eps_mass) then + write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",pDMEA," Pa" + write(iulog,*) "ERROR: Mass not conserved in dry mass adjustment. ABORT" + call endrun('dycore_budget module: Mass not conserved in dry mass adjustment. See atm.log') + end if + if (abs(param-phys_total)>eps_mass) then + write(iulog,*) "Error: dMASS/dt parameterizations (pAP-pBP) .ne. dMASS/dt physics total (pAM-pBF)" + write(iulog,*) "dMASS/dt parameterizations (pAP-pBP) ",param," Pa" + write(iulog,*) "dMASS/dt physics total (pAM-pBF) ",phys_total," Pa" + call endrun('dycore_budget module: mass change not only due to parameterizations. See atm.log') + end if + write(iulog,*)"dMASS/dt parameterizations (pAP-pBP) ",param," Pa" - write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",pDMEA," Pa" write(iulog,*)"dMASS/dt physics total (pAM-pBF) ",phys_total," Pa" write(iulog,*)" " + ! + ! detailed mass budget in dynamical core + ! if (is_budget('dAD').and.is_budget('dBD').and.is_budget('dAR').and.is_budget('dCH')) then call budget_get_global('dAD-dBD',m_cnst,mass_change__2D_dyn) call budget_get_global('dAR-dAD',m_cnst,mass_change__vertical_remapping) diff = mass_change__2D_dyn+mass_change__vertical_remapping write(iulog,*)"dMASS/dt total adiabatic dynamics ",diff," Pa" - if (abs(diff)>1.E-12_r8) then + if (abs(diff)>eps_mass) then write(iulog,*) "Error: mass non-conservation in dynamical core" - + write(iulog,*) "(detailed budget below)" + write(iulog,*) " " write(iulog,*)"dMASS/dt 2D dynamics (dAD-dBD) ",mass_change__2D_dyn," Pa" if (is_budget('dAR').and.is_budget('dAD')) then call budget_get_global('dAR',m_cnst,dar) From 7e520bd33eef2c465bc5822cfde68c0baa877280 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 20 Jan 2023 11:40:40 -0700 Subject: [PATCH 058/140] better error checking --- src/utils/cam_thermo.F90 | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/utils/cam_thermo.F90 b/src/utils/cam_thermo.F90 index 113636e237..8c91dccb6f 100644 --- a/src/utils/cam_thermo.F90 +++ b/src/utils/cam_thermo.F90 @@ -1680,11 +1680,11 @@ subroutine get_hydrostatic_energy_1hd(tracer, pdel, cp_or_cv, U, V, T, & po_vint(idx) = (phis(idx) * ps(idx) / gravit) end do case(vc_height) - if (.not. present(z_mid)) then - write(iulog, *) subname, & - ' z_mid must be present for height vertical coordinate' - call endrun(subname//': z_mid must be present for height '// & - 'vertical coordinate') + if ((.not. present(phis)) .or. (.not. present(phis))) then + write(iulog, *) subname, ' phis and phis must be present for ', & + 'heigt-based vertical coordinate' + call endrun(subname//': phis and phis must be present for '// & + 'height-based vertical coordinate') end if ke_vint = 0._r8 se_vint = 0._r8 @@ -1772,7 +1772,6 @@ subroutine get_hydrostatic_energy_1hd(tracer, pdel, cp_or_cv, U, V, T, & end select end if deallocate(species_idx, species_liq_idx, species_ice_idx) - end subroutine get_hydrostatic_energy_1hd end module cam_thermo From 0544d0dc1ecd09b8fa8355647c24060685e605e8 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Thu, 2 Feb 2023 15:44:06 -0700 Subject: [PATCH 059/140] make MPAS use cam_thermo energy routines --- src/dynamics/mpas/dp_coupling.F90 | 87 +++++++++++++------------------ src/physics/cam/check_energy.F90 | 11 ++-- src/utils/cam_thermo.F90 | 45 +++++++++++----- 3 files changed, 73 insertions(+), 70 deletions(-) diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index 1676692d0b..8b3a48bd9f 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -827,7 +827,8 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t use air_composition, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_liq_num use budgets, only: budget_array_max,budget_info_byname use cam_thermo, only: wvidx,wlidx,wiidx,seidx,poidx,keidx,moidx,mridx,ttidx,teidx,thermo_budget_num_vars - + use dyn_tests_utils, only: vcoord=>vc_height + use cam_thermo, only: get_hydrostatic_energy ! Arguments integer, intent(in) :: nCells integer, intent(in) :: nVertLevels @@ -846,12 +847,14 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t character*(*), intent(in) :: outfld_name_suffix ! suffix for "outfld" names ! Local variables - integer :: iCell, k, idx + integer :: iCell, k, idx, idx_tmp integer :: s_ind,b_ind logical :: b_subcycle - real(r8) :: rho_dz,zcell,temperature,theta,pk,ptop,exner - real(r8), dimension(nVertLevels, nCells) :: rhod, dz - real(r8), dimension(nCells) :: kinetic_energy,potential_energy,internal_energy,water_vapor + real(r8) :: rho_dz,theta,pk,ptop,exner,dz,rhod + real(r8), dimension(nCells,nVertLevels) :: temperature, pdeldry, cp_or_cv, zcell, u, v + real(r8), dimension(nCells) :: phis + real(r8), dimension(nCells,nVertLevels,qsize) :: tracers + real(r8), dimension(nCells) :: kinetic_energy,potential_energy,internal_energy,water_vapor real(r8), dimension(nCells) :: liq !total column integrated liquid real(r8), dimension(nCells) :: ice !total column integrated ice @@ -872,40 +875,42 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t potential_energy = 0.0_r8 internal_energy = 0.0_r8 water_vapor = 0.0_r8 + tracers = 0.0_r8 do iCell = 1, nCells do k = 1, nVertLevels - dz(k,iCell) = zgrid(k+1,iCell) - zgrid(k,iCell) - zcell = 0.5_r8*(zgrid(k,iCell)+zgrid(k+1,iCell)) - rhod(k,iCell) = zz(k,iCell) * rho_zz(k,iCell) -#ifdef phl_cam_development - rho_dz = (1.0_r8+q(index_qv,k,iCell))*rhod(k,iCell)*dz(k,iCell) -#else - rho_dz = 1.0_r8 + dz = zgrid(k+1,iCell) - zgrid(k,iCell) + zcell(iCell,k) = 0.5_r8*(zgrid(k,iCell)+zgrid(k+1,iCell))-zgrid(1,iCell) + rhod = zz(k,iCell) * rho_zz(k,iCell) + theta = theta_m(k,iCell)/(1.0_r8 + Rv_over_Rd *q(index_qv,k,iCell))!convert theta_m to theta + exner = (rgas*rhod*theta_m(k,iCell)/p0)**(rgas/cv) + + temperature(iCell,k) = exner*theta + pdeldry(iCell,k) = gravit*rhod*dz + cp_or_cv(iCell,k) = cv + u(iCell,k) = ux(k,iCell) + v(iCell,k) = uy(k,iCell) + phis(iCell) = zgrid(1,iCell)*gravit do idx=1,thermodynamic_active_species_num - rho_dz = rho_dz+q(thermodynamic_active_species_idx_dycore(idx),k,iCell) + idx_tmp = thermodynamic_active_species_idx_dycore(idx) + tracers(iCell,k,idx_tmp) = q(idx_tmp,k,iCell) end do - rho_dz = rho_dz*rhod(k,iCell)*dz(k,iCell) -#endif - theta = theta_m(k,iCell)/(1.0_r8 + Rv_over_Rd *q(index_qv,k,iCell))!convert theta_m to theta - - exner = (rgas*rhod(k,iCell)*theta_m(k,iCell)/p0)**(rgas/cv) - temperature = exner*theta - - water_vapor(iCell) = water_vapor(iCell) + rhod(k,iCell)*q(index_qv,k,iCell)*dz(k,iCell) - kinetic_energy(iCell) = kinetic_energy(iCell) + & - 0.5_r8*(ux(k,iCell)**2._r8+uy(k,iCell)**2._r8)*rho_dz - potential_energy(iCell) = potential_energy(iCell)+ rho_dz*gravit*zcell - internal_energy(iCell) = internal_energy(iCell) + rho_dz*cv*temperature end do - end do - call outfld(name_out1,internal_energy,ncells,1) - call outfld(name_out2,kinetic_energy ,ncells,1) - call outfld(name_out3,water_vapor ,ncells,1) - call outfld(name_out6,potential_energy ,ncells,1) + enddo + call get_hydrostatic_energy(tracers, .false., pdeldry, cp_or_cv, u, v, temperature, & + vcoord=vcoord, phis = phis, z_mid=zcell, dycore_idx=.true., & + se=internal_energy, po =potential_energy, ke =kinetic_energy, & + wv=water_vapor , liq=liq , ice=ice) + + call outfld(name_out1,internal_energy ,ncells,1) + call outfld(name_out2,kinetic_energy ,ncells,1) + call outfld(name_out3,water_vapor ,ncells,1) + call outfld(name_out6,potential_energy,ncells,1) call budget_info_byname(trim(outfld_name_suffix),budget_ind=b_ind,state_ind=s_ind,subcycle=b_subcycle) ! reset all when cnt is 0 + write(iulog,*)'dpc calc se,ke ',s_ind,',1:3,1 is ',internal_energy(1),' ',kinetic_energy(1) + write(iulog,*)'dpc budgets initial ',s_ind,',1:3,1 is ',te_budgets(s_ind,1,1),' ',te_budgets(s_ind,2,1),' ',te_budgets(s_ind,3,1) if (budgets_cnt(b_ind) == 0) then budgets_subcycle_cnt(b_ind) = 0 te_budgets(s_ind,:,:)=0.0_r8 @@ -921,27 +926,18 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t !not subcycling so don't sum just replace previous budget values te_budgets(s_ind,:,:)=0._r8 end if - + te_budgets(s_ind,teidx,:)=te_budgets(s_ind,teidx,:)+potential_energy+internal_energy+kinetic_energy te_budgets(s_ind,seidx,:)=te_budgets(s_ind,seidx,:)+internal_energy te_budgets(s_ind,keidx,:)=te_budgets(s_ind,keidx,:)+kinetic_energy te_budgets(s_ind,poidx,:)=te_budgets(s_ind,poidx,:)+potential_energy - te_budgets(s_ind,wvidx,:)=te_budgets(s_ind,wvidx,:)+water_vapor + write(iulog,*)'tot_e te_budget for this proc ',s_ind,',1:3,1 is ',te_budgets(s_ind,1,1),' ',te_budgets(s_ind,2,1),' ',te_budgets(s_ind,3,1) ! ! vertical integral of total liquid water ! if (hist_fld_active(name_out4)) then - liq = 0._r8 - do idx = 1,thermodynamic_active_species_liq_num - do iCell = 1, nCells - do k = 1, nVertLevels - liq(iCell) = liq(iCell) + & - q(thermodynamic_active_species_liq_idx_dycore(idx),k,iCell)*rhod(k,iCell)*dz(k,iCell) - end do - end do - end do call outfld(name_out4,liq,ncells,1) te_budgets(s_ind,wlidx,:)=te_budgets(s_ind,wlidx,:)+liq end if @@ -949,15 +945,6 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t ! vertical integral of total frozen (ice) water ! if (hist_fld_active(name_out5)) then - ice = 0._r8 - do idx = 1,thermodynamic_active_species_ice_num - do iCell = 1, nCells - do k = 1, nVertLevels - ice(iCell) = ice(iCell) + & - q(thermodynamic_active_species_ice_idx_dycore(idx),k,iCell)*rhod(k,iCell)*dz(k,iCell) - end do - end do - end do call outfld(name_out5,ice,ncells,1) te_budgets(s_ind,wiidx,:)=te_budgets(s_ind,wiidx,:)+ice end if diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index c67ee71892..5cda181e31 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -1,4 +1,3 @@ - module check_energy !--------------------------------------------------------------------------------- @@ -276,7 +275,7 @@ subroutine check_energy_timestep_init(state, tend, pbuf, col_type) ! ! CAM physics total energy ! - call get_hydrostatic_energy(state%q(1:ncol,1:pver,1:pcnst),& + call get_hydrostatic_energy(state%q(1:ncol,1:pver,1:pcnst),.true., & state%pdel(1:ncol,1:pver), cp_or_cv(1:ncol,1:pver), & state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), state%T(1:ncol,1:pver), & vc_physics, ps = state%ps(1:ncol), phis = state%phis(1:ncol), & @@ -296,7 +295,7 @@ subroutine check_energy_timestep_init(state, tend, pbuf, col_type) cp_or_cv(:,:) = cpair-rair endif - call get_hydrostatic_energy(state%q(1:ncol,1:pver,1:pcnst),& + call get_hydrostatic_energy(state%q(1:ncol,1:pver,1:pcnst),.true., & state%pdel(1:ncol,1:pver), cp_or_cv(1:ncol,1:pver), & state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), state%T(1:ncol,1:pver), & vc_dycore, ps = state%ps(1:ncol), phis = state%phis(1:ncol), & @@ -488,7 +487,7 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & call endrun('check_energy_chng: cpairv is not allowed to vary when subcolumns are turned on') end if - call get_hydrostatic_energy(state%q(1:ncol,1:pver,1:pcnst),& + call get_hydrostatic_energy(state%q(1:ncol,1:pver,1:pcnst),.true., & state%pdel(1:ncol,1:pver), cp_or_cv(1:ncol,1:pver), & state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), state%T(1:ncol,1:pver), & vc_physics, ps = state%ps(1:ncol), phis = state%phis(1:ncol), & @@ -571,7 +570,7 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & scaling(:,:) = cpairv(:,:,lchnk)/cp_or_cv(:,:) !cp/cv scaling temp(1:ncol,:) = state%temp_ini(1:ncol,:)+scaling(1:ncol,:)*(state%T(1:ncol,:)-state%temp_ini(1:ncol,:)) - call get_hydrostatic_energy(state%q(1:ncol,1:pver,1:pcnst),& + call get_hydrostatic_energy(state%q(1:ncol,1:pver,1:pcnst),.true., & state%pdel(1:ncol,1:pver), cp_or_cv(1:ncol,1:pver), & state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), temp(1:ncol,1:pver), & vc_dycore, ps = state%ps(1:ncol), phis = state%phis(1:ncol), & @@ -1138,7 +1137,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) ! scale accumulated temperature increment for constant volume (otherwise effectively do nothing) temp(1:ncol,:) = state%temp_ini(1:ncol,:)+scaling(1:ncol,:)*(state%T(1:ncol,:)- state%temp_ini(1:ncol,:)) - call get_hydrostatic_energy(state%q(1:ncol,1:pver,1:pcnst), & + call get_hydrostatic_energy(state%q(1:ncol,1:pver,1:pcnst),.true., & state%pdel(1:ncol,1:pver), cp_or_cv(1:ncol,1:pver), & state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), temp(1:ncol,1:pver), & vc_loc, ps = state%ps(1:ncol), phis = state%phis(1:ncol), & diff --git a/src/utils/cam_thermo.F90 b/src/utils/cam_thermo.F90 index 8c91dccb6f..d551bf0219 100644 --- a/src/utils/cam_thermo.F90 +++ b/src/utils/cam_thermo.F90 @@ -1555,9 +1555,9 @@ end subroutine cam_thermo_calc_kappav_2hd ! !*************************************************************************** ! - subroutine get_hydrostatic_energy_1hd(tracer, pdel, cp_or_cv, U, V, T, & - vcoord, ps, phis, z_mid, dycore_idx, qidx, te, se, po, ke, & - wv, H2O, liq, ice) + subroutine get_hydrostatic_energy_1hd(tracer, moist_mixing_ratio, pdel_in, & + cp_or_cv, U, V, T, vcoord, ps, phis, z_mid, dycore_idx, qidx, & + te, se, po, ke, wv, H2O, liq, ice) use cam_logfile, only: iulog use dyn_tests_utils, only: vc_height, vc_moist_pressure, vc_dry_pressure @@ -1566,9 +1566,12 @@ subroutine get_hydrostatic_energy_1hd(tracer, pdel, cp_or_cv, U, V, T, & ! Dummy arguments ! tracer: tracer mixing ratio + ! + ! note - if pdeldry passed to subroutine then tracer mixing ratio must be dry real(r8), intent(in) :: tracer(:,:,:) + logical, intent(in) :: moist_mixing_ratio ! pdel: pressure level thickness - real(r8), intent(in) :: pdel(:,:) + real(r8), intent(in) :: pdel_in(:,:) ! cp_or_cv: dry air heat capacity under constant pressure or ! constant volume (depends on vcoord) real(r8), intent(in) :: cp_or_cv(:,:) @@ -1609,6 +1612,7 @@ subroutine get_hydrostatic_energy_1hd(tracer, pdel, cp_or_cv, U, V, T, & real(r8) :: wv_vint(SIZE(tracer, 1)) ! Vertical integral of wv real(r8) :: liq_vint(SIZE(tracer, 1)) ! Vertical integral of liq real(r8) :: ice_vint(SIZE(tracer, 1)) ! Vertical integral of ice + real(r8) :: pdel(SIZE(tracer, 1),SIZE(tracer, 2)) !moist pressure level thickness real(r8) :: latsub ! latent heat of sublimation integer :: ierr @@ -1655,6 +1659,15 @@ subroutine get_hydrostatic_energy_1hd(tracer, pdel, cp_or_cv, U, V, T, & wvidx = wv_idx end if + if (moist_mixing_ratio) then + pdel = pdel_in + else + pdel = pdel_in + do qdx = 1, thermodynamic_active_species_num + pdel(:,:) = pdel(:,:) + pdel_in(:, :)*tracer(:,:,species_idx(qdx)) + end do + end if + select case (vcoord) case(vc_moist_pressure, vc_dry_pressure) if ((.not. present(ps)) .or. (.not. present(phis))) then @@ -1665,15 +1678,12 @@ subroutine get_hydrostatic_energy_1hd(tracer, pdel, cp_or_cv, U, V, T, & end if ke_vint = 0._r8 se_vint = 0._r8 - wv_vint = 0._r8 do kdx = 1, SIZE(tracer, 2) do idx = 1, SIZE(tracer, 1) ke_vint(idx) = ke_vint(idx) + (pdel(idx, kdx) * & 0.5_r8 * (U(idx, kdx)**2 + V(idx, kdx)**2) / gravit) se_vint(idx) = se_vint(idx) + (T(idx, kdx) * & cp_or_cv(idx, kdx) * pdel(idx, kdx) / gravit) - wv_vint(idx) = wv_vint(idx) + (tracer(idx, kdx, wvidx) * & - pdel(idx, kdx) / gravit) end do end do do idx = 1, SIZE(tracer, 1) @@ -1689,7 +1699,6 @@ subroutine get_hydrostatic_energy_1hd(tracer, pdel, cp_or_cv, U, V, T, & ke_vint = 0._r8 se_vint = 0._r8 po_vint = 0._r8 - wv_vint = 0._r8 do kdx = 1, SIZE(tracer, 2) do idx = 1, SIZE(tracer, 1) ke_vint(idx) = ke_vint(idx) + (pdel(idx, kdx) * & @@ -1699,8 +1708,6 @@ subroutine get_hydrostatic_energy_1hd(tracer, pdel, cp_or_cv, U, V, T, & ! z_mid is height above ground po_vint(idx) = po_vint(idx) + (z_mid(idx, kdx) + & phis(idx) / gravit) * pdel(idx, kdx) - wv_vint(idx) = wv_vint(idx) + (tracer(idx, kdx, wvidx) * & - pdel(idx, kdx) / gravit) end do end do case default @@ -1719,17 +1726,27 @@ subroutine get_hydrostatic_energy_1hd(tracer, pdel, cp_or_cv, U, V, T, & if (present(ke)) then ke = ke_vint end if - if (present(wv)) then - wv = wv_vint - end if ! ! vertical integral of total liquid water ! + if (.not.moist_mixing_ratio) then + pdel = pdel_in! set pseudo density to dry + end if + + wv_vint = 0._r8 + do kdx = 1, SIZE(tracer, 2) + do idx = 1, SIZE(tracer, 1) + wv_vint(idx) = wv_vint(idx) + (tracer(idx, kdx, wvidx) * & + pdel(idx, kdx) / gravit) + end do + end do + if (present(wv)) wv = wv_vint + liq_vint = 0._r8 do qdx = 1, thermodynamic_active_species_liq_num do kdx = 1, SIZE(tracer, 2) do idx = 1, SIZE(tracer, 1) - liq_vint(idx) = liq_vint(idx) + (pdel(idx, kdx) * & + liq_vint(idx) = liq_vint(idx) + (pdel(idx, kdx) * & tracer(idx, kdx, species_liq_idx(qdx)) / gravit) end do end do From 64a592eae7e5b1b00b9feecf13e8d6a298637f5a Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 3 Feb 2023 16:05:51 -0700 Subject: [PATCH 060/140] use thermo infrastructure in SE energy calculations --- src/dynamics/se/dycore/prim_advance_mod.F90 | 128 +++++++------------- src/dynamics/se/dycore_budget.F90 | 4 +- src/physics/cam/check_energy.F90 | 16 +-- src/utils/cam_thermo.F90 | 21 ++-- 4 files changed, 66 insertions(+), 103 deletions(-) diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index 6696ffd532..0e1b084170 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -1457,15 +1457,17 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf use string_utils, only: strlist_get_ind use hycoef, only: hyai, ps0 use fvm_control_volume_mod, only: fvm_struct - use cam_thermo, only: get_dp, MASS_MIXING_RATIO,wvidx,wlidx,wiidx,seidx,keidx,moidx,mridx,ttidx,teidx + use cam_thermo, only: get_dp, MASS_MIXING_RATIO,wvidx,wlidx,wiidx,seidx,poidx,keidx,moidx,mridx,ttidx,teidx + use cam_thermo, only: get_hydrostatic_energy use air_composition, only: thermodynamic_active_species_idx_dycore, get_cp + use air_composition, only: thermodynamic_active_species_num, thermodynamic_active_species_idx_dycore use air_composition, only: thermodynamic_active_species_liq_num,thermodynamic_active_species_liq_idx use air_composition, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_ice_idx use dimensions_mod, only: cnst_name_gll use budgets, only: budget_info_byname use cam_logfile, only: iulog use spmd_utils, only: masterproc - + use dyn_tests_utils, only: vcoord=>vc_dry_pressure !------------------------------Arguments-------------------------------- type (element_t) , intent(inout) :: elem(:) @@ -1476,15 +1478,19 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf !---------------------------Local storage------------------------------- - real(kind=r8) :: se(npsq) ! Dry Static energy (J/m2) - real(kind=r8) :: ke(npsq) ! kinetic energy (J/m2) + real(kind=r8) :: se(np,np) ! Enthalpy energy (J/m2) + real(kind=r8) :: ke(np,np) ! kinetic energy (J/m2) + real(kind=r8) :: po(np,np) ! PHIS term in energy equation (J/m2) + real(kind=r8) :: wv(np,np) ! water vapor + real(kind=r8) :: liq(np,np) ! liquid + real(kind=r8) :: ice(np,np) ! ice + real(kind=r8) :: q(np,nlev,qsize) real(kind=r8) :: cdp_fvm(nc,nc,nlev) real(kind=r8) :: cdp(np,np,nlev) - real(kind=r8) :: se_tmp - real(kind=r8) :: ke_tmp - real(kind=r8) :: ps(np,np) + real(kind=r8) :: ptop(np,np) real(kind=r8) :: pdel(np,np,nlev) + real(kind=r8) :: cp(np,np,nlev) ! ! global axial angular momentum (AAM) can be separated into one part (mr) associatedwith the relative motion ! of the atmosphere with respect to the planets surface (also known as wind AAM) and another part (mo) @@ -1494,9 +1500,8 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf real(kind=r8) :: mr(npsq) ! wind AAM real(kind=r8) :: mo(npsq) ! mass AAM real(kind=r8) :: mr_cnst, mo_cnst, cos_lat, mr_tmp, mo_tmp,inv_g - real(kind=r8) :: cp(np,np,nlev),btmp(np,np) - integer :: ie,i,j,k,budget_ind,state_ind,idx + integer :: ie,i,j,k,budget_ind,state_ind,idx,idx_tmp integer :: ixwv,ixcldice, ixcldliq, ixtt ! CLDICE, CLDLIQ and test tracer indices character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 @@ -1531,40 +1536,29 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf ! Compute frozen static energy in 3 parts: KE, SE, and energy associated with vapor and liquid ! do ie=nets,nete - se = 0.0_r8 - ke = 0.0_r8 - call get_dp(elem(ie)%state%Qdp(:,:,:,1:qsize,tl_qdp), MASS_MIXING_RATIO, thermodynamic_active_species_idx_dycore,& - elem(ie)%state%dp3d(:,:,:,tl), pdel, ps=ps, ptop=hyai(1)*ps0) - call get_cp(elem(ie)%state%Qdp(:,:,:,1:qsize,tl_qdp),& - .false., cp, dp_dry=elem(ie)%state%dp3d(:,:,:,tl),& - active_species_idx_dycore=thermodynamic_active_species_idx_dycore) - do k = 1, nlev - do j=1,np - do i = 1, np - ! - ! kinetic energy - ! - ke_tmp = 0.5_r8*(elem(ie)%state%v(i,j,1,k,tl)**2+ elem(ie)%state%v(i,j,2,k,tl)**2)*pdel(i,j,k)/gravit - if (lcp_moist) then - se_tmp = cp(i,j,k)*elem(ie)%state%T(i,j,k,tl)*pdel(i,j,k)/gravit - else - ! - ! using CAM physics definition of internal energy - ! - se_tmp = cpair*elem(ie)%state%T(i,j,k,tl)*pdel(i,j,k)/gravit - end if - se (i+(j-1)*np) = se (i+(j-1)*np) + se_tmp - ke (i+(j-1)*np) = ke (i+(j-1)*np) + ke_tmp - end do - end do - end do + if (lcp_moist) then + call get_cp(elem(ie)%state%Qdp(:,:,:,1:qsize,tl_qdp),& + .false., cp, dp_dry=elem(ie)%state%dp3d(:,:,:,tl),& + active_species_idx_dycore=thermodynamic_active_species_idx_dycore) + else + cp = cpair + end if + ptop = hyai(1)*ps0 do j=1,np - do i = 1, np - se(i+(j-1)*np) = se(i+(j-1)*np) + elem(ie)%state%phis(i,j)*ps(i,j)/gravit + !set thermodynamic active species + do idx=1,thermodynamic_active_species_num + idx_tmp = thermodynamic_active_species_idx_dycore(idx) + q(:,:,idx_tmp) = elem(ie)%state%Qdp(:,j,:,idx_tmp,tl_qdp)/& + elem(ie)%state%dp3d(:,j,:,tl) end do + call get_hydrostatic_energy(q, & + .false., elem(ie)%state%dp3d(:,j,:,tl), cp(:,j,:), elem(ie)%state%v(:,j,1,:,tl), & + elem(ie)%state%v(:,j,2,:,tl), elem(ie)%state%T(:,j,:,tl), vcoord, ptop=ptop(:,j), & + phis=elem(ie)%state%phis(:,j),dycore_idx=.true., & + se=se(:,j), po=po(:,j), ke=ke(:,j), wv=wv(:,j), liq=liq(:,j), ice=ice(:,j)) end do - + ! could store pointer to dyn/phys state index inside of budget and call budget_state_update pass in se,ke etc. call budget_info_byname(trim(outfld_name_suffix),budget_ind=budget_ind,state_ind=state_ind) ! reset all when cnt is 0 @@ -1592,16 +1586,21 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf do j=1,np do i = 1, np - elem(ie)%derived%budget(i,j,teidx,state_ind) = elem(ie)%derived%budget(i,j,teidx,state_ind) + (se(i+(j-1)*np) + ke(i+(j-1)*np)) - elem(ie)%derived%budget(i,j,seidx,state_ind) = elem(ie)%derived%budget(i,j,seidx,state_ind) + se(i+(j-1)*np) - elem(ie)%derived%budget(i,j,keidx,state_ind) = elem(ie)%derived%budget(i,j,keidx,state_ind) + ke(i+(j-1)*np) + elem(ie)%derived%budget(i,j,teidx,state_ind) = elem(ie)%derived%budget(i,j,teidx,state_ind) + & + se(i,j) + ke(i,j)+po(i,j) + elem(ie)%derived%budget(i,j,seidx,state_ind) = elem(ie)%derived%budget(i,j,seidx,state_ind) + se(i,j) + elem(ie)%derived%budget(i,j,keidx,state_ind) = elem(ie)%derived%budget(i,j,keidx,state_ind) + ke(i,j) + elem(ie)%derived%budget(i,j,poidx,state_ind) = elem(ie)%derived%budget(i,j,poidx,state_ind) + po(i,j) + elem(ie)%derived%budget(i,j,wvidx,state_ind) = elem(ie)%derived%budget(i,j,wvidx,state_ind) + wv(i,j) + elem(ie)%derived%budget(i,j,wlidx,state_ind) = elem(ie)%derived%budget(i,j,wlidx,state_ind) + liq(i,j) + elem(ie)%derived%budget(i,j,wiidx,state_ind) = elem(ie)%derived%budget(i,j,wiidx,state_ind) + ice(i,j) end do end do ! ! Output energy diagnostics on GLL grid ! - call outfld(name_out1 ,se ,npsq,ie) - call outfld(name_out2 ,ke ,npsq,ie) + call outfld(name_out1 ,se,npsq,ie) + call outfld(name_out2 ,ke,npsq,ie) ! ! mass variables are output on CSLAM grid if using CSLAM else GLL grid ! @@ -1658,43 +1657,6 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf end do end if else - cdp = elem(ie)%state%qdp(:,:,:,1,tl_qdp) - call util_function(cdp,np,nlev,name_out3,ie) - do j = 1, np - do i = 1, np - elem(ie)%derived%budget(i,j,wvidx,state_ind) = elem(ie)%derived%budget(i,j,wvidx,state_ind) + sum(cdp(i,j,:)*inv_g) - end do - end do - ! - ! sum over liquid water - ! - if (thermodynamic_active_species_liq_num>0) then - cdp = 0.0_r8 - do idx = 1,thermodynamic_active_species_liq_num - cdp = cdp + elem(ie)%state%qdp(:,:,:,thermodynamic_active_species_liq_idx(idx),tl_qdp) - end do - call util_function(cdp,np,nlev,name_out4,ie) - do j = 1, np - do i = 1, np - elem(ie)%derived%budget(i,j,wlidx,state_ind) = elem(ie)%derived%budget(i,j,wlidx,state_ind) + sum(cdp(i,j,:)*inv_g) - end do - end do - end if - ! - ! sum over ice water - ! - if (thermodynamic_active_species_ice_num>0) then - cdp = 0.0_r8 - do idx = 1,thermodynamic_active_species_ice_num - cdp = cdp + elem(ie)%state%qdp(:,:,:,thermodynamic_active_species_ice_idx(idx),tl_qdp) - end do - call util_function(cdp,np,nlev,name_out5,ie) - do j = 1, np - do i = 1, np - elem(ie)%derived%budget(i,j,wiidx,state_ind) = elem(ie)%derived%budget(i,j,wiidx,state_ind) + sum(cdp(i,j,:)*inv_g) - end do - end do - end if if (ixtt>0) then cdp = elem(ie)%state%qdp(:,:,:,ixtt ,tl_qdp) call util_function(cdp,np,nlev,name_out6,ie) @@ -1732,7 +1694,7 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf mr = 0.0_r8 mo = 0.0_r8 call get_dp(elem(ie)%state%Qdp(:,:,:,1:qsize,tl_qdp), MASS_MIXING_RATIO, thermodynamic_active_species_idx_dycore,& - elem(ie)%state%dp3d(:,:,:,tl), pdel, ps=ps, ptop=hyai(1)*ps0) + elem(ie)%state%dp3d(:,:,:,tl), pdel) do k = 1, nlev do j=1,np do i = 1, np @@ -1767,7 +1729,7 @@ subroutine calc_tot_energy_dynamics_diff(elem,fvm,nets,nete,tl,tl_qdp,budget_nam use fvm_control_volume_mod, only: fvm_struct use budgets, only: budget_info,budget_ind_byname use cam_thermo, only: thermo_budget_num_vars, & - thermo_budget_vars_massv,wvidx,wlidx,wiidx,seidx,keidx,moidx,mridx,ttidx,teidx + thermo_budget_vars_massv,wvidx,wlidx,wiidx,poidx,seidx,keidx,moidx,mridx,ttidx,teidx !------------------------------Arguments-------------------------------- type (element_t) , intent(inout) :: elem(:) diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index 550f1f3655..8bce8eccba 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -206,7 +206,7 @@ subroutine print_budget() write(iulog,*) "" call budget_get_global('dBF',teidx,E_dBF) !state passed to physics call budget_get_global('phBF',teidx,E_phBF)!state beginning physics - if (abs(E_phBF)>eps) then +! if (abs(E_phBF)>eps) then diff = abs_diff(E_dBF,E_phBF) if (abs(diff) Date: Tue, 7 Feb 2023 14:35:05 -0700 Subject: [PATCH 061/140] initial checkin of jt ebudget changes cam6387 --- bld/namelist_files/namelist_definition.xml | 24 +- src/control/budgets.F90 | 294 ++++++-- src/control/cam_control_mod.F90 | 1 - src/control/cam_history.F90 | 667 +++++++++++++++++- src/control/cam_history_buffers.F90 | 70 ++ src/control/cam_history_support.F90 | 43 +- src/dynamics/se/dycore/element_mod.F90 | 8 - .../se/dycore/fvm_control_volume_mod.F90 | 3 - src/dynamics/se/dycore/prim_advance_mod.F90 | 223 ++---- src/dynamics/se/dycore_budget.F90 | 36 +- src/dynamics/se/dyn_comp.F90 | 316 ++------- src/physics/cam/cam_diagnostics.F90 | 48 +- src/physics/cam/check_energy.F90 | 323 +-------- src/physics/cam/phys_control.F90 | 14 +- src/physics/cam/physics_types.F90 | 48 -- src/physics/cam/physpkg.F90 | 24 +- src/utils/cam_grid_support.F90 | 51 ++ src/utils/cam_thermo.F90 | 2 +- 18 files changed, 1262 insertions(+), 933 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 6e15203440..5c8f9f8717 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -1701,12 +1701,13 @@ Default: none + group="cam_history_nl" valid_values="A,B,C,I,X,M,L,S" > Sets the averaging flag for all variables on a particular history file series. Valid values are: A ==> Average B ==> GMT 00:00:00 average + C ==> average over nsteps not nacs I ==> Instantaneous M ==> Minimum X ==> Maximum @@ -1798,6 +1799,7 @@ are: A ==> Average B ==> GMT 00:00:00 average + C ==> average over nsteps I ==> Instantaneous M ==> Minimum X ==> Maximum @@ -2091,6 +2093,14 @@ this to a number greater than 1 allows for temporal interpolation in the post pr Default: 1 + +Frequency that budget files will be output: none, step, hourly, daily, monthly, +yearly, or endofrun. Valid values: 'NONE', 'STEP', 'HOURLY', 'DAILY', 'MONTHLY', +'YEARLY', 'ENDOFRUN'. +Default: 'NONE' + + Frequency that initial files will be output: 6-hourly, daily, monthly, @@ -5076,6 +5086,18 @@ History tape number T/Q budget output is written to. Default: 1 + +Switch for budget diagnostic output +Default: .false. + + + +History tape number thermo budget output is written to. +Default: 1 + + Switch for diagnostic output used primarily for WACCM runs. diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index a23870f2e8..3686fc028f 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -6,7 +6,9 @@ module budgets use spmd_utils, only: masterproc use cam_abortutils, only: endrun use cam_logfile, only: iulog -use cam_thermo, only: thermo_budget_num_vars +use cam_thermo, only: thermo_budget_vars, thermo_budget_vars_descriptor, & + thermo_budget_vars_unit, thermo_budget_vars_massv, thermo_budget_num_vars +use cam_history, only: addfld, add_default, horiz_only implicit none private @@ -26,6 +28,7 @@ module budgets public :: & budget_init, &! initialize budget variables budget_add, &! add a budget to the list of budgets + budget_update, &! update budget diffs, outflds, store new globals. budget_num_avail, &! returns the number of available slots in the budget array budget_chk_dim, &! check that number of budgets added equals dimensions (budget_array_max) budget_name_byind, &! return name of a budget @@ -37,6 +40,7 @@ module budgets budget_cnt_adjust, &! advance or reset budget count budget_count, &! return budget count is_budget, &! return budget count +!jt is_budgetfile, &! return budget count budget_get_global, &! return budget count budget_put_global, &! return budget count budget_write, &! write_budget: time to write global budget @@ -50,9 +54,9 @@ module budgets integer, parameter, public :: budget_array_max = 100 ! number of budget diffs integer, public :: budget_cnt(budget_array_max) ! budget counts for normalization logical, public :: budget_subcycle(budget_array_max) ! budget_subcycle counts -integer, public :: budget_num_dyn = 0 ! -integer, public :: budget_num_phy = 0 ! integer, public :: budget_num = 0 ! +integer, public :: budget_num_phy = 0 ! +integer, public :: budget_num_dyn = 0 ! integer, public :: budget_state_ind(budget_array_max) ! logical, public, protected :: budget_out(budget_array_max) ! outfld this stage character(len=64), public, protected :: budget_name(budget_array_max) ! budget names @@ -82,8 +86,8 @@ module budgets CONTAINS !============================================================================================== -subroutine budget_stage_add (name, pkgtype, longname, outfld, subcycle) - +subroutine budget_stage_add (name, pkgtype, longname, outfld) + use dimensions_mod, only: ntrac ! Register a budget. character(len=*), intent(in) :: & @@ -95,30 +99,15 @@ subroutine budget_stage_add (name, pkgtype, longname, outfld, subcycle) longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) logical, intent(in), optional :: & outfld ! true => default CAM output of budget in kg/kg - logical, intent(in), optional :: & - subcycle ! true => This budget is subcycled - integer :: state_idx ! dyn/phy state budget index (in q array) + character(len=*), parameter :: sub='budget_stage_add' character(len=128) :: errmsg - !----------------------------------------------------------------------- + character (len=108) :: str1, str2, str3 + logical :: thermo_budget_hist + integer :: ivars + !----------------------------------------------------------------------- - ! set budget index and check validity - if (pkgtype=='phy') then - budget_num_phy = budget_num_phy+1 - state_idx = budget_num_phy - else if (pkgtype=='dyn') then - budget_num_dyn = budget_num_dyn+1 - state_idx = budget_num_dyn - else - call endrun('unknown budget pkgtype') - end if budget_num = budget_num+1 - - if (budget_num > budget_array_max) then - write(errmsg, *) sub//': FATAL: budget stage index greater than budget stage max=', budget_array_max - call endrun(errmsg) - end if - ! set budget name and constants budget_name(budget_num) = name if (present(longname)) then @@ -136,19 +125,31 @@ subroutine budget_stage_add (name, pkgtype, longname, outfld, subcycle) end if budget_optype(budget_num)='stg' budget_pkgtype(budget_num)=pkgtype - budget_state_ind(budget_num)=state_idx - if (present(subcycle)) then - budget_subcycle(budget_num)=subcycle - else - budget_subcycle(budget_num)=.false. - end if budget_stagename(budget_num)= trim(name) -end subroutine budget_stage_add - + do ivars=1, thermo_budget_num_vars + write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(name)) + write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & + TRIM(ADJUSTL(longname)) + write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) + if (ntrac>0.and.thermo_budget_vars_massv(ivars)) then +!jt call addfld (TRIM(ADJUSTL(str1))//'&BG', horiz_only, 'C', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='FVM') + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'C', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='FVM') + else +!jt call addfld (TRIM(ADJUSTL(str1))//'&BG', horiz_only, 'C', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='GLL') + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'C', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='GLL') + end if +!jt call add_default(TRIM(ADJUSTL(str1))//'&BG', 0, 'C') + call add_default(TRIM(ADJUSTL(str1)), thermo_budget_histfile_num, 'C') + write(6,*)'adding default budget field ',TRIM(ADJUSTL(str1)),' on history file ',thermo_budget_histfile_num + end do + + end subroutine budget_stage_add + !!$!============================================================================== -subroutine budget_diff_add (name, stg1name, stg2name, pkgtype, optype, longname, outfld, subcycle) +subroutine budget_diff_add (name, stg1name, stg2name, pkgtype, optype, longname, outfld) + use dimensions_mod, only: ntrac ! Register a budget. @@ -167,30 +168,15 @@ subroutine budget_diff_add (name, stg1name, stg2name, pkgtype, optype, longname, logical, intent(in), optional :: & outfld ! true => default CAM output of budget in kg/kg - logical, intent(in), optional :: & - subcycle ! true => if this budget is subcycled - character(len=*), parameter :: sub='budget_diff_add' character(len=128) :: errmsg character(len=1) :: opchar - integer :: state_idx + character (len=256) :: str1, str2, str3, strstg1, strstg2 + integer :: ivars !----------------------------------------------------------------------- - ! set budget index and check validity - if (pkgtype=='phy') then - budget_num_phy=budget_num_phy+1 - state_idx = budget_num_phy - else if (pkgtype=='dyn') then - budget_num_dyn=budget_num_dyn+1 - state_idx = budget_num_dyn - else - call endrun('bad budget pkgtype') - end if - budget_num= budget_num+1 + + budget_num = budget_num + 1 budget_pkgtype(budget_num)=pkgtype - if (budget_num > budget_array_max) then - write(errmsg, *) sub//': FATAL: budget diff index:',budget_num,' greater than budget_array_max=', budget_array_max - call endrun(errmsg) - end if ! set budget name and constants budget_name(budget_num) = name @@ -210,8 +196,6 @@ subroutine budget_diff_add (name, stg1name, stg2name, pkgtype, optype, longname, budget_stagename(budget_num)= trim(stg1name)//opchar//trim(stg2name) budget_stg1index(budget_num) = budget_ind_byname(trim(stg1name)) budget_stg2index(budget_num) = budget_ind_byname(trim(stg2name)) - budget_stg1stateidx(budget_num) = budget_state_ind(budget_stg1index(budget_num)) - budget_stg2stateidx(budget_num) = budget_state_ind(budget_stg2index(budget_num)) ! set outfld type ! (false: the module declaring the budget is responsible for outfld calls) if (present(outfld)) then @@ -221,12 +205,30 @@ subroutine budget_diff_add (name, stg1name, stg2name, pkgtype, optype, longname, end if budget_optype(budget_num)=optype - budget_state_ind(budget_num)=state_idx - if (present(subcycle)) then - budget_subcycle(budget_num)=subcycle - else - budget_subcycle(budget_num)=.false. - end if + + +! register history budget variables + do ivars=1, thermo_budget_num_vars + write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(name)) + write(strstg1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stg1name)) + write(strstg2,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stg2name)) + write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & + TRIM(ADJUSTL(longname)) + write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) + if (ntrac>0.and.thermo_budget_vars_massv(ivars)) then +!jt call addfld (TRIM(ADJUSTL(str1))//'&BG', horiz_only, 'C', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='FVM') +!jt call addfld (TRIM(ADJUSTL(str1))//'&BG', horiz_only, 'C', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'C', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & + gridname='FVM',op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) + else +!jt call addfld (TRIM(ADJUSTL(str1))//'&BG', horiz_only, 'C', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'C', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & + gridname='GLL',op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) + endif +!jt call add_default(TRIM(ADJUSTL(str1))//'&BG', 0, 'C) + call add_default(TRIM(ADJUSTL(str1)), thermo_budget_histfile_num, 'C') + write(6,*)'adding default budget field ',TRIM(ADJUSTL(str1)),' on history file ',thermo_budget_histfile_num + end do end subroutine budget_diff_add !============================================================================== @@ -408,8 +410,13 @@ subroutine budget_cnt_adjust(ind,reset) end subroutine budget_cnt_adjust !============================================================================================== -subroutine budget_init() +subroutine budget_init(dyn_area,phy_area,npsq,ncsq,nets,nete) + + real(r8), intent(in) :: dyn_area(npsq,nets:nete) + real(r8), intent(in) :: phy_area(ncsq,nets:nete) + integer, intent(in) :: npsq,nets,nete,ncsq + integer :: i,ie ! Initial budget module variables. budget_cnt(:) = 0._r8 @@ -427,6 +434,16 @@ subroutine budget_init() budget_stg2name(:)= 'UNSET' budget_subcycle(:)= .false. +!jt call addfld ('dyn_area&BG', horiz_only, 'A', 'steradian', 'dynamics grid area' , gridname='GLL') +!jt call addfld ('phy_area&BG', horiz_only, 'A', 'steradian', 'physics grid area' , gridname='FVM') + call addfld ('dyn_area', horiz_only, 'A', 'steradian', 'dynamics grid area' , gridname='GLL') + call addfld ('phy_area', horiz_only, 'A', 'steradian', 'physics grid area' , gridname='FVM') +!!$ ! Create hbuf fields to weight global integrals +!!$ do ie=nets,nete +!!$ call outfld('dyn_area', dyn_area(:,ie), npsq, ie) +!!$ call outfld('phy_area', phy_area(:,ie), ncsq, ie) +!!$ end do + end subroutine budget_init !============================================================================================== @@ -943,6 +960,7 @@ subroutine budget_readnl(nlfile) else thermo_budgeting=.true. end if + ! Write out thermo_budget options if (masterproc) then if (trim(thermo_budget_averaging_option) == 'NSTEP' ) then @@ -975,8 +993,156 @@ subroutine budget_readnl(nlfile) end if end if - - end subroutine budget_readnl +!========================================================================================= + subroutine budget_update(pkgtype, mpi_comm_id) + +!!$ use shr_kind_mod, only: r8 => shr_kind_r8 +!!$ use shr_reprosum_mod, only: shr_reprosum_calc, shr_reprosum_tolExceeded +!!$ use shr_reprosum_mod, only: shr_reprosum_reldiffmax, shr_reprosum_recompute +!!$ use perf_mod, only: t_startf, t_stopf +!!$ use cam_logfile, only: iulog +!!$ use cam_thermo, only: thermo_budget_vars_massv +!!$ use cam_history_support, only: active_entry,ptapes +!!$ use cam_history, only: is_budgetfile +!!$ +!!$ ! arguments + character(len=3), intent(in) :: pkgtype + integer, intent(in) :: mpi_comm_id +!!$ +!!$ ! Local variables +!!$ integer :: s_ind,b_ind,n,ie,begdim3,enddim3,t +!!$ logical :: budget_outfld +!!$ +!!$ type (active_entry), pointer :: tape(:) => null() ! history tapes +!!$! real(r8) :: budgets_global(budget_num,thermo_budget_num_vars) +!!$! real(r8), allocatable, dimension(:,:,:) :: tmpgll,tmpfvm +!!$ real(r8),pointer :: hbuf0(:,:,:),hbuf1(:,:,:),hbuf2(:,:,:) ! history buffer +!!$ +!!$ !-------------------------------------------------------------------------------------- +!!$ call t_startf ('budget_update') +!!$ +!!$ if (thermo_budget_history) then +!!$ ! update energy budget differences +!!$ do t=1,ptapes +!!$ if(is_budgetfile(file_index=t)) then +!!$ do b_ind = 1,budget_num +! call budget_info(b_ind,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=s_ind) +!!$ if (budget_pkgtype(b_ind)==trim(pkgtype).and.(budget_optype(b_ind)=='dif'.or.budget_optype(b_ind)=='sum')) then +!!$ call get_field_properties(trim(budget_name(b_ind)), found, tape_out=tape, ff_out=ff0) +!!$ call get_field_properties(trim(budget_stg1name(b_ind)), found, tape_out=tape, ff_out=ff1) +!!$ call get_field_properties(trim(budget_stg2name(b_ind)), found, tape_out=tape, ff_out=ff2) +!!$ f0 = masterlist(ff0)%thisentry%htapeindx(t) +!!$ f1 = masterlist(ff1)%thisentry%htapeindx(t) +!!$ f2 = masterlist(ff2)%thisentry%htapeindx(t) +!!$ +!!$ call tape(t)%hlist(f0)%field%get_bounds(3, begdim3, enddim3) +!!$ ! call h_field_op(f0,f1,f2,tape(t),budget_optype(b_ind)) +!!$ hbuf0 => tape(t)%hlist(f0)%hbuf +!!$ hbuf1 => tape(t)%hlist(f1)%hbuf +!!$ hbuf2 => tape(t)%hlist(f2)%hbuf +!!$ do ie=begdim3,enddim3 +!!$ if (budget_optype(b_ind)=='dif') then +!!$ hbuf0(:,:,ie)=hbuf1(:,:,ie)-hbuf2(:,:,ie) +!!$ call outfld(trim(budget_name(b_ind)),hbuf0(:,:,ie),npsq,ie) +!!$ else if (budget_optype=='sum') then +!!$ hbuf0(:,:,ie)=hbuf1(:,:,ie)+hbuf2(:,:,ie) +!!$ call outfld(budget_name(b_ind),hbuf0(:,:,ie),npsq,ie) +!!$ else +!!$ call endrun('dyn_readnl: ERROR: budget_optype unknown:'//budget_optype) +!!$ end if +!!$ end do +!!$ end if +!!$ end do +!!$ end if +!!$ end do +!!$ end if +!!$ +!!$ ! update all dynamics energy budget globals +!!$ +!!$ allocate(tmpgll(np,np,nets:nete)) +!!$ if (ntrac>0) allocate(tmpfvm(nc,nc,nets:nete)) +!!$ +!!$ do b_ind=1,budget_num +!!$ call budget_info(b_ind,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=s_ind) +!!$ if (pkgtype(b_ind)=='dyn') then +!!$ do n=1,thermo_budget_num_vars +!!$ ! Normalize energy sums and convert to W/s +!!$ if (ntrac>0.and.thermo_budget_vars_massv(n)) then +!!$ tmpfvm=0._r8 +!!$ if (elem(nets)%derived%budget_cnt(b_ind).gt.0.) then +!!$ do ie=nets,nete +!!$ tmpfvm(:,:,ie)=fvm(ie)%budget(:,:,n,s_ind)/elem(ie)%derived%budget_cnt(b_ind) +!!$ enddo +!!$ end if +!!$ else +!!$ tmpgll=0._r8 +!!$ if (elem(nets)%derived%budget_cnt(b_ind).gt.0.) then +!!$ do ie=nets,nete +!!$ tmpgll(:,:,ie)=elem(ie)%derived%budget(:,:,n,s_ind)/elem(ie)%derived%budget_cnt(b_ind) +!!$ end do +!!$ end if +!!$ end if +!!$ +!!$ budgets_global(b_ind,n) = global_integral(fvm, hbuf(:,:,nets:nete),hybrid,nc,nets,nete) +!!$ +!!$ if (ntrac>0.and.thermo_budget_vars_massv(n)) then +!!$ budgets_global(b_ind,n) = global_integral(fvm, tmpfvm(:,:,nets:nete),hybrid,nc,nets,nete) +!!$ else +!!$ budgets_global(b_ind,n) = global_integral(elem, tmpgll(:,:,nets:nete),hybrid,np,nets,nete) +!!$ end if +!!$ +!!$ ! divide by time for proper units if not a mass budget. +!!$ if (.not.thermo_budget_vars_massv(n)) & +!!$ budgets_global(b_ind,n)=budgets_global(b_ind,n)/dtime +!!$ if (masterproc) then +!!$ if (ntrac>0.and.thermo_budget_vars_massv(n)) then +!!$ write(iulog,*)"putting global from fvm ",trim(budget_name)," m_cnst=",n," ",budgets_global(b_ind,n)," cnt/subcyc/sum_tmp=",elem(nets)%derived%budget_cnt(b_ind),elem(nets)%derived%budget_subcycle(b_ind),sum(tmpfvm(:,:,nets)) +!!$ else +!!$ write(iulog,*)"putting global from elem ",trim(budget_name)," m_cnst=",n," ",budgets_global(b_ind,n)," cnt/subcyc/sum_tmp=",elem(nets)%derived%budget_cnt(b_ind),elem(nets)%derived%budget_subcycle(b_ind),sum(tmpgll(:,:,nets)) +!!$ end if +!!$ call budget_put_global(trim(budget_name),n,budgets_global(b_ind,n)) +!!$ end if +!!$ end do +!!$ end if +!!$ end do +!!$ deallocate(tmpgll) +!!$ if (ntrac > 0) deallocate(tmpfvm) +!!$ +!!$ call t_stopf ('budget_update') + +end subroutine budget_update +!!$ !####################################################################### +!!$ +!!$ logical function is_budgetfile (file_index) +!!$ ! +!!$ !------------------------------------------------------------------------ +!!$ ! +!!$ ! Purpose: to determine: +!!$ ! +!!$ ! a) if an IC file is active in this model run at all +!!$ ! OR, +!!$ ! b) if it is active, is the current file index referencing the IC file +!!$ ! (IC file is always at ptapes) +!!$ ! +!!$ !------------------------------------------------------------------------ +!!$ ! +!!$ ! Arguments +!!$ ! +!!$ integer, intent(in), optional :: file_index ! index of file in question +!!$ +!!$ is_budgetfile = .false. +!!$ +!!$ if (present(file_index)) then +!!$!jt if (budgethist /= 'NONE' .and. file_index == ptapes) is_budgetfile = .true. +!!$ if (budgethist /= 'NONE' .and. file_index == thermo_budget_histfile_num) is_budgetfile = .true. +!!$ else +!!$ if (budgethist /= 'NONE' ) is_budgetfile = .true. +!!$ end if +!!$ +!!$ return +!!$ +!!$ end function is_budgetfile +!!$ end module budgets diff --git a/src/control/cam_control_mod.F90 b/src/control/cam_control_mod.F90 index 87306e5249..ce6b3deaad 100644 --- a/src/control/cam_control_mod.F90 +++ b/src/control/cam_control_mod.F90 @@ -10,7 +10,6 @@ module cam_control_mod use spmd_utils, only: masterproc use cam_logfile, only: iulog use cam_abortutils, only: endrun -use budgets, only: budget_init implicit none public diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 5b0e6f47f2..a033290466 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -1,4 +1,5 @@ module cam_history +#define HDEBUG TRUE !------------------------------------------------------------------------------------------- ! ! The cam_history module provides the user interface for CAM's history output capabilities. @@ -68,6 +69,12 @@ module cam_history public :: cam_history_snapshot_deactivate public :: cam_history_snapshot_activate + type grid_area_entry + integer :: decomp_type = -1 ! type of decomposition (e.g., physics or dynamics) + real(r8), allocatable :: gbuf(:,:,:) ! for area weights + end type grid_area_entry + type (grid_area_entry), target, allocatable:: grid_wts(:) ! area wts for each decomp type + type (grid_area_entry), pointer :: allgrids(:) ! area wts for each decomp type ! ! master_entry: elements of an entry in the master field list ! @@ -77,6 +84,9 @@ module cam_history character(len=max_fieldname_len) :: zonal_field = '' ! for vector fields character(len=1) :: avgflag(ptapes) ! averaging flag character(len=max_chars) :: time_op(ptapes) ! time operator (e.g. max, min, avg) + character(len=3) :: field_op = '' ! field derived from sum/dif of field1 and field2 + character(len=max_fieldname_len) :: op_field1 = '' ! first field name to be summed/diffed + character(len=max_fieldname_len) :: op_field2 = '' ! second field name to be summed/diffed logical :: act_sometape ! Field is active on some tape logical :: actflag(ptapes) ! Per tape active/inactive flag integer :: htapeindx(ptapes)! This field's index on particular history tape @@ -115,7 +125,7 @@ module cam_history ! ! The size of these parameters should match the assignments in restart_vars_setnames and restart_dims_setnames below ! - integer, parameter :: restartvarcnt = 38 + integer, parameter :: restartvarcnt = 41 integer, parameter :: restartdimcnt = 10 type(rvar_id) :: restartvars(restartvarcnt) type(rdim_id) :: restartdims(restartdimcnt) @@ -160,6 +170,8 @@ module cam_history character(len=16) :: host ! host name character(len=8) :: inithist = 'YEARLY' ! If set to '6-HOURLY, 'DAILY', 'MONTHLY' or ! 'YEARLY' then write IC file + character(len=8) :: budgethist = 'ENDOFRUN' ! If set to 'STEP, HOURLY, 'DAILY', 'MONTHLY' or + ! 'YEARLY', 'ENDOFRUN' then write budget file logical :: inithist_all = .false. ! Flag to indicate set of fields to be ! included on IC file ! .false. include only required fields @@ -169,6 +181,7 @@ module cam_history character(len=fieldname_lenp2) :: fexcl(pflds,ptapes) ! List of fields to rm from primary h-file character(len=fieldname_lenp2) :: fwrtpr(pflds,ptapes) ! List of fields to change default history output prec character(len=fieldname_suffix_len ) :: fieldname_suffix = '&IC' ! Suffix appended to field names for IC file + character(len=fieldname_suffix_len ) :: bfieldname_suffix = '&BG' ! Suffix appended to field names for IC file ! Parameters for interpolated output tapes logical, public :: interpolate_output(ptapes) = .false. @@ -178,7 +191,7 @@ module cam_history ! Allowed history averaging flags ! This should match namelist_definition.xml => avgflag_pertape (+ ' ') ! The presence of 'ABI' and 'XML' in this string is a coincidence - character(len=7), parameter :: HIST_AVG_FLAGS = ' ABIXML' + character(len=8), parameter :: HIST_AVG_FLAGS = ' ABCIXML' character(len=22) ,parameter :: LT_DESC = 'mean (over local time)' ! local time description logical :: collect_column_output(ptapes) @@ -305,6 +318,7 @@ module cam_history public :: nfils, mfilt ! Functions +!jt public :: is_budgetfile ! Check if htape is a budget history file public :: history_readnl ! Namelist reader for CAM history public :: init_restart_history ! Write restart history data public :: write_restart_history ! Write restart history data @@ -315,6 +329,7 @@ module cam_history public :: history_initialized ! .true. iff cam history initialized public :: wrapup ! process history files at end of run public :: write_inithist ! logical flag to allow dump of IC history buffer to IC file +!jt public :: write_budgethist ! logical flag to allow dump of budget history buffer to budget file public :: addfld ! Add a field to history file public :: add_default ! Add the default fields public :: register_vector_field ! Register vector field set for interpolated output @@ -323,7 +338,7 @@ module cam_history public :: get_hist_restart_filepath ! Return the full filepath to the history restart file public :: hist_fld_active ! Determine if a field is active on any history file public :: hist_fld_col_active ! Determine if a field is active on any history file at - ! each column in a chunk + CONTAINS @@ -349,6 +364,8 @@ subroutine intht (model_doi_url_in) use cam_control_mod, only: restart_run, branch_run use sat_hist, only: sat_hist_init use spmd_utils, only: mpicom, masterprocid, mpi_character + use cam_grid_support, only: cam_grid_get_area + use cam_history_support, only: dim_index_2d ! !----------------------------------------------------------------------- ! @@ -367,9 +384,15 @@ subroutine intht (model_doi_url_in) integer :: enddim3 ! on-node chunk or lat end index integer :: day, sec ! day and seconds from base date integer :: rcode ! shr_sys_getenv return code + integer :: wtidx(1) ! area weight index + integer :: i,k,c,ib,ie,jb,je,count ! index + integer :: fdecomp ! field decomp + type(dim_index_2d) :: dimind ! 2-D dimension index + real(r8), pointer :: area(:) ! pointer to area values for attribute type(master_entry), pointer :: listentry character(len=32) :: fldname ! temp variable used to produce a left justified field name ! in the formatted logfile output +!jt class(cam_grid_attribute_t), pointer :: attr ! ! Save the DOI @@ -460,18 +483,58 @@ subroutine intht (model_doi_url_in) enddim2 = tape(t)%hlist(f)%field%enddim2 begdim3 = tape(t)%hlist(f)%field%begdim3 enddim3 = tape(t)%hlist(f)%field%enddim3 + if (masterproc) write(6,*)'allocating hbuf for field num',f,' name:',trim(tape(t)%hlist(f)%field%name) allocate(tape(t)%hlist(f)%hbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) tape(t)%hlist(f)%hbuf = 0._r8 if (tape(t)%hlist(f)%avgflag .eq. 'S') then ! allocate the variance buffer for standard dev allocate(tape(t)%hlist(f)%sbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) tape(t)%hlist(f)%sbuf = 0._r8 endif + if (tape(t)%hlist(f)%avgflag .eq. 'C') then ! set up area weight buffer + fdecomp = tape(t)%hlist(f)%field%decomp_type + if (masterproc) write(6,*)'in avgflag = C field',f,' name:',trim(tape(t)%hlist(f)%field%name),'decomp=',fdecomp + if (any(allgrids(:)%decomp_type == fdecomp)) then + wtidx=MAXLOC(allgrids(:)%decomp_type, MASK = allgrids(:)%decomp_type .EQ. fdecomp) + if (masterproc) write(6,*)'found decomp in allgrids at index', wtidx + tape(t)%hlist(f)%gbuf => allgrids(wtidx(1))%gbuf + if (masterproc) write(6,*)'pointing allgrids gbuf to hlist gbuf' + else + ! area weights not found for this grid, then create them + wtidx=MINLOC(allgrids(:)%decomp_type) + allgrids(wtidx)%decomp_type=fdecomp + area => cam_grid_get_area(fdecomp) + write(6,*)'shape area:',shape(area),' size area:',size(area),'shape gbuf:',shape(allgrids(wtidx(1))%gbuf), & + ' size gbuf:',size(allgrids(wtidx(1))%gbuf) + allocate(allgrids(wtidx(1))%gbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) + count=0 + do c=begdim3,enddim3 + dimind = tape(t)%hlist(f)%field%get_dims(c) + ib=dimind%beg1 + ie=dimind%end1 + jb=dimind%beg2 + je=dimind%end2 + write(6,*)'dimind(',ib,':',ie,',',jb,':',je,',',c,')' + do k=jb,je + do i=ib,ie + count=count+1 + allgrids(wtidx(1))%gbuf(i,k,c)=area(count) + end do + end do + end do + tape(t)%hlist(f)%gbuf => allgrids(wtidx(1))%gbuf +!jt write(6,*)'didnt find decomp in allgrids allocating at index', wtidx(1),'area(1:20)=',area(1:20),'gbuf=',allgrids(wtidx(1))%gbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3),'hlist gbuf=',tape(t)%hlist(f)%gbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3) + write(6,*)'didnt find decomp in allgrids allocating at index', wtidx(1),'area(1:40)=',area(1:40) + endif + endif if(tape(t)%hlist(f)%field%flag_xyfill .or. (avgflag_pertape(t) .eq. 'L')) then allocate (tape(t)%hlist(f)%nacs(begdim1:enddim1,begdim3:enddim3)) + allocate (tape(t)%hlist(f)%nsteps(begdim1:enddim1,begdim3:enddim3)) else allocate (tape(t)%hlist(f)%nacs(1,begdim3:enddim3)) + allocate (tape(t)%hlist(f)%nsteps(1,begdim3:enddim3)) end if tape(t)%hlist(f)%nacs(:,:) = 0 + tape(t)%hlist(f)%nsteps(:,:) = 0 tape(t)%hlist(f)%field%meridional_complement = -1 tape(t)%hlist(f)%field%zonal_complement = -1 end do @@ -569,7 +632,7 @@ subroutine history_readnl(nlfile) fwrtpr1, fwrtpr2, fwrtpr3, fwrtpr4, fwrtpr5, & fwrtpr6, fwrtpr7, fwrtpr8, fwrtpr9, fwrtpr10, & interpolate_nlat, interpolate_nlon, & - interpolate_gridtype, interpolate_type, interpolate_output + interpolate_gridtype, interpolate_type, interpolate_output, budgethist ! Set namelist defaults (these should match initial values if given) fincl(:,:) = ' ' @@ -583,6 +646,7 @@ subroutine history_readnl(nlfile) nhtfrq(2:) = -24 mfilt = 30 inithist = 'YEARLY' + budgethist = 'NONE' inithist_all = .false. empty_htapes = .false. lcltod_start(:) = 0 @@ -712,6 +776,16 @@ subroutine history_readnl(nlfile) inithist = 'NONE' end if ! + ! If generate a thermo budget history file as an auxillary tape: + ! + ctemp = shr_string_toUpper(budgethist) + budgethist = trim(ctemp) + if ( (budgethist /= 'HOURLY') .and. (budgethist /= 'DAILY') .and. & + (budgethist /= 'MONTHLY') .and. (budgethist /= 'YEARLY') .and. & + (budgethist /= 'STEP') .and. (budgethist /= 'ENDOFRUN')) then + budgethist = 'NONE' + end if + ! ! History file write times ! Convert write freq. of hist files from hours to timesteps if necessary. ! @@ -784,6 +858,27 @@ subroutine history_readnl(nlfile) end if end if + ! Write out budgethist info + if (masterproc) then + if (budgethist == 'HOURLY' ) then + write(iulog,*)'Budget history files will be written hourly.' + else if (budgethist == 'STEP' ) then + write(iulog,*)'Budget history files will be written every time step.' + else if (budgethist == 'DAILY' ) then + write(iulog,*)'Budget history files will be written daily.' + else if (budgethist == 'MONTHLY' ) then + write(iulog,*)'Budget history files will be written monthly.' + else if (budgethist == 'YEARLY' ) then + write(iulog,*)'Budget history files will be written yearly.' + else if (budgethist == 'CAMIOP' ) then + write(iulog,*)'Budget history files will be written for IOP.' + else if (budgethist == 'ENDOFRUN' ) then + write(iulog,*)'Budget history files will be written at end of run.' + else + write(iulog,*)'Budget history files will not be created' + end if + end if + ! Print out column-output information do t = 1, size(fincllonlat, 2) if (ANY(len_trim(fincllonlat(:,t)) > 0)) then @@ -800,6 +895,7 @@ subroutine history_readnl(nlfile) call mpi_bcast(nhtfrq, ptapes, mpi_integer, masterprocid, mpicom, ierr) call mpi_bcast(mfilt, ptapes, mpi_integer, masterprocid, mpicom, ierr) call mpi_bcast(inithist,len(inithist), mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(budgethist,len(budgethist), mpi_character, masterprocid, mpicom, ierr) call mpi_bcast(inithist_all,1, mpi_logical, masterprocid, mpicom, ierr) call mpi_bcast(lcltod_start, ptapes, mpi_integer, masterprocid, mpicom, ierr) call mpi_bcast(lcltod_stop, ptapes, mpi_integer, masterprocid, mpicom, ierr) @@ -937,6 +1033,48 @@ subroutine setup_interpolation_and_define_vector_complements() end if end subroutine setup_interpolation_and_define_vector_complements + subroutine define_composed_field_ids(t) + + ! Dummy arguments + integer, intent(in) :: t ! Current tape + + ! Local variables + integer :: f, ff + character(len=max_fieldname_len) :: field1 + character(len=max_fieldname_len) :: field2 + character(len=*), parameter :: subname='define_composed_field_ids' + + do f = 1, nflds(t) + write(6,*)'tape:',t,'nflds:',nflds(t) + if (composed_field(trim(tape(t)%hlist(f)%field%name), & + field1, field2)) then + if (len_trim(field1) > 0 .and. len_trim(field2) > 0) then + ! find ids for field1/2 + do ff = 1, nflds(t) + if (trim(field1) == trim(tape(t)%hlist(ff)%field%name)) & + tape(t)%hlist(f)%field%op_field1_id = ff + if (trim(field2) == trim(tape(t)%hlist(ff)%field%name)) & + tape(t)%hlist(f)%field%op_field2_id = ff + end do + if (tape(t)%hlist(f)%field%op_field1_id == -1) & + call endrun(trim(subname)//': No op_field1 match for '//trim(tape(t)%hlist(f)%field%name)) + if (tape(t)%hlist(f)%field%op_field2_id == -1) & + call endrun(trim(subname)//': No op_field2 match for '//trim(tape(t)%hlist(f)%field%name)) + + write(iulog,'(a,i0,a)')'TAPE:',t,' composed fields' + write(iulog,'(a,a,a)')' field',trim(tape(t)%hlist(f)%field%name),' composed of ' + ff=tape(t)%hlist(f)%field%op_field1_id + write(iulog,'(a,a,a,i0)')' name=',trim(tape(t)%hlist(ff)%field%name),' field1_id:',ff + ff=tape(t)%hlist(f)%field%op_field2_id + write(iulog,'(a,a,a,i0)')' name=',trim(tape(t)%hlist(ff)%field%name),' field2_id:',ff + else + call endrun(trim(subname)//': Component fields not found for composed field') + end if + end if + end do + end subroutine define_composed_field_ids + + subroutine restart_vars_setnames() ! Local variable @@ -1217,6 +1355,32 @@ subroutine restart_vars_setnames() restartvars(rvindex)%fillset = .true. restartvars(rvindex)%ifill = 0 + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'field_op' + restartvars(rvindex)%type = pio_char + restartvars(rvindex)%ndims = 3 + restartvars(rvindex)%dims(1) = 3 + restartvars(rvindex)%dims(2) = maxnflds_dim_ind + restartvars(rvindex)%dims(3) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'op_field1_id' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%dims(1) = maxnflds_dim_ind + restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%fillset = .true. + restartvars(rvindex)%ifill = 0 + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'op_field2_id' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%dims(1) = maxnflds_dim_ind + restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%fillset = .true. + restartvars(rvindex)%ifill = 0 + end subroutine restart_vars_setnames subroutine restart_dims_setnames() @@ -1378,6 +1542,9 @@ subroutine write_restart_history ( File, & type(var_desc_t), pointer :: interpolate_nlon_desc type(var_desc_t), pointer :: meridional_complement_desc type(var_desc_t), pointer :: zonal_complement_desc + type(var_desc_t), pointer :: field_op_desc + type(var_desc_t), pointer :: op_field1_id_desc + type(var_desc_t), pointer :: op_field2_id_desc integer, allocatable :: allmdims(:,:,:) integer, allocatable :: xyfill(:,:) @@ -1497,6 +1664,10 @@ subroutine write_restart_history ( File, & meridional_complement_desc => restartvar_getdesc('meridional_complement') zonal_complement_desc => restartvar_getdesc('zonal_complement') + field_op_desc => restartvar_getdesc('field_op') + op_field1_id_desc => restartvar_getdesc('op_field1_id') + op_field2_id_desc => restartvar_getdesc('op_field2_id') + mdims_desc => restartvar_getdesc('mdims') mdimname_desc => restartvar_getdesc('mdimnames') fillval_desc => restartvar_getdesc('fillvalue') @@ -1528,6 +1699,9 @@ subroutine write_restart_history ( File, & ierr = pio_put_var(File, fillval_desc,start, tape(t)%hlist(f)%field%fillvalue) ierr = pio_put_var(File, meridional_complement_desc,start, tape(t)%hlist(f)%field%meridional_complement) ierr = pio_put_var(File, zonal_complement_desc,start, tape(t)%hlist(f)%field%zonal_complement) + ierr = pio_put_var(File, field_op_desc,start, tape(t)%hlist(f)%field%field_op) + ierr = pio_put_var(File, op_field1_id_desc,start, tape(t)%hlist(f)%field%op_field1_id) + ierr = pio_put_var(File, op_field2_id_desc,start, tape(t)%hlist(f)%field%op_field2_id) if(associated(tape(t)%hlist(f)%field%mdims)) then allmdims(1:size(tape(t)%hlist(f)%field%mdims),f,t) = tape(t)%hlist(f)%field%mdims else @@ -1620,7 +1794,8 @@ subroutine read_restart_history (File) character(len=max_string_len) :: locfn ! Local filename character(len=max_fieldname_len), allocatable :: tmpname(:,:) integer, allocatable :: decomp(:,:), tmpnumlev(:,:) - integer, pointer :: nacs(:,:) ! accumulation counter + integer, pointer :: nacs(:,:) ! outfld accumulation counter + integer, pointer :: nsteps(:,:) ! nstep accumulation counter character(len=max_fieldname_len) :: fname_tmp ! local copy of field name character(len=max_fieldname_len) :: dname_tmp ! local copy of dim name @@ -1635,12 +1810,16 @@ subroutine read_restart_history (File) type(var_desc_t) :: fillval_desc type(var_desc_t) :: meridional_complement_desc type(var_desc_t) :: zonal_complement_desc + type(var_desc_t) :: field_op_desc + type(var_desc_t) :: op_field1_id_desc + type(var_desc_t) :: op_field2_id_desc integer, allocatable :: tmpprec(:,:) integer, allocatable :: xyfill(:,:) integer, allocatable :: allmdims(:,:,:) integer, allocatable :: is_subcol(:,:) integer, allocatable :: interp_output(:) integer :: nacsdimcnt, nacsval + integer :: nstepsdimcnt, nstepsval integer :: maxnflds, dimid ! List of active grids (first dim) for each tape (second dim) @@ -1826,6 +2005,9 @@ subroutine read_restart_history (File) ierr = pio_inq_varid(File, 'fillvalue', fillval_desc) ierr = pio_inq_varid(File, 'meridional_complement', meridional_complement_desc) ierr = pio_inq_varid(File, 'zonal_complement', zonal_complement_desc) + ierr = pio_inq_varid(File, 'field_op', field_op_desc) + ierr = pio_inq_varid(File, 'op_field1_id', op_field1_id_desc) + ierr = pio_inq_varid(File, 'op_field2_id', op_field2_id_desc) rgnht(:)=.false. @@ -1851,6 +2033,9 @@ subroutine read_restart_history (File) ierr = pio_get_var(File,fillval_desc, (/f,t/), tape(t)%hlist(f)%field%fillvalue) ierr = pio_get_var(File,meridional_complement_desc, (/f,t/), tape(t)%hlist(f)%field%meridional_complement) ierr = pio_get_var(File,zonal_complement_desc, (/f,t/), tape(t)%hlist(f)%field%zonal_complement) + ierr = pio_get_var(File,field_op_desc, (/f,t/), tape(t)%hlist(f)%field%field_op) + ierr = pio_get_var(File,op_field1_id_desc, (/f,t/), tape(t)%hlist(f)%field%op_field1_id) + ierr = pio_get_var(File,op_field2_id_desc, (/f,t/), tape(t)%hlist(f)%field%op_field2_id) ierr = pio_get_var(File,avgflag_desc, (/f,t/), tape(t)%hlist(f)%avgflag) ierr = pio_get_var(File,longname_desc, (/1,f,t/), tape(t)%hlist(f)%field%long_name) ierr = pio_get_var(File,units_desc, (/1,f,t/), tape(t)%hlist(f)%field%units) @@ -1929,6 +2114,16 @@ subroutine read_restart_history (File) else allocate(tape(t)%hlist(f)%nacs(1,begdim3:enddim3)) end if + + if (associated(tape(t)%hlist(f)%nsteps)) then + deallocate(tape(t)%hlist(f)%nsteps) + end if + nullify(tape(t)%hlist(f)%nsteps) + if(tape(t)%hlist(f)%field%flag_xyfill .or. (avgflag_pertape(t)=='L')) then + allocate (tape(t)%hlist(f)%nsteps(begdim1:enddim1,begdim3:enddim3)) + else + allocate(tape(t)%hlist(f)%nsteps(1,begdim3:enddim3)) + end if ! initialize all buffers to zero - this will be overwritten later by the ! data in the history restart file if it exists. call h_zero(f,t) @@ -2050,6 +2245,24 @@ subroutine read_restart_history (File) tape(t)%hlist(f)%nacs(1,:)= nacsval end if + ierr = pio_inq_varid(tape(t)%File, trim(fname_tmp)//'_nacs', vdesc) + call cam_pio_var_info(tape(t)%File, vdesc, nacsdimcnt, dimids, dimlens) + + if(nstepsdimcnt > 0) then + if (nfdims > 2) then + ! nsteps only has 2 dims (no levels) + fdims(2) = fdims(3) + end if + allocate(tape(t)%hlist(f)%nsteps(begdim1:enddim1,begdim3:enddim3)) + nsteps => tape(t)%hlist(f)%nsteps(:,:) + call cam_grid_read_dist_array(tape(t)%File, fdecomp, fdims(1:2), & + dimlens(1:nstepsdimcnt), nsteps, vdesc) + else + allocate(tape(t)%hlist(f)%nsteps(1,begdim3:enddim3)) + ierr = pio_get_var(tape(t)%File, vdesc, nstepsval) + tape(t)%hlist(f)%nsteps(1,:)= nstepsval + end if + end do ! ! Done reading this history restart file @@ -2088,6 +2301,10 @@ subroutine read_restart_history (File) ! Initialize filename specifier for IC file hfilename_spec(t) = '%c.cam' // trim(inst_suffix) // '.i.%y-%m-%d-%s.nc' nfils(t) = 0 +!!$ else if (is_budgetfile(file_index=t)) then +!!$ ! Initialize filename specifier for budget file +!!$ hfilename_spec(t) = '%c.cam' // trim(inst_suffix) // '.b.%y-%m-%d-%s.nc' +!!$ nfils(t) = 0 else if (nflds(t) == 0) then nfils(t) = 0 else @@ -2121,6 +2338,9 @@ subroutine read_restart_history (File) ! Setup vector pairs for unstructured grid interpolation call setup_interpolation_and_define_vector_complements() +!jt ! Initialize fields ids of fields that are composed of 2 other existing fields +!jt call define_composed_field_ids() + if(mtapes/=ptapes .and. masterproc) then write(iulog,*) ' WARNING: Restart file ptapes setting ',mtapes,' not equal to model setting ',ptapes end if @@ -2210,6 +2430,8 @@ subroutine AvgflagToString(avgflag, time_op) time_op(:) = 'mean' case ('B') time_op(:) = 'mean00z' + case ('C') + time_op(:) = 'mean_over_nsteps' case ('I') time_op(:) = ' ' case ('X') @@ -2429,7 +2651,17 @@ subroutine fldlst () mfilt (ptapes) = 1 end if +!!$ if(is_budgetfile()) then +!!$ hfilename_spec(ptapes) = '%c.cam' // trim(inst_suffix) // '.b.%y-%m-%d-%s.nc' +!!$ +!!$ ncprec(ptapes) = pio_double +!!$ ndens (ptapes) = 1 +!!$ mfilt (ptapes) = 1 +!!$ end if + + allocate(grid_wts(cam_grid_num_grids() + 1)) + allgrids => grid_wts allocate(gridsontape(cam_grid_num_grids() + 1, ptapes)) gridsontape = -1 @@ -2449,6 +2681,7 @@ subroutine fldlst () fieldontape = .false. if (ff > 0) then fieldontape = .true. +!jt else if ((.not. empty_htapes) .or. (is_initfile(file_index=t)) .or. (is_budgetfile(file_index=t))) then else if ((.not. empty_htapes) .or. (is_initfile(file_index=t))) then call list_index (fexcl(1,t), mastername, ff) if (ff == 0 .and. listentry%actflag(t)) then @@ -2511,6 +2744,7 @@ subroutine fldlst () nullify(tape(t)%hlist(ff)%hbuf) nullify(tape(t)%hlist(ff)%sbuf) nullify(tape(t)%hlist(ff)%nacs) + nullify(tape(t)%hlist(ff)%nsteps) nullify(tape(t)%hlist(ff)%varid) end do @@ -2532,6 +2766,7 @@ subroutine fldlst () if (ff > 0) then avgflag = getflag (fincl(ff,t)) call inifld (t, listentry, avgflag, prec_wrt) +!jt else if ((.not. empty_htapes) .or. (is_initfile(file_index=t)) .or. (is_budgetfile(file_index=t))) then else if ((.not. empty_htapes) .or. (is_initfile(file_index=t))) then call list_index (fexcl(1,t), mastername, ff) if (ff == 0 .and. listentry%actflag(t)) then @@ -2555,6 +2790,10 @@ subroutine fldlst () else call patch_init(t) end if + + ! Initialize the field ids for each composed field on tapes + call define_composed_field_ids(t) + ! ! Specification of tape contents now complete. Sort each list of active ! entries for efficiency in OUTFLD. Simple bubble sort. @@ -2633,6 +2872,8 @@ subroutine print_active_fldlst() if (is_initfile(file_index=t)) then write(iulog,*) ' Write frequency: ',inithist,' (INITIAL CONDITIONS)' +!!$ else if (is_budgetfile(file_index=t)) then +!!$ write(iulog,*) ' Write frequency: ',budgethist,' (MASS/ENERGY BUDGETS)' else if (nhtfrq(t) == 0) then write(iulog,*) ' Write frequency: MONTHLY' @@ -2786,6 +3027,7 @@ subroutine inifld (t, listentry, avgflag, prec_wrt) end if end if + #ifdef HDEBUG if (masterproc) then write(iulog,'(a,i0,3a,i0,a,i2)')'HDEBUG: ',__LINE__,' field ', & @@ -2796,6 +3038,7 @@ subroutine inifld (t, listentry, avgflag, prec_wrt) write(iulog,'(2a)')' avgflag = ',tape(t)%hlist(n)%avgflag write(iulog,'(3a)')' time_op = "',trim(tape(t)%hlist(n)%time_op),'"' write(iulog,'(a,i0)')' hwrt_prec = ',tape(t)%hlist(n)%hwrt_prec + write(iulog,'(a,a)')' field_op = ',tape(t)%hlist(n)%field%field_op end if #endif @@ -2941,6 +3184,7 @@ character(len=max_fieldname_len) function strip_suffix (name) strip_suffix(n:n) = name(n:n) if(name(n+1:n+1 ) == ' ' ) return if(name(n+1:n+fieldname_suffix_len) == fieldname_suffix) return + if(name(n+1:n+fieldname_suffix_len) == bfieldname_suffix) return end do strip_suffix(fieldname_len+1:max_fieldname_len) = name(fieldname_len+1:max_fieldname_len) @@ -3224,7 +3468,7 @@ end subroutine list_index recursive subroutine outfld (fname, field, idim, c, avg_subcol_field) use cam_history_buffers, only: hbuf_accum_inst, hbuf_accum_add, hbuf_accum_variance, & hbuf_accum_add00z, hbuf_accum_max, hbuf_accum_min, & - hbuf_accum_addlcltime + hbuf_accum_addlcltime, hbuf_accum_addnsteps use cam_history_support, only: dim_index_2d use subcol_pack_mod, only: subcol_unpack use cam_grid_support, only: cam_grid_id @@ -3283,8 +3527,10 @@ end subroutine subcol_field_avg_handler type (active_entry), pointer :: otape(:) ! Local history_tape pointer real(r8),pointer :: hbuf(:,:) ! history buffer + real(r8),pointer :: gbuf(:,:) ! area weights for field real(r8),pointer :: sbuf(:,:) ! variance buffer integer, pointer :: nacs(:) ! accumulation counter + integer, pointer :: nsteps(:) ! nstep accumulation counter integer :: begdim2, enddim2, endi integer :: phys_decomp type (dim_index_2d) :: dimind ! 2-D dimension index @@ -3321,7 +3567,11 @@ end subroutine subcol_field_avg_handler fillvalue = otape(t)%hlist(f)%field%fillvalue avgflag = otape(t)%hlist(f)%avgflag nacs => otape(t)%hlist(f)%nacs(:,c) + nsteps => otape(t)%hlist(f)%nsteps(:,c) hbuf => otape(t)%hlist(f)%hbuf(:,:,c) + if (associated(tape(t)%hlist(f)%gbuf)) then + gbuf => otape(t)%hlist(f)%gbuf(:,:,c) + endif if (associated(tape(t)%hlist(f)%sbuf)) then sbuf => otape(t)%hlist(f)%sbuf(:,:,c) endif @@ -3395,6 +3645,10 @@ end subroutine subcol_field_avg_handler call hbuf_accum_add00z(hbuf, ufield, nacs, dimind, pcols, & flag_xyfill, fillvalue) + case ('C') ! Time average over nsteps + call hbuf_accum_addnsteps(hbuf, ufield, nacs, dimind, pcols, & + flag_xyfill, fillvalue, nsteps) + case ('X') ! Maximum over time call hbuf_accum_max (hbuf, ufield, nacs, dimind, pcols, & flag_xyfill, fillvalue) @@ -3433,6 +3687,10 @@ end subroutine subcol_field_avg_handler call hbuf_accum_add00z(hbuf, field, nacs, dimind, idim, & flag_xyfill, fillvalue) + case ('C') ! Time average over nsteps + call hbuf_accum_addnsteps (hbuf, field, nacs, dimind, idim, & + flag_xyfill, fillvalue, nsteps) + case ('X') ! Maximum over time call hbuf_accum_max (hbuf, field, nacs, dimind, idim, & flag_xyfill, fillvalue) @@ -3661,8 +3919,9 @@ subroutine h_inquire (t) ierr=pio_inq_varid (tape(t)%File,'tsec ',tape(t)%tsecid) ierr=pio_inq_varid (tape(t)%File,'bdate ',tape(t)%bdateid) #endif - if (.not. is_initfile(file_index=t) ) then - ! Don't write the GHG/Solar forcing data to the IC file. It is never +!jt if (.not. is_initfile(file_index=t).and. .not. is_budgetfile(file_index=t)) then + if (.not. is_initfile(file_index=t)) then + ! Don't write the GHG/Solar forcing data to the IC or budget files. It is never ! read from that file so it's confusing to have it there. ierr=pio_inq_varid (tape(t)%File,'co2vmr ', tape(t)%co2vmrid) ierr=pio_inq_varid (tape(t)%File,'ch4vmr ', tape(t)%ch4vmrid) @@ -3786,6 +4045,7 @@ subroutine add_default (name, tindex, flag) ! Add to IC file if tindex = 0, reset to ptapes if (tindex == 0) then t = ptapes +!jt if ( .not. is_initfile(file_index=t) .and. .not. is_budgetfile(file_index=t) ) return if ( .not. is_initfile(file_index=t) ) return else t = tindex @@ -3904,6 +4164,7 @@ subroutine h_define (t, restart) integer :: chardim ! character dimension id integer :: dimenchar(2) ! character dimension ids integer :: nacsdims(2) ! dimension ids for nacs (used in restart file) + integer :: nstepsdims(2) ! dimension ids for nsteps (used in restart file) integer :: bnddim ! bounds dimension id integer :: timdim ! unlimited dimension id @@ -4148,8 +4409,9 @@ subroutine h_define (t, restart) ierr=pio_put_att (tape(t)%File, tape(t)%nscurid, 'long_name', trim(str)) +!jt if (.not. is_initfile(file_index=t) .and. .not. is_budgetfile(file_index=t)) then if (.not. is_initfile(file_index=t)) then - ! Don't write the GHG/Solar forcing data to the IC file. + ! Don't write the GHG/Solar forcing data to the IC or budget file. ierr=pio_def_var (tape(t)%File,'co2vmr ',pio_double,(/timdim/),tape(t)%co2vmrid) str = 'co2 volume mixing ratio' ierr=pio_put_att (tape(t)%File, tape(t)%co2vmrid, 'long_name', trim(str)) @@ -4303,6 +4565,7 @@ subroutine h_define (t, restart) do i = 1, num_hdims dimindex(i) = header_info(1)%get_hdimid(i) nacsdims(i) = header_info(1)%get_hdimid(i) + nstepsdims(i) = header_info(1)%get_hdimid(i) end do else if (patch_output) then ! All patches for this variable should be on the same grid @@ -4329,6 +4592,7 @@ subroutine h_define (t, restart) do i = 1, num_hdims dimindex(i) = header_info(grd)%get_hdimid(i) nacsdims(i) = header_info(grd)%get_hdimid(i) + nstepsdims(i) = header_info(grd)%get_hdimid(i) end do end if ! is_satfile @@ -4449,7 +4713,7 @@ subroutine h_define (t, restart) end if if (restart) then - ! For restart history files, we need to save accumulation counts + ! For restart history files, we need to save accumulation counts and nsteps fname_tmp = trim(fname_tmp)//'_nacs' if (.not. associated(tape(t)%hlist(f)%nacs_varid)) then allocate(tape(t)%hlist(f)%nacs_varid) @@ -4462,6 +4726,20 @@ subroutine h_define (t, restart) call cam_pio_def_var(tape(t)%File, trim(fname_tmp), pio_int, & tape(t)%hlist(f)%nacs_varid) end if + fname_tmp = trim(fname_tmp)//'_nsteps' + if (.not. associated(tape(t)%hlist(f)%nsteps_varid)) then + allocate(tape(t)%hlist(f)%nsteps_varid) + end if + if (size(tape(t)%hlist(f)%nsteps, 1) > 1) then + call cam_pio_def_var(tape(t)%File, trim(fname_tmp), pio_int, & + nstepsdims(1:num_hdims), tape(t)%hlist(f)%nsteps_varid) + else + ! Save just one value representing all chunks + call cam_pio_def_var(tape(t)%File, trim(fname_tmp), pio_int, & + tape(t)%hlist(f)%nsteps_varid) + end if + + ! for standard deviation if (associated(tape(t)%hlist(f)%sbuf)) then fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) @@ -4620,6 +4898,23 @@ subroutine h_normalize (f, t) end do end if end if + if (avgflag == 'C') then + if (size(tape(t)%hlist(f)%nsteps, 1) > 1) then + do k = jb, je + where (tape(t)%hlist(f)%nsteps(ib:ie,c) /= 0) + tape(t)%hlist(f)%hbuf(ib:ie,k,c) = & + tape(t)%hlist(f)%hbuf(ib:ie,k,c) & + / tape(t)%hlist(f)%nsteps(ib:ie,c) + endwhere + end do + else if(tape(t)%hlist(f)%nsteps(1,c) > 0) then + do k=jb,je + tape(t)%hlist(f)%hbuf(ib:ie,k,c) = & + tape(t)%hlist(f)%hbuf(ib:ie,k,c) & + / tape(t)%hlist(f)%nsteps(1,c) + end do + end if + end if if (avgflag == 'S') then ! standard deviation ... ! from http://www.johndcook.com/blog/standard_deviation/ @@ -4678,6 +4973,7 @@ subroutine h_zero (f, t) end if end do tape(t)%hlist(f)%nacs(:,:) = 0 + tape(t)%hlist(f)%nsteps(:,:) = 0 call t_stopf ('h_zero') @@ -4686,6 +4982,163 @@ end subroutine h_zero !####################################################################### + subroutine h_global (f, t) + + use cam_history_support, only: dim_index_2d + use shr_reprosum_mod, only: shr_reprosum_calc + use spmd_utils, only: mpicom + use shr_const_mod, only: PI => SHR_CONST_PI + ! + !----------------------------------------------------------------------- + ! + ! Purpose: compute globals of field + ! + ! Method: Loop through fields on the tape + ! + !----------------------------------------------------------------------- + ! + integer, intent(in) :: f ! field index + integer, intent(in) :: t ! tape index + ! + ! Local workspace + ! + type (dim_index_2d) :: dimind ! 2-D dimension index + integer :: ie ! dim3 index + integer :: count ! + integer :: i1 ! + integer :: comm_id! + integer :: begdim1,enddim1,begdim2,enddim2,begdim3,enddim3 ! + real(r8) :: globalsum(1) ! globalsum + real(r8), allocatable :: globalarr(:) ! globalarr values for this pe + + + + call t_startf ('h_global') + if (masterproc) write(6,*)'h_global: field num:',f,'tape:',t,' name:',trim(tape(t)%hlist(f)%field%name),' gbuf associated?',associated(tape(t)%hlist(f)%gbuf) + if (associated(tape(t)%hlist(f)%gbuf) ) then + + begdim1 = tape(t)%hlist(f)%field%begdim1 + enddim1 = tape(t)%hlist(f)%field%enddim1 + begdim2 = tape(t)%hlist(f)%field%begdim2 + enddim2 = tape(t)%hlist(f)%field%enddim2 + begdim3 = tape(t)%hlist(f)%field%begdim3 + enddim3 = tape(t)%hlist(f)%field%enddim3 + + allocate(globalarr((enddim1-begdim1+1)*(enddim2-begdim2+1)*(enddim3-begdim3+1))) + count=0 + globalarr=0._r8 + do ie = begdim3, enddim3 + dimind = tape(t)%hlist(f)%field%get_dims(ie) +!jt write(6,*)'t,f,begdim1,beg1,enddim1,end1=',t,f,begdim1,dimind%beg1,enddim1,dimind%end1 + write(6,*)'h_global:field:',trim(tape(t)%hlist(f)%field%name),'gbuf(',dimind%beg1,':',dimind%end1,',1,',ie,')=',tape(t)%hlist(f)%gbuf(dimind%beg1:dimind%end1,1,ie),'hbbuf(',dimind%beg1,':',dimind%end1,',1,',ie,')=',tape(t)%hlist(f)%hbuf(dimind%beg1:dimind%end1,1,ie) + do i1 = dimind%beg1, dimind%end1 +!jt do i1 = begdim1, enddim1 + count=count+1 + globalarr(count)=globalarr(count)+tape(t)%hlist(f)%hbuf(i1,1,ie)*tape(t)%hlist(f)%gbuf(i1,1,ie) + end do + end do + ! call fixed-point algorithm + call shr_reprosum_calc (globalarr, globalsum, count, count, 1, commid=mpicom) + if (masterproc) write(6,*)'h_global:field:',trim(tape(t)%hlist(f)%field%name),'global integral=',globalsum/(4.0_r8*PI) + +!!$ call repro_sum(globarr, globsum, nsize_use, nelemd, nflds(t), commid=comm_id) +!!$ h(npts,npts,num_flds,nets:nete) +!!$ da = grid area wgt organized by hbuf dims ie all local cols from begdim3:enddim3 +!!$ global_integrals_general(h,comm_id,npts,da,nflds(t),begdim3,enddim3,I_sphere) +!!$ +!!$ +!!$!JMD print *,'global_integral: before loop' +!!$ do ie=dimind%beg3:dimind%end3 +!!$ do q=1,num_flds +!!$ do j=1,begnpts +!!$ do i=1,npts +!!$ J_tmp(ie,q) = J_tmp(ie,q) + da(i,j,ie)*h(i,j,q,ie) +!!$ end do +!!$ end do +!!$ end do +!!$ end do +!!$ do ie=nets,nete +!!$ global_shared_buf(ie,1:num_flds) = J_tmp(ie,:) +!!$ enddo +!!$ !JMD print *,'global_integral: before wrap_repro_sum' +!!$ call wrap_repro_sum(nvars=num_flds, comm=hybrid%par%comm) +!!$ !JMD print *,'global_integral: after wrap_repro_sum' +!!$ I_sphere(:) =global_shared_sum(1:num_flds) /(4.0_r8*PI) +!!$ + + end if + call t_stopf ('h_global') + return + end subroutine h_global + + subroutine h_field_op (f, t) + use cam_history_support, only: dim_index_2d + ! + !----------------------------------------------------------------------- + ! + ! Purpose: run field sum/dif opperation on all contructed fields + ! + ! Method: Loop through fields on the tape + ! + !----------------------------------------------------------------------- + ! + integer, intent(in) :: f ! field index + integer, intent(in) :: t ! tape index +!jt character(len=*), intent(in) :: op ! field operation currently only sum/diff + ! + ! Local workspace + ! + type (dim_index_2d) :: dimind ! 2-D dimension index + integer :: c ! chunk index + integer, pointer :: f1,f2 ! fields to be operated on + integer :: begdim1, begdim2, begdim3 ! on-node chunk or lat start index + integer :: enddim1, enddim2, enddim3 ! on-node chunk or lat end index + character(len=3) :: op ! field operation currently only sum/diff + + call t_startf ('h_field_op') + begdim1 = tape(t)%hlist(f)%field%begdim1 + enddim1 = tape(t)%hlist(f)%field%enddim1 + begdim2 = tape(t)%hlist(f)%field%begdim2 + enddim2 = tape(t)%hlist(f)%field%enddim2 + begdim3 = tape(t)%hlist(f)%field%begdim3 + enddim3 = tape(t)%hlist(f)%field%enddim3 + + call tape(t)%hlist(f)%field%get_bounds(3, begdim3, enddim3) + f1 => tape(t)%hlist(f)%field%op_field1_id + f2 => tape(t)%hlist(f)%field%op_field2_id + op = tape(t)%hlist(f)%field%field_op + call tape(t)%hlist(f)%field%get_bounds(3, begdim3, enddim3) + do c = begdim3, enddim3 + dimind = tape(t)%hlist(f)%field%get_dims(c) + if (op == 'dif') then + tape(t)%hlist(f)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) = & + tape(t)%hlist(f1)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) - & + tape(t)%hlist(f2)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) + else if (op == 'sum') then + tape(t)%hlist(f)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) = & + tape(t)%hlist(f1)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) - & + tape(t)%hlist(f2)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) + else + call endrun('dyn_readnl: ERROR: budget_optype unknown:'//trim(op)) + end if + end do + ! Set nsteps for composed fields using value of one of the component fields + tape(t)%hlist(f)%nsteps(:,:)=tape(t)%hlist(f1)%nsteps(:,:) + tape(t)%hlist(f)%nacs(:,:)=tape(t)%hlist(f1)%nacs(:,:) + call t_stopf ('h_field_op') + + if (masterproc) write(6,*)'h_field_op:field,f1name,f2name,op,f1,f1id,f2,f2id,nsteps,nacs,sumhbuf1,sumhbuf2=', & + trim(tape(t)%hlist(f)%field%name),trim(tape(t)%hlist(f1)%field%name),trim(tape(t)%hlist(f2)%field%name),op, & + f1,tape(t)%hlist(f)%field%op_field1_id,f2,tape(t)%hlist(f)%field%op_field2_id, & + tape(t)%hlist(f)%nsteps(begdim1,begdim3),tape(t)%hlist(f)%nacs(begdim1,begdim3), & + sum(tape(t)%hlist(f1)%hbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)), & + sum(tape(t)%hlist(f2)%hbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) + + return + end subroutine h_field_op + + !####################################################################### + subroutine dump_field (f, t, restart) use cam_history_support, only: history_patch_t, dim_index_2d, dim_index_3d use cam_grid_support, only: cam_grid_write_dist_array, cam_grid_dimensions @@ -4710,6 +5163,7 @@ subroutine dump_field (f, t, restart) integer :: fdims(8) ! Field file dim sizes integer :: frank ! Field file rank integer :: nacsrank ! Field file rank for nacs + integer :: nstepsrank ! Field file rank for nsteps type(dim_index_2d) :: dimind2 ! 2-D dimension index type(dim_index_3d) :: dimind ! 3-D dimension index integer :: adims(3) ! Field array dim sizes @@ -4878,6 +5332,22 @@ subroutine dump_field (f, t, restart) ierr = pio_put_var(tape(t)%File, tape(t)%hlist(f)%nacs_varid, & tape(t)%hlist(f)%nacs(:, bdim3:edim3)) end if + !! NSTEPS + if (size(tape(t)%hlist(f)%nsteps, 1) > 1) then + if (nadims > 2) then + adims(2) = adims(3) + nadims = 2 + end if + call cam_grid_dimensions(fdecomp, fdims(1:2), nstepsrank) + call cam_grid_write_dist_array(tape(t)%File, fdecomp, & + adims(1:nadims), fdims(1:nstepsrank), & + tape(t)%hlist(f)%nsteps, tape(t)%hlist(f)%nsteps_varid) + else + bdim3 = tape(t)%hlist(f)%field%begdim3 + edim3 = tape(t)%hlist(f)%field%enddim3 + ierr = pio_put_var(tape(t)%File, tape(t)%hlist(f)%nsteps_varid, & + tape(t)%hlist(f)%nsteps(:, bdim3:edim3)) + end if end if return @@ -4934,6 +5404,57 @@ end function write_inithist !####################################################################### + !####################################################################### + + logical function write_budgethist () + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Set flags that will initiate dump to BUDGET file when OUTFLD and + ! WSHIST are called + ! + !----------------------------------------------------------------------- + ! + use time_manager, only: get_nstep, get_curr_date, get_step_size, is_last_step + ! + ! Local workspace + ! + integer :: yr, mon, day ! year, month, and day components of + ! a date + integer :: nstep ! current timestep number + integer :: ncsec ! current time of day [seconds] + integer :: dtime ! timestep size + + !----------------------------------------------------------------------- + + write_budgethist = .false. + +!jt if(is_budgetfile()) then + + nstep = get_nstep() + call get_curr_date(yr, mon, day, ncsec) + + if(budgethist == 'STEP' ) then + write_budgethist = nstep /= 0 + elseif (budgethist == 'HOURLY') then + dtime = get_step_size() + write_budgethist = nstep /= 0 .and. mod( nstep, nint((3600._r8)/dtime) ) == 0 + elseif(budgethist == 'DAILY' ) then + write_budgethist = nstep /= 0 .and. ncsec == 0 + elseif(budgethist == 'MONTHLY' ) then + write_budgethist = nstep /= 0 .and. ncsec == 0 .and. day == 1 + elseif(budgethist == 'YEARLY' ) then + write_budgethist = nstep /= 0 .and. ncsec == 0 .and. day == 1 .and. mon == 1 + elseif(budgethist == 'ENDOFRUN' ) then + write_budgethist = nstep /= 0 .and. is_last_step() + end if +!jt end if + + return + end function write_budgethist + + !####################################################################### + subroutine wshist (rgnht_in) ! !----------------------------------------------------------------------- @@ -4949,6 +5470,7 @@ subroutine wshist (rgnht_in) use interp_mod, only: set_interp_hfile use datetime_mod, only: datetime use cam_pio_utils, only: cam_pio_closefile + use spmd_utils, only: mpicom logical, intent(in), optional :: rgnht_in(ptapes) ! @@ -5012,6 +5534,9 @@ subroutine wshist (rgnht_in) if( is_initfile(file_index=t) ) then hstwr(t) = write_inithist() prev = .false. +!!$ else if( is_budgetfile(file_index=t) ) then +!!$ hstwr(t) = write_budgethist() +!!$ prev = .false. else if (nhtfrq(t) == 0) then hstwr(t) = nstep /= 0 .and. day == 1 .and. ncsec == 0 @@ -5028,6 +5553,10 @@ subroutine wshist (rgnht_in) write(iulog,100) yr,mon,day,ncsec 100 format('WSHIST: writing time sample to Initial Conditions h-file', & ' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) +!!$ else if(is_budgetfile(file_index=t)) then +!!$ write(iulog,125) yr,mon,day,ncsec +!!$125 format('WSHIST: writing time sample to Budget h-file', & +!!$ ' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) else if(is_satfile(t)) then write(iulog,150) nfils(t),t,yr,mon,day,ncsec 150 format('WSHIST: writing sat columns ',i6,' to h-file ', & @@ -5053,6 +5582,8 @@ subroutine wshist (rgnht_in) hrestpath(t)=fname else if(is_initfile(file_index=t)) then fname = interpret_filename_spec( hfilename_spec(t) ) +!!$ else if(is_budgetfile(file_index=t)) then +!!$ fname = interpret_filename_spec( hfilename_spec(t) ) else fname = interpret_filename_spec( hfilename_spec(t), number=(t-1), & prev=prev ) @@ -5099,8 +5630,9 @@ subroutine wshist (rgnht_in) ierr = pio_put_var (tape(t)%File, tape(t)%nscurid,(/start/), (/count1/),(/nscur/)) ierr = pio_put_var (tape(t)%File, tape(t)%dateid,(/start/), (/count1/),(/ncdate/)) +!jt if (.not. is_initfile(file_index=t) .and. .not. is_budgetfile(file_index=t)) then if (.not. is_initfile(file_index=t)) then - ! Don't write the GHG/Solar forcing data to the IC file. + ! Don't write the GHG/Solar forcing data to the IC or budget file. ierr=pio_put_var (tape(t)%File, tape(t)%co2vmrid,(/start/), (/count1/),(/chem_surfvals_co2_rad(vmr_in=.true.)/)) ierr=pio_put_var (tape(t)%File, tape(t)%ch4vmrid,(/start/), (/count1/),(/chem_surfvals_get('CH4VMR')/)) ierr=pio_put_var (tape(t)%File, tape(t)%n2ovmrid,(/start/), (/count1/),(/chem_surfvals_get('N2OVMR')/)) @@ -5160,6 +5692,10 @@ subroutine wshist (rgnht_in) if(.not. restart) then !$OMP PARALLEL DO PRIVATE (F) do f=1,nflds(t) + ! First compose field if needed + if (tape(t)%hlist(f)%field%is_composed()) then + call h_field_op (f, t) + end if ! Normalized averaged fields if (tape(t)%hlist(f)%avgflag /= 'I') then call h_normalize (f, t) @@ -5174,12 +5710,17 @@ subroutine wshist (rgnht_in) call dump_field(f, t, restart) end do call t_stopf ('dump_field') + ! + ! If this is a budget field calculate globals and write out energy budget + ! +!jt if (is_budgetfile(file_index=t)) then + do f=1,nflds(t) + call h_global(f, t) + end do +!jt end if ! ! Zero history buffers and accumulators now that the fields have been written. ! - - - if(restart) then do f=1,nflds(t) if(associated(tape(t)%hlist(f)%varid)) then @@ -5205,7 +5746,8 @@ end subroutine wshist !####################################################################### subroutine addfld_1d(fname, vdim_name, avgflag, units, long_name, & - gridname, flag_xyfill, sampling_seq, standard_name, fill_value) + gridname, flag_xyfill, sampling_seq, standard_name, fill_value, & + op, op_f1name, op_f2name) ! !----------------------------------------------------------------------- @@ -5234,6 +5776,9 @@ subroutine addfld_1d(fname, vdim_name, avgflag, units, long_name, & ! every other; only during LW/SW radiation calcs, etc. character(len=*), intent(in), optional :: standard_name ! CF standard name (max_chars) real(r8), intent(in), optional :: fill_value + character(len=*), intent(in), optional :: op ! currently 'dif'/'sum' supported dif ex fname = op_f1name - op_f2name + character(len=*), intent(in), optional :: op_f1name ! first field to be operated on + character(len=*), intent(in), optional :: op_f2name ! second field which is subtracted from or added to first field ! ! Local workspace @@ -5252,12 +5797,14 @@ subroutine addfld_1d(fname, vdim_name, avgflag, units, long_name, & dimnames(1) = trim(vdim_name) end if call addfld(fname, dimnames, avgflag, units, long_name, gridname, & - flag_xyfill, sampling_seq, standard_name, fill_value) + flag_xyfill, sampling_seq, standard_name, fill_value, op, op_f1name, & + op_f2name) end subroutine addfld_1d subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & - gridname, flag_xyfill, sampling_seq, standard_name, fill_value) + gridname, flag_xyfill, sampling_seq, standard_name, fill_value, op, & + op_f1name, op_f2name) ! !----------------------------------------------------------------------- @@ -5290,6 +5837,9 @@ subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & ! every other; only during LW/SW radiation calcs, etc. character(len=*), intent(in), optional :: standard_name ! CF standard name (max_chars) real(r8), intent(in), optional :: fill_value + character(len=*), intent(in), optional :: op ! currently 'dif'/'sum' supported dif ex fname = op_f1name - op_f2name + character(len=*), intent(in), optional :: op_f1name ! first field to be operated on + character(len=*), intent(in), optional :: op_f2name ! second field which is subtracted from or added to first field ! ! Local workspace @@ -5299,10 +5849,13 @@ subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & character(len=128) :: errormsg character(len=3) :: mixing_ratio type(master_entry), pointer :: listentry + type(master_entry), pointer :: f1listentry,f2listentry integer :: dimcnt integer :: idx + character(len=*), parameter :: subname='ADDFLD_ND' + if (htapes_defined) then call endrun ('ADDFLD: Attempt to add field '//trim(fname)//' after history files set') end if @@ -5352,6 +5905,9 @@ subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & listentry%field%mixing_ratio = mixing_ratio listentry%field%meridional_complement = -1 listentry%field%zonal_complement = -1 + listentry%field%field_op = '' + listentry%field%op_field1_id = -1 + listentry%field%op_field2_id = -1 listentry%htapeindx(:) = -1 listentry%act_sometape = .false. listentry%actflag(:) = .false. @@ -5453,6 +6009,40 @@ subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & call AvgflagToString(avgflag, listentry%time_op(dimcnt)) end do + if (present(op)) then + listentry%field%field_op = op + if (present(op_f1name).and.present(op_f2name)) then + ! Look for the field IDs + f1listentry => get_entry_by_name(masterlinkedlist, op_f1name) + f2listentry => get_entry_by_name(masterlinkedlist, op_f2name) + if (associated(f1listentry).and.associated(f2listentry)) then + listentry%op_field1=trim(op_f1name) + listentry%op_field2=trim(op_f2name) + else + write(errormsg, '(5a)') ': Attempt to create a composed field using (', & + trim(op_f1name), ', ', trim(op_f2name), & + ') but both fields have not been added to masterlist via addfld first' + call endrun (trim(subname)//errormsg) + end if + else + write(errormsg, *) ': Attempt to create a composed field but no component fields have been specified' + call endrun (trim(subname)//errormsg) + end if + + else + if (present(op_f1name)) then + write(errormsg, '(3a)') ': creating a composed field using component field 1:',& + trim(op_f1name),' but no field operation (op=sum/dif) has been defined' + call endrun (trim(subname)//errormsg) + end if + if (present(op_f2name)) then + write(errormsg, '(3a)') ': creating a composed field using component field 2:',& + trim(op_f2name),' but no field operation (op=sum/dif) has been defined' + call endrun (trim(subname)//errormsg) + end if + end if + + nullify(listentry%next_entry) call add_entry_to_master(listentry) @@ -5460,7 +6050,6 @@ subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & end subroutine addfld_nd !####################################################################### - ! field_part_of_vector: Determinie if fname is part of a vector set ! Optionally fill in the names of the vector set fields logical function field_part_of_vector(fname, meridional_name, zonal_name) @@ -5501,6 +6090,48 @@ logical function field_part_of_vector(fname, meridional_name, zonal_name) end function field_part_of_vector + !####################################################################### + ! composed field: Determinie if fname is composed from 2 other + ! fields + ! Optionally fill in the names of the composing fields + logical function composed_field(fname, fname1, fname2) + + ! Dummy arguments + character(len=*), intent(in) :: fname + character(len=*), optional, intent(out) :: fname1 + character(len=*), optional, intent(out) :: fname2 + + ! Local variables + type(master_entry), pointer :: listentry + + listentry => get_entry_by_name(masterlinkedlist, fname) + if (associated(listentry)) then + if ( (len_trim(listentry%op_field1) > 0) .or. & + (len_trim(listentry%op_field2) > 0)) then + composed_field = .true. + if (present(fname1)) then + fname1 = listentry%op_field1 + end if + if (present(fname2)) then + fname2 = listentry%op_field2 + end if + else + composed_field = .false. + end if + else + composed_field = .false. + end if + if (.not. composed_field) then + if (present(fname1)) then + fname1 = '' + end if + if (present(fname2)) then + fname2 = '' + end if + end if + + end function composed_field + ! register_vector_field: Register a pair of history field names as ! being a vector complement set. diff --git a/src/control/cam_history_buffers.F90 b/src/control/cam_history_buffers.F90 index f9a141247a..77cea6cfd6 100644 --- a/src/control/cam_history_buffers.F90 +++ b/src/control/cam_history_buffers.F90 @@ -110,6 +110,76 @@ subroutine hbuf_accum_add (buf8, field, nacs, dimind, idim, flag_xyfill, fillval return end subroutine hbuf_accum_add + !####################################################################### + + subroutine hbuf_accum_addnsteps (buf8, field, nacs, dimind, idim, flag_xyfill, fillvalue, nsteps) + use time_manager, only: get_nstep + ! + !----------------------------------------------------------------------- + ! + ! Purpose: Add the values of field to 2-D hbuf. + ! Increment accumulation counter by 1 and nsteps counter by 1 as + ! + !----------------------------------------------------------------------- + ! + real(r8), pointer :: buf8(:,:) ! 2-D history buffer + integer, pointer :: nacs(:) ! accumulation counter + integer, pointer :: nsteps(:)! nstep accumulation counter + integer, intent(in) :: idim ! Longitude dimension of field array + logical, intent(in) :: flag_xyfill ! non-applicable xy points flagged with fillvalue + real(r8), intent(in ) :: field(idim,*) ! real*8 array + type (dim_index_2d), intent(in ) :: dimind ! 2-D dimension index + real(r8), intent(in) :: fillvalue + integer, save :: nstep_save + integer :: nstep_curr + ! + ! Local indices + ! + integer :: ieu, jeu ! number of elements in each dimension + integer :: i,k ! indices + + call dimind%dim_sizes(ieu, jeu) + nstep_curr=get_nstep() + + if (flag_xyfill) then + do k=1,jeu + do i=1,ieu + if (field(i,k) /= fillvalue) then + buf8(i,k) = buf8(i,k) + field(i,k) + end if + end do + end do + ! + ! Ensure input field has fillvalue defined invariant in the z-direction, then increment nacs + ! + call check_accum (field, idim, ieu, jeu, fillvalue) + do i=1,ieu + if (field(i,1) /= fillvalue) then + nacs(i) = nacs(i) + 1 + if (nstep_curr > nstep_save) then + nsteps(i) = nsteps(i) + 1 + nstep_save=nstep_curr + nsteps(i) = 1 + end if + end if + end do + else + do k=1,jeu + do i=1,ieu + buf8(i,k) = buf8(i,k) + field(i,k) + end do + end do + nacs(1) = nacs(1) + 1 + if (nstep_curr > nstep_save) then + nsteps(1) = nsteps(1) + 1 + nstep_save=nstep_curr + nsteps(1) = 1 + end if + end if + + return + end subroutine hbuf_accum_addnsteps + !####################################################################### subroutine hbuf_accum_variance (hbuf, sbuf, field, nacs, dimind, idim, flag_xyfill, fillvalue) ! diff --git a/src/control/cam_history_support.F90 b/src/control/cam_history_support.F90 index 8251ebde95..466b5c4f78 100644 --- a/src/control/cam_history_support.F90 +++ b/src/control/cam_history_support.F90 @@ -26,7 +26,7 @@ module cam_history_support integer, parameter, public :: max_string_len = shr_kind_cxx integer, parameter, public :: max_chars = shr_kind_cl ! max chars for char variables integer, parameter, public :: fieldname_len = 32 ! max chars for field name - integer, parameter, public :: fieldname_suffix_len = 3 ! length of field name suffix ("&IC") + integer, parameter, public :: fieldname_suffix_len = 3 ! length of field name suffix ("&IC" and "&BG") integer, parameter, public :: fieldname_lenp2 = fieldname_len + 2 ! allow for extra characters ! max_fieldname_len = max chars for field name (including suffix) integer, parameter, public :: max_fieldname_len = fieldname_len + fieldname_suffix_len @@ -118,6 +118,10 @@ module cam_history_support integer :: meridional_complement ! meridional field id or -1 integer :: zonal_complement ! zonal field id or -1 + character(len=3) :: field_op ! 'sum' or 'dif' + integer :: op_field1_id ! first field id to be summed/diffed or -1 + integer :: op_field2_id ! second field id to be summed/diffed or -1 + character(len=max_fieldname_len) :: name ! field name character(len=max_chars) :: long_name ! long name character(len=max_chars) :: units ! units @@ -127,6 +131,7 @@ module cam_history_support ! radiation calcs; etc. character(len=max_chars) :: cell_methods ! optional cell_methods attribute contains + procedure :: is_composed => field_info_is_composed procedure :: get_shape => field_info_get_shape procedure :: get_bounds => field_info_get_bounds procedure :: get_dims_2d => field_info_get_dims_2d @@ -159,11 +164,18 @@ module cam_history_support integer :: hwrt_prec ! history output precision real(r8), pointer :: hbuf(:,:,:) => NULL() + real(r8) :: hbuf_area_wgt_integral! area weighted integral of active field field real(r8), pointer :: sbuf(:,:,:) => NULL() ! for standard deviation + real(r8), pointer :: gbuf(:,:,:) => NULL() ! pointer to area weights type(var_desc_t), pointer :: varid(:) => NULL() ! variable ids integer, pointer :: nacs(:,:) => NULL() ! accumulation counter type(var_desc_t), pointer :: nacs_varid => NULL() + integer, pointer :: nsteps(:,:) => NULL() ! accumulation counter + type(var_desc_t), pointer :: nsteps_varid=> NULL() type(var_desc_t), pointer :: sbuf_varid => NULL() + type(var_desc_t), pointer :: gbuf_varid => NULL() + contains + procedure :: get_global => hentry_get_global end type hentry !--------------------------------------------------------------------------- @@ -435,6 +447,12 @@ type(dim_index_3d) function field_info_get_dims_3d(this) result(dims) end function field_info_get_dims_3d + ! field_info_is_composed: Return whether this field is composed of two other fields + logical function field_info_is_composed(this) + class(field_info) :: this + field_info_is_composed = (this%field_op=='sum' .or. this%field_op=='dif') + end function field_info_is_composed + ! field_info_get_shape: Return a pointer to the field's global shape. ! Calculate it first if necessary subroutine field_info_get_shape(this, shape_out, rank_out) @@ -503,6 +521,26 @@ subroutine field_info_get_bounds(this, dim, beg, end) end subroutine field_info_get_bounds + subroutine hentry_get_global(this, gval) + + ! Dummy arguments + class(hentry) :: this + real(r8), intent(out) :: gval + + gval=this%hbuf_area_wgt_integral + + end subroutine hentry_get_global + + subroutine hentry_put_global(this, gval) + + ! Dummy arguments + class(hentry) :: this + real(r8), intent(in) :: gval + + this%hbuf_area_wgt_integral=gval + + end subroutine hentry_put_global + ! history_patch_write_attrs: Define coordinate variables and attributes ! for a patch subroutine history_patch_write_attrs(this, File) @@ -957,6 +995,9 @@ subroutine field_copy(f_out, f_in) f_out%meridional_complement = f_in%meridional_complement ! id or -1 f_out%zonal_complement = f_in%zonal_complement ! id or -1 + f_out%field_op = f_in%field_op ! sum,dif, or '' + f_out%op_field1_id = f_in%op_field1_id ! id or -1 + f_out%op_field2_id = f_in%op_field2_id ! id or -1 f_out%name = f_in%name ! field name f_out%long_name = f_in%long_name ! long name diff --git a/src/dynamics/se/dycore/element_mod.F90 b/src/dynamics/se/dycore/element_mod.F90 index 6905c380bd..6ba2b36e02 100644 --- a/src/dynamics/se/dycore/element_mod.F90 +++ b/src/dynamics/se/dycore/element_mod.F90 @@ -5,8 +5,6 @@ module element_mod use dimensions_mod, only: np, nc, npsq, nlev, nlevp, qsize_d, max_neigh_edges,ntrac_d use edgetype_mod, only: edgedescriptor_t use gridgraph_mod, only: gridvertex_t - use budgets, only: budget_array_max - use cam_thermo, only: thermo_budget_num_vars implicit none private @@ -79,12 +77,6 @@ module element_mod ! reference profiles real (kind=r8) :: T_ref(np,np,nlev) ! reference temperature real (kind=r8) :: dp_ref(np,np,nlev) ! reference pressure level thickness - - ! budgets - real (kind=r8) :: budget(np,np,thermo_budget_num_vars,budget_array_max) ! budgets - integer :: budget_cnt(budget_array_max) ! budget count for averaging - integer :: budget_subcycle(budget_array_max) ! budget subcycle count - end type derived_state_t !___________________________________________________________________ diff --git a/src/dynamics/se/dycore/fvm_control_volume_mod.F90 b/src/dynamics/se/dycore/fvm_control_volume_mod.F90 index 91e25975a0..c1b3c6fc15 100644 --- a/src/dynamics/se/dycore/fvm_control_volume_mod.F90 +++ b/src/dynamics/se/dycore/fvm_control_volume_mod.F90 @@ -17,7 +17,6 @@ module fvm_control_volume_mod use dimensions_mod, only: fv_nphys, nhe_phys, nhr_phys, ns_phys, nhc_phys,fv_nphys use dimensions_mod, only: irecons_tracer use cam_abortutils, only: endrun - use budgets, only: budget_array_max implicit none private @@ -156,7 +155,6 @@ module fvm_control_volume_mod real (kind=r8) , allocatable :: ft(:,:,:) real (kind=r8) , allocatable :: fm(:,:,:,:) real (kind=r8) , allocatable :: dp_phys(:,:,:) - real (kind=r8) , allocatable :: budget(:,:,:,:) ! budgets end type fvm_struct public :: fvm_mesh, fvm_set_cubeboundary, allocate_physgrid_vars @@ -308,7 +306,6 @@ subroutine allocate_physgrid_vars(fvm,par) allocate(fvm(ie)%ft(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,nlev)) allocate(fvm(ie)%fm(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,2,nlev)) allocate(fvm(ie)%dp_phys(1-nhc_phys:fv_nphys+nhc_phys,1-nhc_phys:fv_nphys+nhc_phys,nlev)) - allocate(fvm(ie)%budget(nc,nc,9,budget_array_max)) end do end subroutine allocate_physgrid_vars end module fvm_control_volume_mod diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index 0e1b084170..b1905b411f 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -10,8 +10,7 @@ module prim_advance_mod private save - public :: prim_advance_exp, prim_advance_init, applyCAMforcing, calc_tot_energy_dynamics, compute_omega, & - calc_tot_energy_dynamics_diff + public :: prim_advance_exp, prim_advance_init, applyCAMforcing, calc_tot_energy_dynamics, compute_omega type (EdgeBuffer_t) :: edge3,edgeOmega,edgeSponge real (kind=r8), allocatable :: ur_weights(:) @@ -1453,20 +1452,22 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf use physconst, only: gravit, cpair, rearth, omega use element_mod, only: element_t use cam_history, only: outfld, hist_fld_active + use cam_history_support, only: max_fieldname_len use constituents, only: cnst_get_ind use string_utils, only: strlist_get_ind use hycoef, only: hyai, ps0 use fvm_control_volume_mod, only: fvm_struct - use cam_thermo, only: get_dp, MASS_MIXING_RATIO,wvidx,wlidx,wiidx,seidx,poidx,keidx,moidx,mridx,ttidx,teidx + use cam_thermo, only: get_dp, MASS_MIXING_RATIO,wvidx,wlidx,wiidx,seidx,poidx,keidx,moidx,mridx,ttidx,teidx, & + thermo_budget_num_vars,thermo_budget_vars use cam_thermo, only: get_hydrostatic_energy use air_composition, only: thermodynamic_active_species_idx_dycore, get_cp use air_composition, only: thermodynamic_active_species_num, thermodynamic_active_species_idx_dycore use air_composition, only: thermodynamic_active_species_liq_num,thermodynamic_active_species_liq_idx use air_composition, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_ice_idx use dimensions_mod, only: cnst_name_gll - use budgets, only: budget_info_byname use cam_logfile, only: iulog use spmd_utils, only: masterproc + use time_manager, only: get_step_size use dyn_tests_utils, only: vcoord=>vc_dry_pressure !------------------------------Arguments-------------------------------- @@ -1491,6 +1492,8 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf real(kind=r8) :: ptop(np,np) real(kind=r8) :: pdel(np,np,nlev) real(kind=r8) :: cp(np,np,nlev) + + real(kind=r8) :: dtime ! time_step ! ! global axial angular momentum (AAM) can be separated into one part (mr) associatedwith the relative motion ! of the atmosphere with respect to the planets surface (also known as wind AAM) and another part (mo) @@ -1499,26 +1502,20 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf ! real(kind=r8) :: mr(npsq) ! wind AAM real(kind=r8) :: mo(npsq) ! mass AAM - real(kind=r8) :: mr_cnst, mo_cnst, cos_lat, mr_tmp, mo_tmp,inv_g + real(kind=r8) :: mr_cnst, mo_cnst, cos_lat, mr_tmp, mo_tmp integer :: ie,i,j,k,budget_ind,state_ind,idx,idx_tmp integer :: ixwv,ixcldice, ixcldliq, ixtt ! CLDICE, CLDLIQ and test tracer indices - character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 + character(len=max_fieldname_len) :: name_out(thermo_budget_num_vars) !----------------------------------------------------------------------- - name_out1 = 'SE_' //trim(outfld_name_suffix) - name_out2 = 'KE_' //trim(outfld_name_suffix) - name_out3 = 'WV_' //trim(outfld_name_suffix) - name_out4 = 'WL_' //trim(outfld_name_suffix) - name_out5 = 'WI_' //trim(outfld_name_suffix) - name_out6 = 'TT_' //trim(outfld_name_suffix) - - if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2).or.hist_fld_active(name_out3).or.& - hist_fld_active(name_out4).or.hist_fld_active(name_out5).or.hist_fld_active(name_out6)) then - - inv_g = 1.0_r8/gravit + do i=1,thermo_budget_num_vars + name_out(i)=trim(thermo_budget_vars(i))//'_'//trim(outfld_name_suffix) + end do + dtime=get_step_size() + if (ntrac>0) then ixwv = 1 call cnst_get_ind('CLDLIQ' , ixcldliq, abort=.false.) @@ -1558,61 +1555,22 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf phis=elem(ie)%state%phis(:,j),dycore_idx=.true., & se=se(:,j), po=po(:,j), ke=ke(:,j), wv=wv(:,j), liq=liq(:,j), ice=ice(:,j)) end do - - ! could store pointer to dyn/phys state index inside of budget and call budget_state_update pass in se,ke etc. - call budget_info_byname(trim(outfld_name_suffix),budget_ind=budget_ind,state_ind=state_ind) - ! reset all when cnt is 0 - - if (elem(ie)%derived%budget_cnt(budget_ind) == 0) then - if (ie.eq.nets) write(iulog,*)'cnt = 0;resetting :',trim(outfld_name_suffix) - elem(ie)%derived%budget_subcycle(budget_ind) = 0 - elem(ie)%derived%budget(:,:,:,state_ind)=0.0_r8 - if (ntrac>0) fvm(ie)%budget(:,:,:,state_ind)=0.0_r8 - end if - if (present(subcycle)) then - if (subcycle) then - elem(ie)%derived%budget_subcycle(budget_ind) = elem(ie)%derived%budget_subcycle(budget_ind) + 1 - if (elem(ie)%derived%budget_subcycle(budget_ind) == 1) then - elem(ie)%derived%budget_cnt(budget_ind) = elem(ie)%derived%budget_cnt(budget_ind) + 1 - end if - else - elem(ie)%derived%budget_cnt(budget_ind) = elem(ie)%derived%budget_cnt(budget_ind) + 1 - elem(ie)%derived%budget_subcycle(budget_ind) = 1 - end if - else - elem(ie)%derived%budget_cnt(budget_ind) = elem(ie)%derived%budget_cnt(budget_ind) + 1 - elem(ie)%derived%budget_subcycle(budget_ind) = 1 - end if - - do j=1,np - do i = 1, np - elem(ie)%derived%budget(i,j,teidx,state_ind) = elem(ie)%derived%budget(i,j,teidx,state_ind) + & - se(i,j) + ke(i,j)+po(i,j) - elem(ie)%derived%budget(i,j,seidx,state_ind) = elem(ie)%derived%budget(i,j,seidx,state_ind) + se(i,j) - elem(ie)%derived%budget(i,j,keidx,state_ind) = elem(ie)%derived%budget(i,j,keidx,state_ind) + ke(i,j) - elem(ie)%derived%budget(i,j,poidx,state_ind) = elem(ie)%derived%budget(i,j,poidx,state_ind) + po(i,j) - elem(ie)%derived%budget(i,j,wvidx,state_ind) = elem(ie)%derived%budget(i,j,wvidx,state_ind) + wv(i,j) - elem(ie)%derived%budget(i,j,wlidx,state_ind) = elem(ie)%derived%budget(i,j,wlidx,state_ind) + liq(i,j) - elem(ie)%derived%budget(i,j,wiidx,state_ind) = elem(ie)%derived%budget(i,j,wiidx,state_ind) + ice(i,j) - end do - end do + ! + ! Normalize energy variables by dtime for W/s +!jt se(:)=se(:)/dtime +!jt ke(:)=ke(:)/dtime ! ! Output energy diagnostics on GLL grid ! - call outfld(name_out1 ,se,npsq,ie) - call outfld(name_out2 ,ke,npsq,ie) + call outfld(name_out(seidx) ,se ,npsq,ie) + call outfld(name_out(keidx) ,ke ,npsq,ie) ! ! mass variables are output on CSLAM grid if using CSLAM else GLL grid ! if (ntrac>0) then if (ixwv>0) then cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixwv)*fvm(ie)%dp_fvm(1:nc,1:nc,:) - call util_function(cdp_fvm,nc,nlev,name_out3,ie) - do j = 1, nc - do i = 1, nc - fvm(ie)%budget(i,j,wvidx,state_ind) = fvm(ie)%budget(i,j,wvidx,state_ind) + sum(cdp_fvm(i,j,:)*inv_g) - end do - end do + call util_function(cdp_fvm,nc,nlev,name_out(wvidx),ie) end if ! ! sum over liquid water @@ -1623,12 +1581,7 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf cdp_fvm = cdp_fvm + fvm(ie)%c(1:nc,1:nc,:,thermodynamic_active_species_liq_idx(idx))& *fvm(ie)%dp_fvm(1:nc,1:nc,:) end do - call util_function(cdp_fvm,nc,nlev,name_out4,ie) - do j = 1, nc - do i = 1, nc - fvm(ie)%budget(i,j,wlidx,state_ind) = fvm(ie)%budget(i,j,wlidx,state_ind) + sum(cdp_fvm(i,j,:)*inv_g) - end do - end do + call util_function(cdp_fvm,nc,nlev,name_out(wlidx),ie) end if ! ! sum over ice water @@ -1639,36 +1592,41 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf cdp_fvm = cdp_fvm + fvm(ie)%c(1:nc,1:nc,:,thermodynamic_active_species_ice_idx(idx))& *fvm(ie)%dp_fvm(1:nc,1:nc,:) end do - call util_function(cdp_fvm,nc,nlev,name_out5,ie) - - do j = 1, nc - do i = 1, nc - fvm(ie)%budget(i,j,wiidx,state_ind) = fvm(ie)%budget(i,j,wiidx,state_ind) + sum(cdp_fvm(i,j,:)*inv_g) - end do - end do + call util_function(cdp_fvm,nc,nlev,name_out(wiidx),ie) end if if (ixtt>0) then cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixtt)*fvm(ie)%dp_fvm(1:nc,1:nc,:) - call util_function(cdp_fvm,nc,nlev,name_out6,ie) - do j = 1, nc - do i = 1, nc - fvm(ie)%budget(i,j,ttidx,state_ind) = fvm(ie)%budget(i,j,ttidx,state_ind) + sum(cdp_fvm(i,j,:)*inv_g) - end do - end do + call util_function(cdp_fvm,nc,nlev,name_out(ttidx),ie) end if else + cdp = elem(ie)%state%qdp(:,:,:,1,tl_qdp) + call util_function(cdp,np,nlev,name_out(wvidx),ie) + ! + ! sum over liquid water + ! + if (thermodynamic_active_species_liq_num>0) then + cdp = 0.0_r8 + do idx = 1,thermodynamic_active_species_liq_num + cdp = cdp + elem(ie)%state%qdp(:,:,:,thermodynamic_active_species_liq_idx(idx),tl_qdp) + end do + call util_function(cdp,np,nlev,name_out(wlidx),ie) + end if + ! + ! sum over ice water + ! + if (thermodynamic_active_species_ice_num>0) then + cdp = 0.0_r8 + do idx = 1,thermodynamic_active_species_ice_num + cdp = cdp + elem(ie)%state%qdp(:,:,:,thermodynamic_active_species_ice_idx(idx),tl_qdp) + end do + call util_function(cdp,np,nlev,name_out(wiidx),ie) + end if if (ixtt>0) then cdp = elem(ie)%state%qdp(:,:,:,ixtt ,tl_qdp) - call util_function(cdp,np,nlev,name_out6,ie) - do j = 1, np - do i = 1, np - elem(ie)%derived%budget(i,j,ttidx,state_ind) = elem(ie)%derived%budget(i,j,ttidx,state_ind) + sum(cdp(i,j,:)*inv_g) - end do - end do + call util_function(cdp,np,nlev,name_out(ttidx),ie) end if end if end do - end if ! ! Axial angular momentum diagnostics ! @@ -1682,10 +1640,7 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf ! MR is equation (6) without \Delta A and sum over areas (areas are in units of radians**2) ! MO is equation (7) without \Delta A and sum over areas (areas are in units of radians**2) ! - name_out1 = 'MR_' //trim(outfld_name_suffix) - name_out2 = 'MO_' //trim(outfld_name_suffix) - if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2)) then call strlist_get_ind(cnst_name_gll, 'CLDLIQ', ixcldliq, abort=.false.) call strlist_get_ind(cnst_name_gll, 'CLDICE', ixcldice, abort=.false.) mr_cnst = rearth**3/gravit @@ -1702,97 +1657,21 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf mr_tmp = mr_cnst*elem(ie)%state%v(i,j,1,k,tl)*pdel(i,j,k)*cos_lat mo_tmp = mo_cnst*pdel(i,j,k)*cos_lat**2 +!jt mr (i+(j-1)*np) = mr (i+(j-1)*np) + mr_tmp/dtime +!jt mo (i+(j-1)*np) = mo (i+(j-1)*np) + mo_tmp/dtime mr (i+(j-1)*np) = mr (i+(j-1)*np) + mr_tmp mo (i+(j-1)*np) = mo (i+(j-1)*np) + mo_tmp end do end do end do - call outfld(name_out1 ,mr ,npsq,ie) - call outfld(name_out2 ,mo ,npsq,ie) - do j=1,np - do i = 1, np - elem(ie)%derived%budget(i,j,mridx,state_ind) = elem(ie)%derived%budget(i,j,mridx,state_ind) + mr(i+(j-1)*np) - elem(ie)%derived%budget(i,j,moidx,state_ind) = elem(ie)%derived%budget(i,j,moidx,state_ind) + mo(i+(j-1)*np) - end do - end do + call outfld(name_out(mridx) ,mr ,npsq,ie) + call outfld(name_out(moidx) ,mo ,npsq,ie) end do - end if end subroutine calc_tot_energy_dynamics - subroutine calc_tot_energy_dynamics_diff(elem,fvm,nets,nete,tl,tl_qdp,budget_name, subcycle) - use dimensions_mod, only: ntrac - use element_mod, only: element_t - use constituents, only: cnst_get_ind - use fvm_control_volume_mod, only: fvm_struct - use budgets, only: budget_info,budget_ind_byname - use cam_thermo, only: thermo_budget_num_vars, & - thermo_budget_vars_massv,wvidx,wlidx,wiidx,poidx,seidx,keidx,moidx,mridx,ttidx,teidx - !------------------------------Arguments-------------------------------- - - type (element_t) , intent(inout) :: elem(:) - type(fvm_struct) , intent(inout) :: fvm(:) - integer , intent(in) :: tl, tl_qdp,nets,nete - character*(*) , intent(in) :: budget_name ! suffix for "outfld" names - logical, optional, intent(in) :: subcycle ! true if called inside subcycle loop - - !---------------------------Local storage------------------------------- - - integer :: ie,ixtt,b_ind,s_ind,is1,is2,isb1,isb2,n - character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn - !----------------------------------------------------------------------- - b_ind=budget_ind_byname(trim(budget_name)) - call budget_info(b_ind,stg1stateidx=is1, stg2stateidx=is2,stg1index=isb1, stg2index=isb2, optype=budget_optype, pkgtype=budget_pkgtype,state_ind=s_ind) - - do ie=nets,nete - ! advance budget_cnt - if (present(subcycle)) then - if (subcycle) then - ! reset subcycle when cnt is 0 - if (elem(ie)%derived%budget_cnt(b_ind) == 0) then - elem(ie)%derived%budget_subcycle(b_ind) = 0 - elem(ie)%derived%budget(:,:,:,s_ind)=0._r8 - if (ntrac>0) fvm(ie)%budget(:,:,:,s_ind)=0._r8 - end if - elem(ie)%derived%budget_subcycle(b_ind) = elem(ie)%derived%budget_subcycle(b_ind) + 1 - if (elem(ie)%derived%budget_subcycle(b_ind) == 1) then - elem(ie)%derived%budget_cnt(b_ind) = elem(ie)%derived%budget_cnt(b_ind) + 1 - end if - else - elem(ie)%derived%budget_cnt(b_ind) = elem(ie)%derived%budget_cnt(b_ind) + 1 - elem(ie)%derived%budget_subcycle(b_ind) = 1 - end if - else - elem(ie)%derived%budget_cnt(b_ind) = elem(ie)%derived%budget_cnt(b_ind) + 1 - elem(ie)%derived%budget_subcycle(b_ind) = 1 - end if - - if (elem(ie)%derived%budget_cnt(isb1)==0.or.elem(ie)%derived%budget_cnt(isb2)==0) then - elem(ie)%derived%budget(:,:,:,s_ind)=0._r8 - else - do n=1,thermo_budget_num_vars - if (budget_optype=='dif') then - if (ntrac>0.and.thermo_budget_vars_massv(n)) then - fvm(ie)%budget(:,:,n,s_ind)=(fvm(ie)%budget(:,:,n,is1)-fvm(ie)%budget(:,:,n,is2)) - else - elem(ie)%derived%budget(:,:,n,s_ind)=(elem(ie)%derived%budget(:,:,n,is1)-elem(ie)%derived%budget(:,:,n,is2)) - end if - else if (budget_optype=='sum') then - if (ntrac>0.and.thermo_budget_vars_massv(n)) then - fvm(ie)%budget(:,:,n,s_ind)=(fvm(ie)%budget(:,:,n,is1)+fvm(ie)%budget(:,:,n,is2)) - else - elem(ie)%derived%budget(:,:,n,s_ind)=(elem(ie)%derived%budget(:,:,n,is1)+elem(ie)%derived%budget(:,:,n,is2)) - end if - else - call endrun('dyn_readnl: ERROR: budget_optype unknown:'//budget_optype) - end if - end do - end if - end do - end subroutine calc_tot_energy_dynamics_diff - subroutine output_qdp_var_dynamics(qdp,nx,num_trac,nets,nete,outfld_name) use dimensions_mod, only: nlev,ntrac use cam_history , only: outfld, hist_fld_active diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index 8bce8eccba..9bd47eb140 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -3,8 +3,7 @@ module dycore_budget implicit none public :: print_budget -real(r8), parameter :: eps = 1.0E-9_r8 -real(r8), parameter :: eps_mass = 1.0E-12_r8 +real(r8), parameter :: eps = 1.0E-9_r8 real(r8), save :: previous_dEdt_adiabatic_dycore = 0.0_r8 real(r8), save :: previous_dEdt_dry_mass_adjust = 0.0_r8 @@ -135,7 +134,7 @@ subroutine print_budget() dycore = -ph_EFIX-previous_dEdt_dry_mass_adjust write(iulog,*) "" write(iulog,*) "Dycore TE dissipation estimated from physics in pressure coordinate:" - write(iulog,*) "(note: to avoid sampling error we need dE/dt from previous time-step)" + write(iulog,*) "(note to avoid sampling error we need dE/dt from previous time-step)" write(iulog,*) "" write(iulog,*) "dE/dt adiabatic dycore estimated from physics (t=n-1) = " write(iulog,'(a58,F6.2,a6)') "-dE/dt energy fixer(t=n)-dE/dt dry-mass adjust(t=n-1) = ",dycore," W/M^2" @@ -206,7 +205,7 @@ subroutine print_budget() write(iulog,*) "" call budget_get_global('dBF',teidx,E_dBF) !state passed to physics call budget_get_global('phBF',teidx,E_phBF)!state beginning physics -! if (abs(E_phBF)>eps) then + if (abs(E_phBF)>eps) then diff = abs_diff(E_dBF,E_phBF) if (abs(diff)eps_mass) then - write(iulog,*) "dMASS/dt energy fixer (pBP-pBF) ",pEFIX," Pa" - write(iulog,*) "ERROR: Mass not conserved in energy fixer. ABORT" - call endrun('dycore_budget module: Mass not conserved in energy fixer. See atm.log') - endif - if (abs(pDMEA)>eps_mass) then - write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",pDMEA," Pa" - write(iulog,*) "ERROR: Mass not conserved in dry mass adjustment. ABORT" - call endrun('dycore_budget module: Mass not conserved in dry mass adjustment. See atm.log') - end if - if (abs(param-phys_total)>eps_mass) then - write(iulog,*) "Error: dMASS/dt parameterizations (pAP-pBP) .ne. dMASS/dt physics total (pAM-pBF)" - write(iulog,*) "dMASS/dt parameterizations (pAP-pBP) ",param," Pa" - write(iulog,*) "dMASS/dt physics total (pAM-pBF) ",phys_total," Pa" - call endrun('dycore_budget module: mass change not only due to parameterizations. See atm.log') - end if - + write(iulog,*)"dMASS/dt energy fixer (pBP-pBF) ",pEFIX," Pa" write(iulog,*)"dMASS/dt parameterizations (pAP-pBP) ",param," Pa" + write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",pDMEA," Pa" write(iulog,*)"dMASS/dt physics total (pAM-pBF) ",phys_total," Pa" write(iulog,*)" " - ! - ! detailed mass budget in dynamical core - ! if (is_budget('dAD').and.is_budget('dBD').and.is_budget('dAR').and.is_budget('dCH')) then call budget_get_global('dAD-dBD',m_cnst,mass_change__2D_dyn) call budget_get_global('dAR-dAD',m_cnst,mass_change__vertical_remapping) diff = mass_change__2D_dyn+mass_change__vertical_remapping write(iulog,*)"dMASS/dt total adiabatic dynamics ",diff," Pa" - if (abs(diff)>eps_mass) then + if (abs(diff)>1.E-12_r8) then write(iulog,*) "Error: mass non-conservation in dynamical core" - write(iulog,*) "(detailed budget below)" - write(iulog,*) " " + write(iulog,*)"dMASS/dt 2D dynamics (dAD-dBD) ",mass_change__2D_dyn," Pa" if (is_budget('dAR').and.is_budget('dAD')) then call budget_get_global('dAR',m_cnst,dar) diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 8c9183c1cd..e21b2f4370 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -46,7 +46,6 @@ module dyn_comp use edge_mod, only: initEdgeBuffer, edgeVpack, edgeVunpack, FreeEdgeBuffer use edgetype_mod, only: EdgeBuffer_t use bndry_mod, only: bndry_exchange -use budgets, only: budget_add implicit none private @@ -609,9 +608,9 @@ subroutine dyn_init(dyn_in, dyn_out) use control_mod, only: vert_remap_uvTq_alg, vert_remap_tracer_alg use std_atm_profile, only: std_atm_height use dyn_tests_utils, only: vc_dycore, vc_dry_pressure, string_vc, vc_str_lgth - use budgets, only: thermo_budget_history, budget_num, budget_outfld, budget_info - use cam_thermo, only: thermo_budget_vars, thermo_budget_vars_descriptor, & - thermo_budget_vars_unit, thermo_budget_vars_massv, thermo_budget_num_vars + use budgets, only: thermo_budget_history, budget_outfld, budget_info, & + thermo_budget_histfile_num, budget_add + ! Dummy arguments: type(dyn_import_t), intent(out) :: dyn_in type(dyn_export_t), intent(out) :: dyn_out @@ -628,7 +627,8 @@ subroutine dyn_init(dyn_in, dyn_out) ! variables for initializing energy and axial angular momentum diagnostics integer, parameter :: num_stages = 12 - character (len = 3), dimension(num_stages) :: stage = (/"dED","dAF","dBD","dAD","dAR","dBF","dBH","dCH","dAH",'dBS','dAS','p2d'/) + character (len = 3), dimension(num_stages) :: stage = (/"dED","dAF","dBD","dAD","dAR","dBF","dBH","dCH","dAH","dBS","dAS","p2d"/) + character (len = 1), dimension(num_stages) :: stage_avgflag = (/"A" ,"C" ,"C" ,"C" ,"C" ,"A" ,"C" ,"C" ,"C" ,"C" ,"C" ,"A"/) character (len = 70),dimension(num_stages) :: stage_txt = (/& " end of previous dynamics ",& !dED " from previous remapping or state passed to dynamics",& !dAF - state in beginning of nsplit loop @@ -645,19 +645,16 @@ subroutine dyn_init(dyn_in, dyn_out) /) integer :: istage, ivars - character (len=108) :: str1, str2, str3 + character (len=108) :: str1, str2, str3, str4 character (len=vc_str_lgth) :: vc_str - logical :: history_budget ! output tendencies and state variables for budgets - integer :: budget_hfile_num + logical :: history_budget ! output tendencies and state variables for budgets + logical :: thermo_budget_hist ! output tendencies and state variables for budgets + integer :: budget_hfile_num, thermo_budget_hfile_num character(len=*), parameter :: sub = 'dyn_init' real(r8) :: km_sponge_factor_local(nlev+1) - character(len=64) :: budget_name ! budget names - character(len=3) :: budget_pkgtype ! budget type phy or dyn - character(len=3) :: budget_optype ! budget type phy or dyn - character(len=128) :: budget_longname ! long name of budgets !---------------------------------------------------------------------------- vc_dycore = vc_dry_pressure if (masterproc) then @@ -909,73 +906,48 @@ subroutine dyn_init(dyn_in, dyn_out) call addfld ('TT_PDC', horiz_only, 'A', 'kg/m2','Total column test tracer lost in physics-dynamics coupling',gridname='GLL') end if - do istage = 1, num_stages - do ivars=1, thermo_budget_num_vars - write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stage(istage))) - write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & - TRIM(ADJUSTL(stage_txt(istage))) - write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) - if (ntrac>0.and.thermo_budget_vars_massv(ivars)) then - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='FVM') - else - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='GLL') - end if - end do + call phys_getopts(thermo_budget_hist_out=thermo_budget_hist) + if (thermo_budget_hist) then ! Register stages for budgets - call budget_add(TRIM(ADJUSTL(stage(istage))), pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) - end do - - ! - ! Register dif/sum budgets. - ! - call budget_add('BD_dyn_total','dBF','dED',pkgtype='dyn',optype='dif',longname="dE/dt dyn total (dycore+phys tendency (dBF-dED)",outfld=.true.) - - call budget_add('rate_2d_dyn','dAD','dBD',pkgtype='dyn',optype='dif',longname="rate_of_change_2d_dyn (dAD-dBD)",outfld=.false.) - - call budget_add('rate_vert_remap','dAR','dAD',pkgtype='dyn',optype='dif',longname="rate_of_change_2d_dyn (dAR-dAD)",outfld=.false.) - - call budget_add('BD_dyn_adai','rate_2d_dyn','rate_vert_remap',pkgtype='dyn',optype='sum',longname="dE/dt total adiabatic dynamics (adiab=rate2ddyn+vremap) ",outfld=.true.) - - call budget_add('BD_dyn_2D','dAD','dBD',pkgtype='dyn',optype='dif',longname="dE/dt 2D dynamics (dAD-dBD)",outfld=.true.) - - call budget_add('BD_dyn_remap','dAR','dAD',pkgtype='dyn',optype='dif',longname="dE/dt vertical remapping (dAR-dAD)",outfld=.true.) - - call budget_add('BD_dyn_ptend','dBD','dAF',pkgtype='dyn',optype='dif',longname="dE/dt physics tendency in dynamics (dBD-dAF)",outfld=.true.) - - call budget_add('BD_dyn_hvis','dCH','dBH',pkgtype='dyn',optype='dif',longname="dE/dt hypervis del4 (dCH-dBH)",outfld=.true.) - - call budget_add('BD_dyn_fric','dAH','dCH',pkgtype='dyn',optype='dif',longname="dE/dt hypervis frictional heating del4 (dAH-dCH)",outfld=.true.) - - call budget_add('BD_dyn_difdel4tot','dAH','dBH',pkgtype='dyn',optype='dif',longname="dE/dt hypervis del4 total (dAH-dBH)",outfld=.true.) - - call budget_add('BD_dyn_sponge','dAS','dBS',pkgtype='dyn',optype='dif',longname="dE/dt hypervis sponge total (dAS-dBS)",outfld=.true.) - - call budget_add('BD_dyn_difftot','BD_dyn_difdel4tot','BD_dyn_sponge',pkgtype='dyn',optype='sum',longname="dE/dt explicit diffusion total (hvisdel4tot+hvisspngtot)",outfld=.true.) - - call budget_add('BD_dyn_res','BD_dyn_2D','BD_dyn_difftot',pkgtype='dyn',optype='dif',longname="dE/dt residual (2ddyn-expdifftot)",outfld=.true.) - - call budget_add('hrate','dAH','dCH',pkgtype='dyn',optype='dif',longname="rate of change heating term put back in (dAH-dCH)",outfld=.false.) - -! register history budget variables - if (thermo_budget_history) then - do m=1,budget_num - call budget_info(m,name=budget_name,longname=budget_longname,pkgtype=budget_pkgtype,optype=budget_optype) - if (trim(budget_pkgtype)=='dyn'.and.(trim(budget_optype)=='dif'.or.trim(budget_optype)=='sum')) then - do ivars=1, thermo_budget_num_vars - write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(budget_name)) - write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & - TRIM(ADJUSTL(budget_longname)) - write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) - if (ntrac>0.and.thermo_budget_vars_massv(ivars)) then - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='FVM') - else - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='GLL') - endif - end do - end if - end do - end if + do istage = 1, num_stages + call budget_add(TRIM(ADJUSTL(stage(istage))), 'dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) + end do + + ! + ! Register dif/sum budgets. + ! + call budget_add('BD_dyn_total','dBF','dED','dyn','dif',longname="dE/dt dyn total (dycore+phys tendency (dBF-dED)",outfld=.true.) + + call budget_add('rate_2d_dyn','dAD','dBD','dyn','dif',longname="rate_of_change_2d_dyn (dAD-dBD)",outfld=.false.) + + call budget_add('rate_vert_remap','dAR','dAD','dyn','dif',longname="rate_of_change_2d_dyn (dAR-dAD)",outfld=.false.) + + call budget_add('BD_dyn_adai','rate_2d_dyn','rate_vert_remap','dyn','sum',longname="dE/dt total adiabatic dynamics (adiab=rate2ddyn+vremap) ",outfld=.true.) + + call budget_add('BD_dyn_2D','dAD','dBD','dyn','dif',longname="dE/dt 2D dynamics (dAD-dBD)",outfld=.true.) + + call budget_add('BD_dyn_remap','dAR','dAD','dyn','dif',longname="dE/dt vertical remapping (dAR-dAD)",outfld=.true.) + + call budget_add('BD_dyn_ptend','dBD','dAF','dyn','dif',longname="dE/dt physics tendency in dynamics (dBD-dAF)",outfld=.true.) + + call budget_add('BD_dyn_hvis','dCH','dBH','dyn','dif',longname="dE/dt hypervis del4 (dCH-dBH)",outfld=.true.) + + call budget_add('BD_dyn_fric','dAH','dCH','dyn','dif',longname="dE/dt hypervis frictional heating del4 (dAH-dCH)",outfld=.true.) + + call budget_add('BD_dyn_difdel4tot','dAH','dBH','dyn','dif',longname="dE/dt hypervis del4 total (dAH-dBH)",outfld=.true.) + + call budget_add('BD_dyn_sponge','dAS','dBS','dyn','dif',longname="dE/dt hypervis sponge total (dAS-dBS)",outfld=.true.) + + call budget_add('BD_dyn_difftot','BD_dyn_difdel4tot','BD_dyn_sponge','dyn','sum',longname="dE/dt explicit diffusion total (hvisdel4tot+hvisspngtot)",outfld=.true.) + + call budget_add('BD_dyn_res','BD_dyn_2D','BD_dyn_difftot','dyn','dif',longname="dE/dt residual (2ddyn-expdifftot)",outfld=.true.) + + call budget_add('hrate','dAH','dCH','dyn','dif',longname="rate of change heating term put back in (dAH-dCH)",outfld=.false.) + + end if + call addfld ('dyn_area', horiz_only, 'I', 'steradian', 'dynamics grid area' , gridname='GLL') + ! ! add dynamical core tracer tendency output ! if (ntrac>0) then @@ -1014,8 +986,7 @@ subroutine dyn_run(dyn_state) use control_mod, only: qsplit, rsplit, ftype_conserve use thread_mod, only: horz_num_threads use time_mod, only: tevolve - use budgets, only: budget_cnt,budget_num,& - budget_outfld,budget_count, budget_write +!jt use budgets, only: budget_write use global_norms_mod, only: global_integral, wrap_repro_sum use parallel_mod, only: global_shared_buf, global_shared_sum use dycore_budget, only: print_budget @@ -1038,10 +1009,6 @@ subroutine dyn_run(dyn_state) real(r8), allocatable, dimension(:,:,:) :: abs_ps_tend real (kind=r8) :: omega_cn(2,nelemd) !min and max of vertical Courant number - integer :: is1,is2,is1b,is2b,budget_state_ind - character(len=64) :: budget_name ! budget names - character(len=3) :: budget_pkgtype ! budget type phy or dyn - character(len=3) :: budget_optype ! budget type phy or dyn !---------------------------------------------------------------------------- #ifdef debug_coupling @@ -1189,11 +1156,9 @@ subroutine dyn_run(dyn_state) ! output vars on CSLAM fvm grid call write_dyn_vars(dyn_state) - if(budget_write(step_offset=nint(dtime))) then - call budget_update(dyn_state%elem,dyn_state%fvm, nets, nete, TimeLevel%n0, n0_qdp, hybrid) - else - call budget_update_dyn_cnts(dyn_state%elem,dyn_state%fvm, nets, nete, TimeLevel%n0, n0_qdp, hybrid) - end if +!jt if(budget_write(step_offset=nint(dtime))) then +!jt call budget_update(dyn_state%elem,dyn_state%fvm, nets, nete, TimeLevel%n0, n0_qdp, hybrid) +!jt end if end subroutine dyn_run !=============================================================================== @@ -2378,179 +2343,4 @@ subroutine write_dyn_vars(dyn_out) end subroutine write_dyn_vars -!========================================================================================= -subroutine budget_update(elem,fvm,nets,nete,n0,n0_qdp,hybrid) - - use budgets, only: budget_write, thermo_budget_history, budget_num, budget_info, budget_put_global - use element_mod, only: element_t - use fvm_control_volume_mod, only: fvm_struct - use global_norms_mod, only: global_integral - use air_composition, only: thermodynamic_active_species_liq_num, thermodynamic_active_species_ice_num - use prim_advance_mod, only: calc_tot_energy_dynamics_diff - use time_manager, only: get_step_size - use cam_thermo, only: thermo_budget_num_vars, & - thermo_budget_vars_massv,wvidx,wlidx,wiidx,seidx,keidx,moidx,mridx,ttidx,teidx - ! arguments - type (element_t) , intent(inout) :: elem(:) - type(fvm_struct) , intent(inout) :: fvm(:) - type(hybrid_t) , intent(in) :: hybrid - integer , intent(in) :: n0, n0_qdp,nets,nete - - ! Local variables - character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn - character(len=64) :: name_out1,name_out2,name_out3,name_out4,name_out5,budget_name - integer :: budget_state_ind,s_ind,b_ind,i,n,ie - logical :: budget_outfld - - real(r8) :: budgets_global(budget_num,thermo_budget_num_vars) - real(r8), allocatable, dimension(:,:,:) :: tmpgll,tmpfvm - real(r8) :: dtime - - !-------------------------------------------------------------------------------------- - - - ! update energy budget differences and outfld - - dtime = get_step_size() - - do b_ind = 1,budget_num - call budget_info(b_ind,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=s_ind,outfld=budget_outfld) - if (budget_pkgtype=='dyn'.and.(budget_optype=='dif'.or.budget_optype=='sum')) then - call calc_tot_energy_dynamics_diff(elem,fvm, nets, nete, n0, n0_qdp,trim(budget_name)) - ! - ! Output energy diagnostics - ! - if (thermo_budget_history) then - name_out1 = 'SE_' //trim(budget_name) - name_out2 = 'KE_' //trim(budget_name) - name_out3 = 'WV_' //trim(budget_name) - name_out4 = 'WL_' //trim(budget_name) - name_out5 = 'WI_' //trim(budget_name) - do ie=nets,nete - call outfld(name_out1, elem(ie)%derived%budget(:,:,seidx,s_ind), npsq, ie) - call outfld(name_out2, elem(ie)%derived%budget(:,:,keidx,s_ind), npsq, ie) - ! - ! sum over vapor - call outfld(name_out3, elem(ie)%derived%budget(:,:,wvidx,s_ind), npsq, ie) - ! - ! sum over liquid water - if (thermodynamic_active_species_liq_num>0) & - call outfld(name_out4, elem(ie)%derived%budget(:,:,wlidx,s_ind), npsq, ie) - ! - ! sum over ice water - if (thermodynamic_active_species_ice_num>0) & - call outfld(name_out5, elem(ie)%derived%budget(:,:,wiidx,s_ind), npsq, ie) - end do - end if - end if - end do - - ! update energy budget globals - - allocate(tmpgll(np,np,nets:nete)) - if (ntrac>0) allocate(tmpfvm(nc,nc,nets:nete)) - - do b_ind=1,budget_num - call budget_info(b_ind,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=s_ind) - if (budget_pkgtype=='dyn') then - do n=1,thermo_budget_num_vars - ! Normalize energy sums and convert to W/s - if (ntrac>0.and.thermo_budget_vars_massv(n)) then - tmpfvm=0._r8 - if (elem(nets)%derived%budget_cnt(b_ind).gt.0.) then - do ie=nets,nete - tmpfvm(:,:,ie)=fvm(ie)%budget(:,:,n,s_ind)/elem(ie)%derived%budget_cnt(b_ind) - enddo - end if - else - tmpgll=0._r8 - if (elem(nets)%derived%budget_cnt(b_ind).gt.0.) then - do ie=nets,nete - tmpgll(:,:,ie)=elem(ie)%derived%budget(:,:,n,s_ind)/elem(ie)%derived%budget_cnt(b_ind) - end do - end if - end if - if (ntrac>0.and.thermo_budget_vars_massv(n)) then - budgets_global(b_ind,n) = global_integral(fvm, tmpfvm(:,:,nets:nete),hybrid,nc,nets,nete) - else - budgets_global(b_ind,n) = global_integral(elem, tmpgll(:,:,nets:nete),hybrid,np,nets,nete) - end if - ! divide by time for proper units if not a mass budget. - if (.not.thermo_budget_vars_massv(n)) & - budgets_global(b_ind,n)=budgets_global(b_ind,n)/dtime - if (masterproc) then - if (ntrac>0.and.thermo_budget_vars_massv(n)) then - write(iulog,*)"putting global from fvm ",trim(budget_name)," m_cnst=",n," ",budgets_global(b_ind,n)," cnt/subcyc/sum_tmp=",elem(nets)%derived%budget_cnt(b_ind),elem(nets)%derived%budget_subcycle(b_ind),sum(tmpfvm(:,:,nets)) - else - write(iulog,*)"putting global from elem ",trim(budget_name)," m_cnst=",n," ",budgets_global(b_ind,n)," cnt/subcyc/sum_tmp=",elem(nets)%derived%budget_cnt(b_ind),elem(nets)%derived%budget_subcycle(b_ind),sum(tmpgll(:,:,nets)) - end if - call budget_put_global(trim(budget_name),n,budgets_global(b_ind,n)) - end if - end do - end if - end do - deallocate(tmpgll) - if (ntrac > 0) deallocate(tmpfvm) - - ! reset dyn budget states and counts - do b_ind=1,budget_num - call budget_info(b_ind,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=s_ind) - if (budget_pkgtype=='dyn') then - if (masterproc) write(iulog,*)"resetting %budget for ",trim(budget_name) - do ie=nets,nete - elem(ie)%derived%budget(:,:,:,s_ind)=0._r8 - elem(ie)%derived%budget_cnt(b_ind)=0 - elem(ie)%derived%budget_subcycle(b_ind)=0 - if (ntrac>0) fvm(ie)%budget(:,:,:,s_ind)=0._r8 - end do - end if - end do - -end subroutine budget_update -!========================================================================================= -subroutine budget_update_dyn_cnts(elem,fvm,nets,nete,n0,n0_qdp,hybrid) - - use budgets, only: thermo_budget_history, budget_num, budget_info, budget_put_global - use element_mod, only: element_t - use fvm_control_volume_mod, only: fvm_struct - use global_norms_mod, only: global_integral - use air_composition, only: thermodynamic_active_species_liq_num, thermodynamic_active_species_ice_num - use prim_advance_mod, only: calc_tot_energy_dynamics_diff - use time_manager, only: get_step_size - use cam_thermo, only: thermo_budget_num_vars, & - thermo_budget_vars_massv,wvidx,wlidx,wiidx,seidx,keidx,moidx,mridx,ttidx,teidx - ! arguments - type (element_t) , intent(inout) :: elem(:) - type(fvm_struct) , intent(in) :: fvm(:) - type(hybrid_t) , intent(in) :: hybrid - integer , intent(in) :: n0, n0_qdp,nets,nete - - ! Local variables - character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn - character(len=64) :: name_out1,name_out2,name_out3,name_out4,name_out5,budget_name - integer :: budget_state_ind,s_ind,b_ind,i,n,ie - logical :: budget_outfld - - real(r8) :: budgets_global(budget_num,thermo_budget_num_vars) - - !-------------------------------------------------------------------------------------- - ! update energy budget differences and outfld - - if (thermo_budget_history) then - do b_ind = 1,budget_num - call budget_info(b_ind,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=s_ind,outfld=budget_outfld) - if (budget_pkgtype=='dyn') then - do ie=nets,nete - ! stage budget counts updated in calc_te on the first subcycle need to reset the subcycle count - elem(ie)%derived%budget_subcycle(b_ind)=0 - ! need to update dif and sum budget_counts for normalization - if (budget_optype=='dif'.or.budget_optype=='sum') & - elem(ie)%derived%budget_cnt(b_ind)=elem(ie)%derived%budget_cnt(b_ind)+1 - end do - end if - end do - end if - -end subroutine budget_update_dyn_cnts -!========================================================================================= end module dyn_comp diff --git a/src/physics/cam/cam_diagnostics.F90 b/src/physics/cam/cam_diagnostics.F90 index a11b95c1a4..e3e1675ff0 100644 --- a/src/physics/cam/cam_diagnostics.F90 +++ b/src/physics/cam/cam_diagnostics.F90 @@ -46,6 +46,18 @@ module cam_diagnostics diag_physvar_ic, & nsurf +integer, public, parameter :: num_stages = 8 +character (len = 4), dimension(num_stages) :: stage = (/"phBF","phBP","phAP","phAM","dyBF","dyBP","dyAP","dyAM"/) +character (len = 45),dimension(num_stages) :: stage_txt = (/& + " before energy fixer ",& !phBF - physics energy + " before parameterizations ",& !phBF - physics energy + " after parameterizations ",& !phAP - physics energy + " after dry mass correction ",& !phAM - physics energy + " before energy fixer (dycore) ",& !dyBF - dynamics energy + " before parameterizations (dycore) ",& !dyBF - dynamics energy + " after parameterizations (dycore) ",& !dyAP - dynamics energy + " after dry mass correction (dycore) " & !dyAM - dynamics energy + /) ! Private data @@ -74,6 +86,8 @@ module cam_diagnostics ! temperature, water vapor, cloud ice and cloud ! liquid budgets. integer :: history_budget_histfile_num ! output history file number for budget fields +logical :: thermo_budget_hist ! output budget +integer :: thermo_budget_hfile_num ! output history file number for budget fields logical :: history_waccm ! outputs typically used for WACCM ! Physics buffer indices @@ -179,10 +193,11 @@ subroutine diag_init_dry(pbuf2d) use constituent_burden, only: constituent_burden_init use physics_buffer, only: pbuf_set_field use tidal_diag, only: tidal_diag_init + use budgets, only: budget_add type(physics_buffer_desc), pointer, intent(in) :: pbuf2d(:,:) - integer :: k, m + integer :: k, m, istage integer :: ierr ! outfld calls in diag_phys_writeout call addfld (cnst_name(1), (/ 'lev' /), 'A', 'kg/kg', cnst_longname(1)) @@ -383,8 +398,31 @@ subroutine diag_init_dry(pbuf2d) call addfld( 'CPAIRV', (/ 'lev' /), 'I', 'J/K/kg', 'Variable specific heat cap air' ) call addfld( 'RAIRV', (/ 'lev' /), 'I', 'J/K/kg', 'Variable dry air gas constant' ) + if (thermo_budget_hist) then + ! + ! energy diagnostics addflds for vars_stage combinations plus budget_adds for + ! just the stages as the vars portion is accounted for via an extra array + ! dimension in the state%te_budgets array. + ! + do istage = 1, num_stages + call budget_add(TRIM(ADJUSTL(stage(istage))),'phy',longname=TRIM(ADJUSTL(stage_txt(istage))),outfld=.true.) + end do + + ! Create budgets that are a sum/dif of 2 stages + + call budget_add('BP_param_and_efix','phAP','phBF','phy','dif',longname='dE/dt CAM physics parameterizations + efix dycore E (phAP-phBF)',outfld=.true.) + call budget_add('BD_param_and_efix','dyAP','dyBF','phy','dif',longname='dE/dt CAM physics parameterizations + efix dycore E (dyAP-dyBF)',outfld=.true.) + call budget_add('BP_phy_params','phAP','phBP','phy','dif',longname='dE/dt CAM physics parameterizations (phAP-phBP)',outfld=.true.) + call budget_add('BD_phy_params','dyAP','dyBP','phy','dif',longname='dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)',outfld=.true.) + call budget_add('BP_pwork','phAM','phAP','phy','dif',longname='dE/dt dry mass adjustment (phAM-phAP)',outfld=.true.) + call budget_add('BD_pwork','dyAM','dyAP','phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)',outfld=.true.) + call budget_add('BP_efix','phBP','phBF','phy','dif',longname='dE/dt energy fixer (phBP-phBF)',outfld=.true.) + call budget_add('BD_efix','dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E (dyBP-dyBF)',outfld=.true.) + call budget_add('BP_phys_tot','phAM','phBF','phy','dif',longname='dE/dt physics total (phAM-phBF)',outfld=.true.) + call budget_add('BD_phys_tot','dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)',outfld=.true.) + endif end subroutine diag_init_dry - + subroutine diag_init_moist(pbuf2d) ! Declare the history fields for which this module contains outfld calls. @@ -693,6 +731,8 @@ subroutine diag_init(pbuf2d) type(physics_buffer_desc), pointer, intent(in) :: pbuf2d(:,:) + integer :: thermo_budget_hfile_num ! output history file number for budget fields + ! ---------------------------- ! determine default variables ! ---------------------------- @@ -701,7 +741,9 @@ subroutine diag_init(pbuf2d) history_eddy_out = history_eddy , & history_budget_out = history_budget , & history_budget_histfile_num_out = history_budget_histfile_num, & - history_waccm_out = history_waccm) + history_waccm_out = history_waccm, & + thermo_budget_hist_out = thermo_budget_hist, & + thermo_budget_hfile_num_out = thermo_budget_hfile_num) call diag_init_dry(pbuf2d) if (moist_physics) then diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index e094b890f9..79e686fdc6 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -45,28 +45,12 @@ module check_energy public :: check_energy_timestep_init ! timestep initialization of energy integrals and cumulative boundary fluxes public :: check_energy_chng ! check changes in integrals against cumulative boundary fluxes public :: check_energy_gmean ! global means of physics input and output total energy - public :: check_energy_budgets_init ! initialization of energy budgets (addflds and budget_adds) - public :: check_energy_budget_state_init ! initialization of energy budget integrals - public :: check_energy_phys_budget_update ! global budgets of physics energies - public :: check_energy_phys_cnt_update ! global budgets of physics energies public :: check_energy_fix ! add global mean energy difference as a heating public :: check_tracers_init ! initialize tracer integrals and cumulative boundary fluxes public :: check_tracers_chng ! check changes in integrals against cumulative boundary fluxes public :: calc_te_and_aam_budgets ! calculate and output total energy and axial angular momentum diagnostics - integer, public, parameter :: num_stages = 8 - character (len = 4), dimension(num_stages) :: stage = (/"phBF","phBP","phAP","phAM","dyBF","dyBP","dyAP","dyAM"/) - character (len = 45),dimension(num_stages) :: stage_txt = (/& - " before energy fixer ",& !phBF - physics energy - " before parameterizations ",& !phBF - physics energy - " after parameterizations ",& !phAP - physics energy - " after dry mass correction ",& !phAM - physics energy - " before energy fixer (dycore) ",& !dyBF - dynamics energy - " before parameterizations (dycore) ",& !dyBF - dynamics energy - " after parameterizations (dycore) ",& !dyAP - dynamics energy - " after dry mass correction (dycore) " & !dyAM - dynamics energy - /) ! Private module data @@ -322,98 +306,6 @@ subroutine check_energy_timestep_init(state, tend, pbuf, col_type) end subroutine check_energy_timestep_init -!=============================================================================== - - subroutine check_energy_budget_state_init(state) -!----------------------------------------------------------------------- -! Compute initial values of energy and water integrals, -! zero cumulative tendencies -!----------------------------------------------------------------------- - -!------------------------------Arguments-------------------------------- - - type(physics_state), intent(inout) :: state -!----------------------------------------------------------------------- - -! zero cummulative boundary fluxes - state%te_budgets(:,:,:) = 0._r8 - - end subroutine check_energy_budget_state_init - -!=============================================================================== - - subroutine check_energy_budgets_init() -!----------------------------------------------------------------------- -! Compute initial values of energy and water integrals, -! zero cumulative tendencies -!----------------------------------------------------------------------- - use budgets, only: budget_add, budget_info, budget_num - use cam_history, only: addfld, horiz_only - use cam_thermo, only: thermo_budget_num_vars,thermo_budget_vars, & - thermo_budget_vars_descriptor,thermo_budget_vars_unit -!---------------------------Local storage------------------------------- - ! - ! variables for energy diagnostics - ! - integer :: istage, ivars, i - character (len=256) :: str1, str2, str3 - character(len=32) :: budget_name ! budget names - character(len=3) :: budget_pkgtype,budget_optype - character(len=128) :: budget_longname ! long name of budgets -!----------------------------------------------------------------------- - -! -! energy diagnostics addflds for vars_stage combinations plus budget_adds for -! just the stages as the vars portion is accounted for via an extra array -! dimension in the state%te_budgets array. -! - do istage = 1, num_stages - do ivars=1, thermo_budget_num_vars - write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stage(istage))) - write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & - TRIM(ADJUSTL(stage_txt(istage))) - write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2))) - end do - call budget_add(TRIM(ADJUSTL(stage(istage))),'phy',longname=TRIM(ADJUSTL(stage_txt(istage))),outfld=.true.) - write(iulog,*)'Calling addfld for ',TRIM(ADJUSTL(stage(istage))) - call addfld (TRIM(ADJUSTL(stage(istage))), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(stage_txt(istage)))) - end do - - ! Create budgets that are a sum/dif of 2 stages - - call budget_add('BP_param_and_efix','phAP','phBF','phy','dif',longname='dE/dt CAM physics parameterizations + efix dycore E (phAP-phBF)',outfld=.true.) - call budget_add('BD_param_and_efix','dyAP','dyBF','phy','dif',longname='dE/dt CAM physics parameterizations + efix dycore E (dyAP-dyBF)',outfld=.true.) - call budget_add('BP_phy_params','phAP','phBP','phy','dif',longname='dE/dt CAM physics parameterizations (phAP-phBP)',outfld=.true.) - call budget_add('BD_phy_params','dyAP','dyBP','phy','dif',longname='dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)',outfld=.true.) - call budget_add('BP_pwork','phAM','phAP','phy','dif',longname='dE/dt dry mass adjustment (phAM-phAP)',outfld=.true.) - call budget_add('BD_pwork','dyAM','dyAP','phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)',outfld=.true.) - call budget_add('BP_efix','phBP','phBF','phy','dif',longname='dE/dt energy fixer (phBP-phBF)',outfld=.true.) - call budget_add('BD_efix','dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E (dyBP-dyBF)',outfld=.true.) - call budget_add('BP_phys_tot','phAM','phBF','phy','dif',longname='dE/dt physics total (phAM-phBF)',outfld=.true.) - call budget_add('BD_phys_tot','dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)',outfld=.true.) - - ! create addfld calls for all two stage budgets - do i=1,budget_num - call budget_info(i,name=budget_name,longname=budget_longname,pkgtype=budget_pkgtype,optype=budget_optype) - if (budget_pkgtype=='phy'.and.(budget_optype=='dif'.or.budget_optype=='sum')) then - do ivars=1, thermo_budget_num_vars - write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(budget_name)) - write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & - TRIM(ADJUSTL(budget_longname)) - write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) - write(iulog,*)'Calling addfld for ',TRIM(ADJUSTL(str1)) - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2))) - if (TRIM(ADJUSTL(thermo_budget_vars(ivars)))=='TE') then - write(iulog,*)'Calling addfld for ',TRIM(ADJUSTL(budget_name)) - call addfld (TRIM(ADJUSTL(budget_name)), horiz_only, 'A', 'J/m2',TRIM(ADJUSTL(budget_longname))) - end if - end do - end if - end do - - end subroutine check_energy_budgets_init - !=============================================================================== subroutine check_energy_chng(state, tend, name, nstep, ztodt, & @@ -582,7 +474,6 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & end if end subroutine check_energy_chng - subroutine check_energy_gmean(state, pbuf2d, dtime, nstep) use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_chunk @@ -648,161 +539,6 @@ subroutine check_energy_gmean(state, pbuf2d, dtime, nstep) end subroutine check_energy_gmean - subroutine check_energy_phys_budget_update(state, dtime, nstep) - - use cam_history, only: outfld - use budgets, only: budget_num, budget_info, & - budget_outfld, budget_num_phy, & - budget_put_global - use cam_thermo, only: thermo_budget_num_vars, thermo_budget_vars_massv - use cam_abortutils, only: endrun - use dycore_budget, only: print_budget -!----------------------------------------------------------------------- -! Compute global mean total energy of physics input and output states -! computed consistently with dynamical core vertical coordinate -! (under hydrostatic assumption) -!----------------------------------------------------------------------- -!------------------------------Arguments-------------------------------- - - type(physics_state), intent(inout ), dimension(begchunk:endchunk) :: state - - real(r8), intent(in) :: dtime ! physics time step - integer , intent(in) :: nstep ! current timestep number - -!---------------------------Local storage------------------------------- - integer :: ncol ! number of active columns - integer :: lchnk ! chunk index - - real(r8),allocatable :: te(:,:,:,:) ! total energy of input/output states (copy) - real(r8),allocatable :: te_glob(:,:) ! global means of total energy - integer :: i,ii,s_ind,is1,is2,is1b,is2b - character*32 :: budget_name ! parameterization name for fluxes - character*3 :: budget_pkgtype ! parameterization type phy or dyn - character*3 :: budget_optype ! dif or stg -!----------------------------------------------------------------------- - if (.not.allocated (te)) then - allocate( te(pcols,begchunk:endchunk,budget_num_phy,thermo_budget_num_vars)) - end if - if (.not.allocated (te_glob)) then - allocate( te_glob(budget_num_phy,thermo_budget_num_vars)) - else - write(iulog,*)'no alloc call shape te_glob=',shape(te_glob) - end if - te=0.0_r8 - te_glob=0.0_r8 - - ! calculate energy budget differences - do lchnk = begchunk, endchunk - ncol = state(lchnk)%ncol - do ii=1,budget_num - call budget_info(ii,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=i) - if (budget_pkgtype=='phy') then - if (budget_optype=='dif') then - call budget_info(ii,stg1stateidx=is1, stg2stateidx=is2,stg1index=is1b,stg2index=is2b) - if (state(lchnk)%budget_cnt(is1b).ne.state(lchnk)%budget_cnt(is2b)) then - if (lchnk==begchunk.and.masterproc) write(iulog,*)'budget_cnt mismatch stage1=',state(lchnk)%budget_cnt(is1b),'stage2=',state(lchnk)%budget_cnt(is2b) - call endrun() - end if - if (state(lchnk)%budget_cnt(is1b)==0.or.state(lchnk)%budget_cnt(is2b)==0) then - te(:,lchnk,i,:)=0._r8 - if (lchnk==begchunk.and.masterproc) write(iulog,*)'zeroing:',budget_name,' cnt1:',state(lchnk)%budget_cnt(is1b),' cnt2 ',state(lchnk)%budget_cnt(is2b) - else - if (lchnk==begchunk.and.masterproc) write(iulog,*)'dif and norm into te:',budget_name,' cnt:',state(lchnk)%budget_cnt(ii),' cnt1:',state(lchnk)%budget_cnt(is1b),'budget index ii/is1b=',ii,'/',is1b - te(:,lchnk,i,:) = (state(lchnk)%te_budgets(:,:,is1)-state(lchnk)%te_budgets(:,:,is2))/state(lchnk)%budget_cnt(is1b) - end if - else if (budget_optype=='sum') then - call budget_info(ii,stg1stateidx=is1, stg2stateidx=is2,stg1index=is1b,stg2index=is2b) - if (state(lchnk)%budget_cnt(is1b).ne.state(lchnk)%budget_cnt(is2b)) then - if (lchnk==begchunk.and.masterproc) write(iulog,*)'budget_cnt mismatch stage1=',state(lchnk)%budget_cnt(is1b),'stage2=',state(lchnk)%budget_cnt(is2b) - call endrun() - end if - if (state(lchnk)%budget_cnt(is1b)==0.or.state(lchnk)%budget_cnt(is2b)==0) then - te(:,lchnk,i,:)=0._r8 - else - if (lchnk==begchunk.and.masterproc) write(iulog,*)'sum and norm into te:',budget_name,' cnt:',state(lchnk)%budget_cnt(ii),' cnt1:',state(lchnk)%budget_cnt(is1b),'budget index ii/is1b=',ii,'/',is1b - te(:,lchnk,i,:) = (state(lchnk)%te_budgets(:,:,is1)+state(lchnk)%te_budgets(:,:,is2))/state(lchnk)%budget_cnt(is1b) - end if - else - if (state(lchnk)%budget_cnt(ii)==0) then - te(:,lchnk,i,:)=0._r8 - if (lchnk==begchunk.and.masterproc) write(iulog,*)'zeroing:',budget_name,' cnt:',state(lchnk)%budget_cnt(ii),' ii=',ii,"current vals=",state(lchnk)%te_budgets(:,:,ii) - else - if (lchnk==begchunk.and.masterproc) write(iulog,*)'norm and read into te:',budget_name,' cnt:',state(lchnk)%budget_cnt(ii),'budget index=',ii - te(:,lchnk,i,:)=state(lchnk)%te_budgets(:,:,i)/state(lchnk)%budget_cnt(ii) - end if - end if - if (budget_outfld(i).and.budget_pkgtype=='phy') call outfld(trim(budget_name), te(:ncol,lchnk,i,1), pcols, lchnk) - end if - end do - end do - ! Compute global means of budgets - do i=1,thermo_budget_num_vars - call gmean(te(:,:,:,i), te_glob(:,i), budget_num_phy) - !divide by time to get flux if not a mass budget - if (.not.thermo_budget_vars_massv(i)) te_glob(:,i)=te_glob(:,i)/dtime - end do - - if (masterproc) then - do ii=1,budget_num - call budget_info(ii,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=s_ind) - if (budget_pkgtype=='phy') then - do i=1,thermo_budget_num_vars - call budget_put_global(trim(budget_name),i,te_glob(s_ind,i)) - if (budget_optype=='dif'.or.budget_optype=='sum') then - call budget_info(ii,stg1index=is1b) - write(iulog,*)"putting global ",trim(budget_name)," m_cnst=",i," ",te_glob(s_ind,i)," cnt=",state(begchunk)%budget_cnt(is1b),"is1b=",is1b - else - write(iulog,*)"putting global ",trim(budget_name)," m_cnst=",i," ",te_glob(s_ind,i)," cnt=",state(begchunk)%budget_cnt(ii),"ii=",ii - end if - end do - end if - end do - end if - call print_budget() - do lchnk = begchunk, endchunk - state(lchnk)%budget_cnt(:)=0._r8 - state(lchnk)%te_budgets(:,:,:)=0._r8 - end do - - end subroutine check_energy_phys_budget_update - subroutine check_energy_phys_cnt_update(state) - - use budgets, only: budget_num, budget_info, & - budget_outfld, budget_num_phy, & - budget_put_global - use cam_abortutils, only: endrun - use dycore_budget, only: print_budget -!----------------------------------------------------------------------- -! Compute global mean total energy of physics input and output states -! computed consistently with dynamical core vertical coordinate -! (under hydrostatic assumption) -!----------------------------------------------------------------------- -!------------------------------Arguments-------------------------------- - - type(physics_state), intent(inout ), dimension(begchunk:endchunk) :: state - -!---------------------------Local storage------------------------------- - integer :: ncol ! number of active columns - integer :: lchnk ! chunk index - - integer :: i,ii,s_ind,is1,is2,is1b,is2b - character*32 :: budget_name ! parameterization name for fluxes - character*3 :: budget_pkgtype ! parameterization type phy or dyn - character*3 :: budget_optype ! dif or stg -!----------------------------------------------------------------------- - do lchnk = begchunk, endchunk - ncol = state(lchnk)%ncol - do ii=1,budget_num - call budget_info(ii,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=i) - if (budget_pkgtype=='phy'.and.(budget_optype=='dif'.or.budget_optype=='sub')) then - state(lchnk)%budget_cnt(ii)=state(lchnk)%budget_cnt(ii)+1 - call budget_info(ii,stg1index=is1b,stg2index=is2b) - if (lchnk==begchunk .and. masterproc) write(iulog,*)trim(budget_name)," cnt(",ii,") updated to ",state(lchnk)%budget_cnt(ii),'stage1=',state(lchnk)%budget_cnt(is1b),'stage2=',state(lchnk)%budget_cnt(is2b),' is1b/is2b=',is1b,'/',is2b - end if - end do - end do - end subroutine check_energy_phys_cnt_update - !=============================================================================== subroutine check_energy_fix(state, ptend, nstep, eshflx) @@ -953,7 +689,6 @@ subroutine check_tracers_chng(state, tracerint, name, nstep, ztodt, cflx) integer :: m ! tracer index character(len=8) :: tracname ! tracername !----------------------------------------------------------------------- -!!$ if (.true.) return lchnk = state%lchnk ncol = state%ncol @@ -1060,6 +795,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) use cam_abortutils, only: endrun use budgets, only: budget_info_byname use cam_history_support, only: max_fieldname_len + use shr_assert_mod, only: shr_assert_in_domain !------------------------------Arguments-------------------------------- type(physics_state), intent(inout) :: state @@ -1088,7 +824,6 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) integer :: vc_loc ! local vertical coordinate variable integer :: s_ind,b_ind ! budget array index integer :: ixtt ! test tracer index - character(len=32) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6,name_out7 character(len=max_fieldname_len) :: name_out(thermo_budget_num_vars) !----------------------------------------------------------------------- @@ -1097,13 +832,6 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) do i=1,thermo_budget_num_vars name_out(i)=trim(thermo_budget_vars(i))//'_'//trim(outfld_name_suffix) end do - name_out1 = 'SE_' //trim(outfld_name_suffix) - name_out2 = 'KE_' //trim(outfld_name_suffix) - name_out3 = 'WV_' //trim(outfld_name_suffix) - name_out4 = 'WL_' //trim(outfld_name_suffix) - name_out5 = 'WI_' //trim(outfld_name_suffix) - name_out6 = 'TT_' //trim(outfld_name_suffix) - name_out7 = 'TE_' //trim(outfld_name_suffix) lchnk = state%lchnk ncol = state%ncol @@ -1145,11 +873,14 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) po = po(1:ncol), ke = ke(1:ncol), wv = wv(1:ncol), liq = liq(1:ncol), & ice = ice(1:ncol)) + call shr_assert_in_domain(ke(:), is_nan=.false., & + varname="ke", msg='ke out of get_hydro has nan'//trim(outfld_name_suffix)) + call cnst_get_ind('TT_LW' , ixtt , abort=.false.) tt = 0._r8 if (ixtt > 1) then - if (name_out6 == 'TT_pAM'.or.name_out6 == 'TT_zAM') then + if (name_out(ttidx) == 'TT_pAM'.or.name_out(ttidx) == 'TT_zAM') then ! ! after dme_adjust mixing ratios are all wet ! @@ -1169,32 +900,14 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) end if end if - state%te_budgets(1:ncol,teidx,s_ind)=state%te_budgets(1:ncol,teidx,s_ind)+se(1:ncol)+ke(1:ncol)+po(1:ncol) - state%te_budgets(1:ncol,seidx,s_ind)= state%te_budgets(1:ncol,seidx,s_ind)+se(1:ncol) - state%te_budgets(1:ncol,poidx,s_ind)= state%te_budgets(1:ncol,poidx,s_ind)+po(1:ncol) - state%te_budgets(1:ncol,keidx,s_ind)= state%te_budgets(1:ncol,keidx,s_ind)+ke(1:ncol) - state%te_budgets(1:ncol,wvidx,s_ind)= state%te_budgets(1:ncol,wvidx,s_ind)+wv(1:ncol) - state%te_budgets(1:ncol,wlidx,s_ind)= state%te_budgets(1:ncol,wlidx,s_ind)+liq(1:ncol) - state%te_budgets(1:ncol,wiidx,s_ind)= state%te_budgets(1:ncol,wiidx,s_ind)+ice(1:ncol) - state%te_budgets(1:ncol,ttidx,s_ind)= state%te_budgets(1:ncol,ttidx,s_ind)+tt(1:ncol) - state%budget_cnt(b_ind)=state%budget_cnt(b_ind)+1 - ! Output energy diagnostics - - call outfld(name_out1 ,se+po ,pcols ,lchnk ) - call outfld(name_out2 ,ke ,pcols ,lchnk ) - call outfld(name_out3 ,wv ,pcols ,lchnk ) - call outfld(name_out4 ,liq ,pcols ,lchnk ) - call outfld(name_out5 ,ice ,pcols ,lchnk ) - call outfld(name_out6 ,tt ,pcols ,lchnk ) - call outfld(name_out7 ,se+ke+po ,pcols ,lchnk ) - -!!$ call outfld(name_out(seidx) ,se , pcols ,lchnk ) -!!$ call outfld(name_out(keidx) ,ke , pcols ,lchnk ) -!!$ call outfld(name_out(wiidx) ,wv , pcols ,lchnk ) -!!$ call outfld(name_out(wlidx) ,liq , pcols ,lchnk ) -!!$ call outfld(name_out(wiidx) ,ice , pcols ,lchnk ) -!!$ call outfld(name_out(ttidx) ,tt , pcols ,lchnk ) -!!$ call outfld(name_out(teidx) ,te , pcols ,lchnk ) + + call outfld(name_out(seidx) ,se+po , pcols ,lchnk ) + call outfld(name_out(keidx) ,ke , pcols ,lchnk ) + call outfld(name_out(wvidx) ,wv , pcols ,lchnk ) + call outfld(name_out(wlidx) ,liq , pcols ,lchnk ) + call outfld(name_out(wiidx) ,ice , pcols ,lchnk ) + call outfld(name_out(ttidx) ,tt , pcols ,lchnk ) + call outfld(name_out(teidx) ,se+ke+po , pcols ,lchnk ) ! ! Axial angular momentum diagnostics @@ -1209,10 +922,6 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) ! MR is equation (6) without \Delta A and sum over areas (areas are in units of radians**2) ! MO is equation (7) without \Delta A and sum over areas (areas are in units of radians**2) ! - name_out1 = 'MR_' //trim(outfld_name_suffix) - name_out2 = 'MO_' //trim(outfld_name_suffix) - -!!jt if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2)) then lchnk = state%lchnk ncol = state%ncol @@ -1231,14 +940,10 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) mo(i) = mo(i) + mo_tmp end do end do - state%te_budgets(1:ncol,moidx,s_ind)=mo(1:ncol) - state%te_budgets(1:ncol,mridx,s_ind)=mr(1:ncol) + call outfld(name_out(mridx) ,mr, pcols,lchnk ) call outfld(name_out(moidx) ,mo, pcols,lchnk ) - call outfld(name_out1 ,mr, pcols,lchnk ) - call outfld(name_out2 ,mo, pcols,lchnk ) -!!jt end if end subroutine calc_te_and_aam_budgets diff --git a/src/physics/cam/phys_control.F90 b/src/physics/cam/phys_control.F90 index 08962c816a..ea600a674d 100644 --- a/src/physics/cam/phys_control.F90 +++ b/src/physics/cam/phys_control.F90 @@ -57,11 +57,13 @@ module phys_control logical :: history_aero_optics = .false. ! output the aerosol logical :: history_eddy = .false. ! output the eddy variables logical :: history_budget = .false. ! output tendencies and state variables for CAM4 +logical :: thermo_budget_hist = .false. ! output thermo budget for CAM ! temperature, water vapor, cloud ice and cloud ! liquid budgets. logical :: convproc_do_aer = .false. ! switch for new convective scavenging treatment for modal aerosols integer :: history_budget_histfile_num = 1 ! output history file number for budget fields +integer :: thermo_budget_hfile_num = 2 ! output history file number for thermo budget fields logical :: history_waccm = .false. ! output variables of interest for WACCM runs logical :: history_waccmx = .false. ! output variables of interest for WACCM-X runs logical :: history_chemistry = .true. ! output default chemistry-related variables @@ -134,7 +136,8 @@ subroutine phys_ctl_readnl(nlfile) do_clubb_sgs, state_debug_checks, use_hetfrz_classnuc, use_gw_oro, use_gw_front, & use_gw_front_igw, use_gw_convect_dp, use_gw_convect_sh, cld_macmic_num_steps, & offline_driver, convproc_do_aer, cam_snapshot_before_num, cam_snapshot_after_num, & - cam_take_snapshot_before, cam_take_snapshot_after, cam_physics_mesh + cam_take_snapshot_before, cam_take_snapshot_after, cam_physics_mesh, & + thermo_budget_hist, thermo_budget_hfile_num !----------------------------------------------------------------------------- if (masterproc) then @@ -172,6 +175,8 @@ subroutine phys_ctl_readnl(nlfile) call mpi_bcast(history_aero_optics, 1, mpi_logical, masterprocid, mpicom, ierr) call mpi_bcast(history_budget, 1, mpi_logical, masterprocid, mpicom, ierr) call mpi_bcast(history_budget_histfile_num, 1, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(thermo_budget_hist, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(thermo_budget_hfile_num, 1, mpi_integer, masterprocid, mpicom, ierr) call mpi_bcast(history_waccm, 1, mpi_logical, masterprocid, mpicom, ierr) call mpi_bcast(history_waccmx, 1, mpi_logical, masterprocid, mpicom, ierr) call mpi_bcast(history_chemistry, 1, mpi_logical, masterprocid, mpicom, ierr) @@ -312,7 +317,8 @@ subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, mi cam_chempkg_out, prog_modal_aero_out, macrop_scheme_out, & do_clubb_sgs_out, use_spcam_out, state_debug_checks_out, cld_macmic_num_steps_out, & offline_driver_out, convproc_do_aer_out, cam_snapshot_before_num_out, cam_snapshot_after_num_out,& - cam_take_snapshot_before_out, cam_take_snapshot_after_out, physics_grid_out) + cam_take_snapshot_before_out, cam_take_snapshot_after_out, physics_grid_out,& + thermo_budget_hist_out, thermo_budget_hfile_num_out) !----------------------------------------------------------------------- ! Purpose: Return runtime settings ! deep_scheme_out : deep convection scheme @@ -339,6 +345,8 @@ subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, mi logical, intent(out), optional :: history_aero_optics_out logical, intent(out), optional :: history_budget_out integer, intent(out), optional :: history_budget_histfile_num_out + logical, intent(out), optional :: thermo_budget_hist_out + integer, intent(out), optional :: thermo_budget_hfile_num_out logical, intent(out), optional :: history_waccm_out logical, intent(out), optional :: history_waccmx_out logical, intent(out), optional :: history_chemistry_out @@ -374,10 +382,12 @@ subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, mi if ( present(history_aerosol_out ) ) history_aerosol_out = history_aerosol if ( present(history_aero_optics_out ) ) history_aero_optics_out = history_aero_optics if ( present(history_budget_out ) ) history_budget_out = history_budget + if ( present(thermo_budget_hist_out) ) thermo_budget_hist_out = thermo_budget_hist if ( present(history_amwg_out ) ) history_amwg_out = history_amwg if ( present(history_vdiag_out ) ) history_vdiag_out = history_vdiag if ( present(history_eddy_out ) ) history_eddy_out = history_eddy if ( present(history_budget_histfile_num_out ) ) history_budget_histfile_num_out = history_budget_histfile_num + if ( present(thermo_budget_hfile_num_out ) ) thermo_budget_hfile_num_out = thermo_budget_hfile_num if ( present(history_waccm_out ) ) history_waccm_out = history_waccm if ( present(history_waccmx_out ) ) history_waccmx_out = history_waccmx if ( present(history_chemistry_out ) ) history_chemistry_out = history_chemistry diff --git a/src/physics/cam/physics_types.F90 b/src/physics/cam/physics_types.F90 index ace701d4bd..4ac020a1e8 100644 --- a/src/physics/cam/physics_types.F90 +++ b/src/physics/cam/physics_types.F90 @@ -14,7 +14,6 @@ module physics_types use cam_abortutils, only: endrun use phys_control, only: waccmx_is use shr_const_mod, only: shr_const_rwv - use budgets, only: budget_array_max,budget_name implicit none private ! Make default type private to the module @@ -108,9 +107,6 @@ module physics_types real(r8), dimension(:,:),allocatable :: & temp_ini, &! Temperature of initial state (used for energy computations) z_ini ! Height of initial state (used for energy computations) - real(r8), dimension(:,:,:),allocatable :: & - te_budgets ! te budget array - integer, allocatable :: budget_cnt(:) ! budget counter integer :: count ! count of values with significant energy or water imbalances integer, dimension(:),allocatable :: & latmapback, &! map from column to unique lat for that column @@ -598,17 +594,6 @@ subroutine physics_state_check(state, name) call shr_assert_in_domain(state%q(:ncol,:,:), is_nan=.false., & varname="state%q", msg=msg) - ! Budget variables - do m = 1,budget_array_max - call shr_assert_in_domain(state%te_budgets(:ncol,:,m), is_nan=.false., & - varname="state%te_budgets ("//trim(budget_name(m))//")", msg=msg) - end do - - do m = 1,budget_array_max - call shr_assert_in_domain(state%budget_cnt(m), is_nan=.false., & - varname="state%budget_cnt ("//trim(budget_name(m))//")", msg=msg) - end do - ! Now run other checks (i.e. values are finite and within a range that ! is physically meaningful). @@ -689,11 +674,6 @@ subroutine physics_state_check(state, name) varname="state%q ("//trim(cnst_name(m))//")", msg=msg) end do - ! Budget variables - do m = 1,budget_array_max - call shr_assert_in_domain(state%te_budgets(:ncol,:,m), lt=posinf_r8, gt=neginf_r8, & - varname="state%te_budgets ("//trim(budget_name(m))//")", msg=msg) - end do end subroutine physics_state_check !=============================================================================== @@ -1320,7 +1300,6 @@ subroutine physics_state_copy(state_in, state_out) use ppgrid, only: pver, pverp use constituents, only: pcnst - use cam_thermo, only: thermo_budget_num_vars implicit none @@ -1410,18 +1389,6 @@ subroutine physics_state_copy(state_in, state_out) end do end do - do m = 1, budget_array_max - do k = 1, thermo_budget_num_vars - do i = 1, ncol - state_out%te_budgets(i,k,m) = state_in%te_budgets(i,k,m) - end do - end do - end do - - do m = 1, budget_array_max - state_out%budget_cnt(m) = state_in%budget_cnt(m) - end do - end subroutine physics_state_copy !=============================================================================== @@ -1539,7 +1506,6 @@ end subroutine set_dry_to_wet subroutine physics_state_alloc(state,lchnk,psetcols) use infnan, only: inf, assignment(=) - use cam_thermo, only: thermo_budget_num_vars ! allocate the individual state components @@ -1630,12 +1596,6 @@ subroutine physics_state_alloc(state,lchnk,psetcols) allocate(state%q(psetcols,pver,pcnst), stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%q') - allocate(state%te_budgets(psetcols,thermo_budget_num_vars,budget_array_max), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%te_budgets') - - allocate(state%budget_cnt(budget_array_max), stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%budget_cnt') - allocate(state%pint(psetcols,pver+1), stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%pint') @@ -1701,8 +1661,6 @@ subroutine physics_state_alloc(state,lchnk,psetcols) state%exner(:,:) = inf state%zm(:,:) = inf state%q(:,:,:) = inf - state%te_budgets(:,:,:) = inf - state%budget_cnt(:) = 0 state%pint(:,:) = inf state%pintdry(:,:) = inf @@ -1830,12 +1788,6 @@ subroutine physics_state_dealloc(state) deallocate(state%z_ini, stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%z_ini') - deallocate(state%te_budgets, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%te_budgets') - - deallocate(state%budget_cnt, stat=ierr) - if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%budget_cnt') - deallocate(state%latmapback, stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%latmapback') diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 46528f4694..c1ca0b3fe6 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -776,7 +776,8 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use cam_snapshot, only: cam_snapshot_init use cam_history, only: addfld, register_vector_field, add_default, horiz_only use phys_control, only: phys_getopts - use check_energy, only: check_energy_budgets_init, check_energy_budget_state_init +!jt use check_energy, only: check_energy_budgets_init, check_energy_budget_state_init +!jt use check_energy, only: check_energy_budgets_init ! Input/output arguments type(physics_state), pointer :: phys_state(:) @@ -803,9 +804,9 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) do lchnk = begchunk, endchunk call physics_state_set_grid(lchnk, phys_state(lchnk)) - call check_energy_budget_state_init(phys_state(lchnk)) +!jt call check_energy_budget_state_init(phys_state(lchnk)) end do - call check_energy_budgets_init() +!jt call check_energy_budgets_init() !------------------------------------------------------------------------------------------- ! Initialize any variables in cam_thermo which are not temporally and/or spatially constant @@ -1064,7 +1065,8 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) use budgets, only: budget_write use time_manager, only: get_nstep use cam_diagnostics,only: diag_allocate, diag_physvar_ic - use check_energy, only: check_energy_gmean, check_energy_phys_budget_update, check_energy_phys_cnt_update +!jt use check_energy, only: check_energy_gmean, check_energy_phys_budget_update, check_energy_phys_cnt_update + use check_energy, only: check_energy_gmean use phys_control, only: phys_getopts use spcam_drivers, only: tphysbc_spcam use spmd_utils, only: mpicom @@ -1118,13 +1120,13 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) call t_startf ('chk_en_gmean') call check_energy_gmean(phys_state, pbuf2d, ztodt, nstep) call t_stopf ('chk_en_gmean') - call t_startf ('chk_en_p_budget_update') - if(budget_write()) then - call check_energy_phys_budget_update(phys_state, ztodt, nstep) - else - call check_energy_phys_cnt_update(phys_state) - end if - call t_stopf ('chk_en_p_budget_update') +!!$ call t_startf ('chk_en_p_budget_update') +!!$ if(budget_write()) then +!!$ call check_energy_phys_budget_update(phys_state, ztodt, nstep) +!!$ else +!!$ call check_energy_phys_cnt_update(phys_state) +!!$ end if +!!$ call t_stopf ('chk_en_p_budget_update') call t_stopf ('physpkg_st1') diff --git a/src/utils/cam_grid_support.F90 b/src/utils/cam_grid_support.F90 index 30ffe78576..7e61a44cb3 100644 --- a/src/utils/cam_grid_support.F90 +++ b/src/utils/cam_grid_support.F90 @@ -314,6 +314,8 @@ end subroutine print_attr_spec public :: cam_grid_is_zonal ! Functions for dealing with patch masks public :: cam_grid_compute_patch + ! Functions for dealing with grid areas + public :: cam_grid_get_area interface cam_grid_attribute_register module procedure add_cam_grid_attribute_0d_int @@ -1616,6 +1618,55 @@ function cam_grid_get_lonvals(id) result(lonvals) end if end function cam_grid_get_lonvals + function cam_grid_get_area(id) result(areavals) + + ! Dummy argument + integer, intent(in) :: id + real(r8), pointer :: areavals(:) + + ! Local variables + character(len=max_chars) :: areaname + integer :: gridind + type(cam_grid_attribute_1d_r8_t), pointer :: attrptr_r8 + class(cam_grid_attribute_t), pointer :: attrptr + character(len=120) :: errormsg + + nullify(attrptr_r8) + nullify(attrptr) + gridind = get_cam_grid_index(id) + if (gridind > 0) then + select case(cam_grids(gridind)%name) + case('GLL') + areaname='area_d' + case('INI') + areaname='area' + case('FVM') + areaname='area_fvm' + case default + call endrun('cam_grid_get_area: Invalid gridname:'//trim(cam_grids(gridind)%name)) + end select + + call find_cam_grid_attr(gridind, trim(areaname), attrptr) + if (.not.associated(attrptr)) then + write(errormsg, '(4a)') & + 'cam_grid_get_area: error retrieving area ', trim(areaname), & + ' for cam grid ', cam_grids(gridind)%name + call endrun(errormsg) + else + call attrptr%print_attr() + select type(attrptr) + type is (cam_grid_attribute_1d_r8_t) + !jt attrptr_r8 => attrptr + areavals => attrptr%values + class default + call endrun('cam_grid_get_area: area attribute is not a real datatype') +!jt areavals => null() + end select + end if + end if + + end function cam_grid_get_area + ! Find the longitude and latitude of a range of map entries ! beg and end are the range of the first source index. blk is a block or chunk index subroutine cam_grid_get_coords(id, beg, end, blk, lon, lat) diff --git a/src/utils/cam_thermo.F90 b/src/utils/cam_thermo.F90 index 271782d815..8623b6fce7 100644 --- a/src/utils/cam_thermo.F90 +++ b/src/utils/cam_thermo.F90 @@ -1790,6 +1790,6 @@ subroutine get_hydrostatic_energy_1hd(tracer, moist_mixing_ratio, pdel_in, & end select end if deallocate(species_idx, species_liq_idx, species_ice_idx) - end subroutine get_hydrostatic_energy_1hd + end subroutine get_hydrostatic_energy_1hd end module cam_thermo From b0ceae63d7384f3abba7fa472f0cdc0d2aacb3b6 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Wed, 22 Feb 2023 13:34:38 -0700 Subject: [PATCH 062/140] lots of science changes: - all water in pressure - energy fixer using energy consistent with SE dycore (similar to MPAS) - no frictional heating in sponge - moving towards meaningful log file energy text --- src/dynamics/mpas/dycore_budget.F90 | 2 +- src/dynamics/se/dp_coupling.F90 | 73 +- src/dynamics/se/dycore/prim_advance_mod.F90 | 57 +- src/dynamics/se/dycore_budget.F90 | 743 +++++++++++++------- src/physics/cam/check_energy.F90 | 206 +++--- src/physics/cam/physics_types.F90 | 42 +- src/physics/cam/physpkg.F90 | 8 +- src/physics/cam_dev/physpkg.F90 | 12 +- src/utils/air_composition.F90 | 137 ++-- src/utils/cam_thermo.F90 | 51 +- 10 files changed, 822 insertions(+), 509 deletions(-) diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index ada3f2ab49..57d7e3db60 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -185,7 +185,7 @@ subroutine print_budget() end if write(iulog,*)" " write(iulog,*)"-------------------------------------------------------------------------" - write(iulog,*)" Consistency check 2: total energy increment in dynamics same as phyiscs?" + write(iulog,*)" Consistency check 2: total energy increment in dynamics same as physics?" write(iulog,*)"-------------------------------------------------------------------------" write(iulog,*)" " diff = abs_diff(mpas_param,dy_param+dy_EFIX,pf=pf) diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index 47243577a0..45231b17e6 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -379,9 +379,8 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) end do end do end do - call thermodynamic_consistency( & - phys_state(lchnk), phys_tend(lchnk), ncols, pver, lchnk) - end do + call thermodynamic_consistency(phys_state(lchnk), phys_tend(lchnk), ncols, pver, lchnk) + end do call t_startf('pd_copy') !$omp parallel do num_threads(max_num_threads) private (col_ind, lchnk, icol, ie, blk_ind, ilyr, m) @@ -541,12 +540,10 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) use constituents, only: qmin use physconst, only: gravit, zvir - use cam_thermo, only: cam_thermo_update -#ifndef phl_cam_development + use cam_thermo, only: cam_thermo_dry_air_update, cam_thermo_water_update use air_composition, only: thermodynamic_active_species_num use air_composition, only: thermodynamic_active_species_idx -#endif - use air_composition, only: cpairv, rairv, cappav + use air_composition, only: cpairv, rairv, cappav, dry_air_species_num use shr_const_mod, only: shr_const_rwv use phys_control, only: waccmx_is use geopotential, only: geopotential_t @@ -608,16 +605,6 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) end do ! wet pressure variables (should be removed from physics!) -!#define phl_cam_development -#ifdef phl_cam_development - do k=1,nlev - do i=1,ncol - ! to be consistent with total energy formula in physic's check_energy module only - ! include water vapor in in moist dp - factor_array(i,k) = 1+phys_state(lchnk)%q(i,k,1) - end do - end do -#else factor_array(:,:) = 1.0_r8 do m_cnst=1,thermodynamic_active_species_num m = thermodynamic_active_species_idx(m_cnst) @@ -628,7 +615,7 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) end do end do end do -#endif + do k=1,nlev do i=1,ncol phys_state(lchnk)%pdel (i,k) = phys_state(lchnk)%pdeldry(i,k)*factor_array(i,k) @@ -658,44 +645,46 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) end do end do - ! all tracers (including moisture) are in dry mixing ratio units - ! physics expect water variables moist - factor_array(1:ncol,1:nlev) = 1/factor_array(1:ncol,1:nlev) - - do m = 1,pcnst - if (cnst_type(m) == 'wet') then - do k = 1, nlev - do i = 1, ncol - phys_state(lchnk)%q(i,k,m) = factor_array(i,k)*phys_state(lchnk)%q(i,k,m) - end do - end do - end if - end do - - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - !------------------------------------------------------------ - ! Apply limiters to mixing ratios of major species - !------------------------------------------------------------ + !------------------------------------------------------------ + ! Apply limiters to mixing ratios of major species (waccmx) + !------------------------------------------------------------ + if (dry_air_species_num>0) then call physics_cnst_limit( phys_state(lchnk) ) !----------------------------------------------------------------------------- - ! Call cam_thermo_update to compute cpairv, rairv, mbarv, and cappav as + ! Call cam_thermo_dry_air_update to compute cpairv, rairv, mbarv, and cappav as ! constituent dependent variables. ! Compute molecular viscosity(kmvis) and conductivity(kmcnd). ! Fill local zvirv variable; calculated for WACCM-X. !----------------------------------------------------------------------------- - call cam_thermo_update(phys_state(lchnk)%q, phys_state(lchnk)%t, lchnk, ncol,& - to_moist_factor=phys_state(lchnk)%pdeldry(:ncol,:)/phys_state(lchnk)%pdel(:ncol,:) ) + call cam_thermo_dry_air_update(phys_state(lchnk)%q, phys_state(lchnk)%t, lchnk, ncol) zvirv(:,:) = shr_const_rwv / rairv(:,:,lchnk) -1._r8 else zvirv(:,:) = zvir - endif - + end if + ! + ! update cp_dycore in modeule air_composition. + ! (note: at this point q is dry) + ! + call cam_thermo_water_update(phys_state(lchnk)%q(1:ncol,:,:), lchnk, ncol) do k = 1, nlev do i = 1, ncol phys_state(lchnk)%exner(i,k) = (phys_state(lchnk)%pint(i,pver+1) & / phys_state(lchnk)%pmid(i,k))**cappav(i,k,lchnk) end do end do + ! + ! CAM physics: water tracers are moist; the rest dry + ! + factor_array(1:ncol,1:nlev) = 1/factor_array(1:ncol,1:nlev) + do m = 1,pcnst + if (cnst_type(m) == 'wet') then + do k = 1, nlev + do i = 1, ncol + phys_state(lchnk)%q(i,k,m) = factor_array(i,k)*phys_state(lchnk)%q(i,k,m) + end do + end do + end if + end do ! Compute initial geopotential heights - based on full pressure call geopotential_t (phys_state(lchnk)%lnpint, phys_state(lchnk)%lnpmid , phys_state(lchnk)%pint , & @@ -752,7 +741,7 @@ subroutine thermodynamic_consistency(phys_state, phys_tend, ncols, pver, lchnk) ! note that if lcp_moist=.false. then there is thermal energy increment ! consistency (not taking into account dme adjust) ! - call get_cp(phys_state%q(1:ncols,1:pver,:), .true., inv_cp) + call get_cp(phys_state%q(1:ncols,1:pver,:), .true.,inv_cp, cpdry=cpairv(1:ncols,:,lchnk)) phys_tend%dtdt(1:ncols,1:pver) = phys_tend%dtdt(1:ncols,1:pver) * cpairv(1:ncols,1:pver,lchnk) * inv_cp end if end subroutine thermodynamic_consistency diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index 0e1b084170..1ae86801b6 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -124,16 +124,16 @@ subroutine prim_advance_exp(elem, fvm, deriv, hvcoord, hybrid,dt, tl, nets, net ! ! make sure Q is updated ! - qwater(:,:,:,nq,ie) = elem(ie)%state%Qdp(:,:,:,m_cnst,qn0)/elem(ie)%state%dp3d(:,:,:,n0) + qwater(:,:,:,nq,ie) = elem(ie)%state%Qdp(:,:,:,m_cnst,qn0)/elem(ie)%state%dp3d(:,:,:,n0) end do end do ! - ! compute Cp and kappa=Rdry/cpdry here and not in RK-stages since Q stays constant => Cp and kappa also stays constant + ! compute Cp and kappa=Rdry/cpdry here and not in RK-stages since Q stays constant ! if (lcp_moist) then do ie=nets,nete - call get_cp(qwater(:,:,:,:,ie),& - .true., inv_cp_full(:,:,:,ie), active_species_idx_dycore=qidx) + call get_cp(qwater(:,:,:,:,ie),.true.,& + inv_cp_full(:,:,:,ie), active_species_idx_dycore=qidx) end do else do ie=nets,nete @@ -399,15 +399,13 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu if (ntrac>0) ftmp_fvm(:,:,:,:,ie) = 0.0_r8 end if - if (ftype_conserve==1) then call get_dp(elem(ie)%state%Qdp(:,:,:,1:qsize,np1_qdp), MASS_MIXING_RATIO, & - thermodynamic_active_species_idx_dycore, elem(ie)%state%dp3d(:,:,:,np1), pdel) + thermodynamic_active_species_idx_dycore, elem(ie)%state%dp3d(:,:,:,np1), pdel) do k=1,nlev do j=1,np do i = 1,np pdel(i,j,k)=elem(ie)%derived%FDP(i,j,k)/pdel(i,j,k) - elem(ie)%state%T(i,j,k,np1) = elem(ie)%state%T(i,j,k,np1) + & dt_local*elem(ie)%derived%FT(i,j,k)*pdel(i,j,k) ! @@ -680,7 +678,10 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dCH',subcycle=.true.) do ie=nets,nete !$omp parallel do num_threads(vert_num_threads), private(k,i,j,v1,v2,heating) - do k=kbeg,kend + do k=ksponge_end,nlev + ! + ! only do "frictional heating" away from del2 sponge + ! !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,np @@ -946,12 +947,6 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, v2new=elem(ie)%state%v(i,j,2,k,nt) v1 =elem(ie)%state%v(i,j,1,k,nt)- vtens(i,j,1,k,ie) v2 =elem(ie)%state%v(i,j,2,k,nt)- vtens(i,j,2,k,ie) - ! - ! frictional heating - ! - heating = 0.5_r8*(v1new*v1new+v2new*v2new-(v1*v1+v2*v2)) - elem(ie)%state%T(i,j,k,nt)=elem(ie)%state%T(i,j,k,nt) & - -heating*inv_cp_full(i,j,k,ie) enddo enddo enddo @@ -1486,6 +1481,7 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf real(kind=r8) :: ice(np,np) ! ice real(kind=r8) :: q(np,nlev,qsize) + integer :: qidx(thermodynamic_active_species_num) real(kind=r8) :: cdp_fvm(nc,nc,nlev) real(kind=r8) :: cdp(np,np,nlev) real(kind=r8) :: ptop(np,np) @@ -1501,7 +1497,7 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf real(kind=r8) :: mo(npsq) ! mass AAM real(kind=r8) :: mr_cnst, mo_cnst, cos_lat, mr_tmp, mo_tmp,inv_g - integer :: ie,i,j,k,budget_ind,state_ind,idx,idx_tmp + integer :: ie,i,j,k,budget_ind,state_ind,m_cnst,nq integer :: ixwv,ixcldice, ixcldliq, ixtt ! CLDICE, CLDLIQ and test tracer indices character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 @@ -1535,27 +1531,30 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf ! ! Compute frozen static energy in 3 parts: KE, SE, and energy associated with vapor and liquid ! + do nq=1,thermodynamic_active_species_num + qidx(nq) = nq + end do do ie=nets,nete if (lcp_moist) then call get_cp(elem(ie)%state%Qdp(:,:,:,1:qsize,tl_qdp),& - .false., cp, dp_dry=elem(ie)%state%dp3d(:,:,:,tl),& + .false., cp, factor=1.0_r8/elem(ie)%state%dp3d(:,:,:,tl),& active_species_idx_dycore=thermodynamic_active_species_idx_dycore) else cp = cpair end if - ptop = hyai(1)*ps0 do j=1,np - !set thermodynamic active species - do idx=1,thermodynamic_active_species_num - idx_tmp = thermodynamic_active_species_idx_dycore(idx) - q(:,:,idx_tmp) = elem(ie)%state%Qdp(:,j,:,idx_tmp,tl_qdp)/& + !get mixing ratio of thermodynamic active species only + !(other tracers not used in get_hydrostatic_energy) + do nq=1,thermodynamic_active_species_num + m_cnst = thermodynamic_active_species_idx_dycore(nq) + q(:,:,m_cnst) = elem(ie)%state%Qdp(:,j,:,m_cnst,tl_qdp)/& elem(ie)%state%dp3d(:,j,:,tl) end do call get_hydrostatic_energy(q, & - .false., elem(ie)%state%dp3d(:,j,:,tl), cp(:,j,:), elem(ie)%state%v(:,j,1,:,tl), & - elem(ie)%state%v(:,j,2,:,tl), elem(ie)%state%T(:,j,:,tl), vcoord, ptop=ptop(:,j), & - phis=elem(ie)%state%phis(:,j),dycore_idx=.true., & + .false., elem(ie)%state%dp3d(:,j,:,tl), cp(:,j,:), elem(ie)%state%v(:,j,1,:,tl), & + elem(ie)%state%v(:,j,2,:,tl), elem(ie)%state%T(:,j,:,tl), vcoord, ptop=ptop(:,j),& + phis=elem(ie)%state%phis(:,j), dycore_idx=.true., & se=se(:,j), po=po(:,j), ke=ke(:,j), wv=wv(:,j), liq=liq(:,j), ice=ice(:,j)) end do @@ -1586,7 +1585,7 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf do j=1,np do i = 1, np - elem(ie)%derived%budget(i,j,teidx,state_ind) = elem(ie)%derived%budget(i,j,teidx,state_ind) + & + elem(ie)%derived%budget(i,j,teidx,state_ind) = elem(ie)%derived%budget(i,j,teidx,state_ind) +& se(i,j) + ke(i,j)+po(i,j) elem(ie)%derived%budget(i,j,seidx,state_ind) = elem(ie)%derived%budget(i,j,seidx,state_ind) + se(i,j) elem(ie)%derived%budget(i,j,keidx,state_ind) = elem(ie)%derived%budget(i,j,keidx,state_ind) + ke(i,j) @@ -1619,8 +1618,8 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf ! if (thermodynamic_active_species_liq_num>0) then cdp_fvm = 0.0_r8 - do idx = 1,thermodynamic_active_species_liq_num - cdp_fvm = cdp_fvm + fvm(ie)%c(1:nc,1:nc,:,thermodynamic_active_species_liq_idx(idx))& + do nq = 1,thermodynamic_active_species_liq_num + cdp_fvm = cdp_fvm + fvm(ie)%c(1:nc,1:nc,:,thermodynamic_active_species_liq_idx(nq))& *fvm(ie)%dp_fvm(1:nc,1:nc,:) end do call util_function(cdp_fvm,nc,nlev,name_out4,ie) @@ -1635,8 +1634,8 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf ! if (thermodynamic_active_species_ice_num>0) then cdp_fvm = 0.0_r8 - do idx = 1,thermodynamic_active_species_ice_num - cdp_fvm = cdp_fvm + fvm(ie)%c(1:nc,1:nc,:,thermodynamic_active_species_ice_idx(idx))& + do nq = 1,thermodynamic_active_species_ice_num + cdp_fvm = cdp_fvm + fvm(ie)%c(1:nc,1:nc,:,thermodynamic_active_species_ice_idx(nq))& *fvm(ie)%dp_fvm(1:nc,1:nc,:) end do call util_function(cdp_fvm,nc,nlev,name_out5,ie) diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index 8bce8eccba..dc8c209abb 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -6,8 +6,9 @@ module dycore_budget real(r8), parameter :: eps = 1.0E-9_r8 real(r8), parameter :: eps_mass = 1.0E-12_r8 -real(r8), save :: previous_dEdt_adiabatic_dycore = 0.0_r8 -real(r8), save :: previous_dEdt_dry_mass_adjust = 0.0_r8 +real(r8), save :: previous_dEdt_adiabatic_dycore = 0.0_r8 +real(r8), save :: previous_dEdt_dry_mass_adjust = 0.0_r8 +real(r8), save :: previous_dEdt_phys_dyn_coupl_err = 0.0_r8 !========================================================================================= contains @@ -20,296 +21,518 @@ subroutine print_budget() use cam_logfile, only: iulog use shr_kind_mod, only: r8=>shr_kind_r8 use budgets, only: budget_get_global, is_budget - use dimensions_mod, only: lcp_moist,qsize + use dimensions_mod, only: lcp_moist,qsize, ntrac use control_mod, only: ftype - use cam_thermo, only: teidx, thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv + use cam_thermo, only: teidx, seidx, keidx, poidx + use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv ! Local variables integer :: i character(len=*), parameter :: subname = 'check_energy:print_budgets' - real(r8) :: ph_param,ph_EFIX,ph_DMEA,ph_phys_total - real(r8) :: dy_param,dy_EFIX,dy_DMEA,dy_param_and_efix,dy_phys_total -!jt real(r8) :: se_param,se_dmea,se_phys_total, dycore, err, param, pefix, & + integer, dimension(4) :: idx + real(r8), dimension(4) :: ph_param,ph_EFIX,ph_DMEA,ph_PARAM_AND_EFIX,ph_phys_total + real(r8), dimension(4) :: dy_param,dy_EFIX,dy_DMEA,dy_param_and_efix,dy_phys_total + real(r8), dimension(4) :: se_phys_total + +!jt real(r8) :: se_phys_total,se_dmea,se_phys_total, dycore, err, param, pefix, & real(r8) :: dycore, err, param, pefix, & pdmea, phys_total, dyn_total, dyn_phys_total, & rate_of_change_2D_dyn, rate_of_change_vertical_remapping, & diffusion_del4, diffusion_fric, diffusion_del4_tot, diffusion_sponge, & - diffusion_total, twoDresidual, rate_of_change_physics, & + diffusion_total, twoDresidual, & rate_of_change_heating_term_put_back_in, rate_of_change_hvis_sponge, & dADIA, ttt, fff, & mass_change__2D_dyn,mass_change__vertical_remapping, & mass_change__heating_term_put_back_in,mass_change__hypervis_total, & error, mass_change__physics, dbd, daf, dar, dad, qneg, val,phbf,ded - real(r8) :: E_dBF, E_phBF, diff - - - integer :: m_cnst + real(r8) :: E_dBF(4), E_phBF, diff, tmp + real(r8) :: E_dyBF(4) + integer :: m_cnst + character(LEN=*), parameter :: fmt = "(a40,a15,a1,F6.2,a1,F6.2,a1,E10.2,a5)" + character(LEN=*), parameter :: fmt2 = "(a40,F6.2,a3)" + character(LEN=15) :: str(4) + character(LEN=5) :: pf! pass or fail identifier !-------------------------------------------------------------------------------------- if (masterproc) then - call budget_get_global('phAP-phBP',teidx,ph_param) - call budget_get_global('phBP-phBF',teidx,ph_EFIX) - call budget_get_global('phAM-phAP',teidx,ph_DMEA) - call budget_get_global('phAM-phBF',teidx,ph_phys_total) - - call budget_get_global('dyAP-dyBP',teidx,dy_param) - call budget_get_global('dyBP-dyBF',teidx,dy_EFIX) - call budget_get_global('dyAM-dyAP',teidx,dy_DMEA) - call budget_get_global('dyAP-dyBF',teidx,dy_param_and_efix) - call budget_get_global('dyAM-dyBF',teidx,dy_phys_total) - - call budget_get_global('dBF-dED',teidx,dyn_total) - call budget_get_global('dAD-dBD',teidx,rate_of_change_2D_dyn) - call budget_get_global('dAR-dAD',teidx,rate_of_change_vertical_remapping) - dADIA = rate_of_change_2D_dyn+rate_of_change_vertical_remapping + idx(1) = teidx !total energy index + idx(2) = seidx !enthaly index + idx(3) = keidx !kinetic energy index + idx(4) = poidx !surface potential energy index + str(1) = "(total) )" + str(2) = "(enthalpy )" + str(3) = "(kinetic )" + str(4) = "(srf potential)" + do i=1,4 + ! + ! CAM physics energy tendencies + ! + call budget_get_global('phAP-phBP',idx(i),ph_param(i)) + call budget_get_global('phBP-phBF',idx(i),ph_EFIX(i)) + call budget_get_global('phAM-phAP',idx(i),ph_dmea(i)) + call budget_get_global('phAP-phBF',idx(i),ph_param_and_efix(i)) + call budget_get_global('phAM-phBF',idx(i),ph_phys_total(i)) + ! + ! CAM physics energy tendencies using dycore energy formula scaling + ! temperature tendencies for consistency with CAM physics + ! + call budget_get_global('dyAP-dyBP',idx(i),dy_param(i)) + call budget_get_global('dyBP-dyBF',idx(i),dy_EFIX(i)) + call budget_get_global('dyAM-dyAP',idx(i),dy_dmea(i)) + call budget_get_global('dyAP-dyBF',idx(i),dy_param_and_efix(i)) + call budget_get_global('dyAM-dyBF',idx(i),dy_phys_total(i)) + call budget_get_global('dyBF' ,idx(i),E_dyBF(i))!state beginning physics + ! + ! CAM physics energy tendencies in dynamical core + ! + call budget_get_global('dBD-dAF',idx(i),se_phys_total(i)) + call budget_get_global('dBF' ,idx(i),E_dBF(i)) !state passed to physics + end do - call budget_get_global('dCH-dBH',teidx,diffusion_del4) - call budget_get_global('dAH-dCH',teidx,diffusion_fric) - call budget_get_global('dAH-dBH',teidx,diffusion_del4_tot) - call budget_get_global('dAS-dBS',teidx,diffusion_sponge) - diffusion_total = diffusion_del4_tot+diffusion_sponge - - call budget_get_global('dBD-dAF',teidx,rate_of_change_physics) + call budget_get_global('dBF-dED',teidx,dyn_total) + call budget_get_global('dAD-dBD',teidx,rate_of_change_2D_dyn) + call budget_get_global('dAR-dAD',teidx,rate_of_change_vertical_remapping) + dADIA = rate_of_change_2D_dyn+rate_of_change_vertical_remapping - rate_of_change_heating_term_put_back_in = diffusion_fric - rate_of_change_hvis_sponge = diffusion_sponge - - write(iulog,*)" " - write(iulog,*)" Total energy diagnostics introduced in Lauritzen and Williamson (2019)" - write(iulog,*)" (DOI:10.1029/2018MS001549)" - write(iulog,*)" " - - write(iulog,*)" " - write(iulog,*)"suffix (dynamics)" - write(iulog,*)"dED: state from end of previous dynamics (= pBF + time sampling)" - write(iulog,*)" loop over vertical remapping and physics dribbling -------- (nsplit) -------" - write(iulog,*)" (dribbling and remapping always done together) |" - write(iulog,*)" dAF: state from previous remapping |" - write(iulog,*)" dBD: state after physics dribble, before dynamics |" - write(iulog,*)" loop over vertical Lagrangian dynamics --------rsplit------------- |" - write(iulog,*)" dynamics here | |" - write(iulog,*)" loop over hyperviscosity ----------hypervis_sub------------ | |" - write(iulog,*)" dBH state before hyperviscosity | | |" - write(iulog,*)" dCH state after hyperviscosity | | |" - write(iulog,*)" dAH state after hyperviscosity momentum heating | | |" - write(iulog,*)" end hyperviscosity loop ----------------------------------- | |" - write(iulog,*)" dBS state before del2 sponge | | |" - write(iulog,*)" dAS state after del2+mom heating sponge | | |" - write(iulog,*)" end of vertical Lagrangian dynamics loop ------------------------- |" - write(iulog,*)" dAD state after dynamics, before vertical remapping |" - write(iulog,*)" dAR state after vertical remapping |" - write(iulog,*)" end of remapping loop ------------------------------------------------------" - write(iulog,*)"dBF state passed to parameterizations = state after last remapping " - write(iulog,*)" " - write(iulog,*)" " - write(iulog,*)"------------------------------------------------------------" - write(iulog,*)"Physics time loop" - write(iulog,*)"------------------------------------------------------------" - write(iulog,*)" " - write(iulog,*)"phBF: state passed to parameterizations, before energy fixer" - write(iulog,*)"phBP: after energy fixer, before parameterizations" - write(iulog,*)"phAP: after last phys_update in parameterizations and state " - write(iulog,*)" saved for energy fixer" - write(iulog,*)"phAM: after dry mass correction" - write(iulog,*)"history files saved off here" - write(iulog,*)" " - write(iulog,*)"------------------------------------------------------------" - write(iulog,*)" CAM physics energy tendencies (using pressure coordinate)" - write(iulog,*)"------------------------------------------------------------" - write(iulog,*)" " - write(iulog,'(a40,F6.2,a6)')"dE/dt energy fixer (phBP-phBF) ",ph_EFIX," W/M^2" - write(iulog,'(a40,F6.2,a6)')"dE/dt all parameterizations (phAP-phBP) ",ph_param," W/M^2" - write(iulog,'(a40,F6.2,a6)')"dE/dt dry mass adjustment (phAM-phAP) ",ph_DMEA," W/M^2" - write(iulog,'(a40,F6.2,a6)')"dE/dt physics total (phAM-phBF) ",ph_phys_total," W/M^2" - write(iulog,*)" " - write(iulog,*) " " - write(iulog,*) "-dE/dt energy fixer = dE/dt dry mass adjustment +" - write(iulog,*) " dE/dt dycore +" - write(iulog,*) " dE/dt physics-dynamics coupling errors +" - write(iulog,*) " dE/dt energy formula differences " - write(iulog,*) " " - write(iulog,*) "(equation 23 in Lauritzen and Williamson (2019))" - write(iulog,*) " " - dycore = -ph_EFIX-ph_DMEA - dycore = -ph_EFIX-previous_dEdt_dry_mass_adjust - write(iulog,*) "" - write(iulog,*) "Dycore TE dissipation estimated from physics in pressure coordinate:" - write(iulog,*) "(note: to avoid sampling error we need dE/dt from previous time-step)" - write(iulog,*) "" - write(iulog,*) "dE/dt adiabatic dycore estimated from physics (t=n-1) = " - write(iulog,'(a58,F6.2,a6)') "-dE/dt energy fixer(t=n)-dE/dt dry-mass adjust(t=n-1) = ",dycore," W/M^2" - write(iulog,*) "" - write(iulog,'(a58,F6.2,a6)') "dE/dt adiabatic dycore computed in dycore (t=n-1) = ",& - previous_dEdt_adiabatic_dycore," W/M^2" - write(iulog,'(a58,F6.2,a6)') "dE/dt dry-mass adjust (t=n-1) = ",& - previous_dEdt_dry_mass_adjust," W/M^2" - write(iulog,*) "" - if (abs(previous_dEdt_adiabatic_dycore)>eps) then - diff = abs((dycore-previous_dEdt_adiabatic_dycore)/previous_dEdt_adiabatic_dycore) - if (diff>eps) then - write(iulog,*) "energy budget not closed: previous_dEdt_adiabatic_dycore <> dycore" - write(iulog,*) "normalized difference is:",diff -! call endrun('dycore_budget module: physics energy budget consistency error 2') - end if - end if - write(iulog,*)"------------------------------------------------------------" - write(iulog,*)" Physics dynamics coupling errors" - write(iulog,*)"------------------------------------------------------------" - write(iulog,*)" " - write(iulog,'(a46,F6.2,a6)')"dE/dt physics tendency in dynamics (dBD-dAF) ",rate_of_change_physics," W/M^2" - write(iulog,'(a46,F6.2,a6)')"dE/dt physics tendency in physics (pAM-pBF) ",ph_phys_total," W/M^2" - write(iulog,*)" " - write(iulog,'(a46,F6.2,a6)')"dE/dt physics-dynamics coupling errors ",ph_phys_total-rate_of_change_physics," W/M^2" + call budget_get_global('dCH-dBH',teidx,diffusion_del4) + call budget_get_global('dAH-dCH',teidx,diffusion_fric) + call budget_get_global('dAH-dBH',teidx,diffusion_del4_tot) + call budget_get_global('dAS-dBS',teidx,diffusion_sponge) + diffusion_total = diffusion_del4_tot+diffusion_sponge - write(iulog,*)" " - write(iulog,*)"------------------------------------------------------------" - write(iulog,*)" SE dycore energy tendencies" - write(iulog,*)"------------------------------------------------------------" - write(iulog,*)" " -! write(iulog,*)"dE/dt dyn total (dycore+phys tendency (dBF-dED) ",dyn_total," W/M^2" - write(iulog,'(a46,F6.2,a6)')"dE/dt adiabatic dynamics ",dADIA," W/M^2" - write(iulog,*)" " - write(iulog,*)"Adiabatic dynamics can be divided into quasi-horizontal and vertical remapping: " - write(iulog,*)" " - write(iulog,'(a40,F6.2,a6)') "dE/dt 2D dynamics (dAD-dBD) ",rate_of_change_2D_dyn," W/M^2" - write(iulog,'(a40,F6.2,a6)') "dE/dt vertical remapping (dAR-dAD) ",rate_of_change_vertical_remapping," W/M^2" + rate_of_change_heating_term_put_back_in = diffusion_fric + rate_of_change_hvis_sponge = diffusion_sponge - write(iulog,*) " " - write(iulog,*) "Breakdown of 2D dynamics:" - write(iulog,*) " " - write(iulog,'(a45,F6.2,a6)')" dE/dt hypervis del4 (dCH-dBH) ",diffusion_del4," W/M^2" - write(iulog,'(a45,F6.2,a6)')" dE/dt hypervis frictional heating (dAH-dCH) ",diffusion_fric," W/M^2" - write(iulog,'(a45,F6.2,a6)')" dE/dt hypervis del4 total (dAH-dBH) ",diffusion_del4_tot," W/M^2" - write(iulog,'(a45,F6.2,a6)')" dE/dt hypervis sponge total (dAS-dBS) ",diffusion_sponge," W/M^2" - write(iulog,'(a45,F6.2,a6)')" dE/dt explicit diffusion total ",diffusion_total," W/M^2" - twoDresidual = rate_of_change_2D_dyn-diffusion_total - write(iulog,'(a45,F6.2,a6)')" dE/dt residual (time-truncation errors) ",twoDresidual," W/M^2" - write(iulog,*)" " - write(iulog,*)" " - write(iulog,*)"------------------------------------------------------------" - write(iulog,*)" Consistency checks" - write(iulog,*)"------------------------------------------------------------" - write(iulog,*)" " - ! - ! consistency check - ! - if (abs(ph_param+ph_EFIX+ph_DMEA-ph_phys_total)>eps) then - write(iulog,*) "Physics energy budget not adding up:" - write(iulog,*) "(phBP-pBF)+(phAP-pBP)+(pAM-pAP) does not add up to (pAM-pBF)",\ - abs(ph_param+ph_EFIX+ph_DMEA-ph_phys_total) - call endrun('dycore_budget module: physics energy budget consistency error') - endif - write(iulog,*) "" - write(iulog,*) "Is globally integrated total energy of state at the end of dynamics (dBF)" - write(iulog,*) "and beginning of physics (phBF) the same?" - write(iulog,*) "" - call budget_get_global('dBF',teidx,E_dBF) !state passed to physics - call budget_get_global('phBF',teidx,E_phBF)!state beginning physics -! if (abs(E_phBF)>eps) then - diff = abs_diff(E_dBF,E_phBF) - if (abs(diff)eps_mass) then - write(iulog,*) "dMASS/dt energy fixer (pBP-pBF) ",pEFIX," Pa" - write(iulog,*) "ERROR: Mass not conserved in energy fixer. ABORT" - call endrun('dycore_budget module: Mass not conserved in energy fixer. See atm.log') - endif - if (abs(pDMEA)>eps_mass) then - write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",pDMEA," Pa" - write(iulog,*) "ERROR: Mass not conserved in dry mass adjustment. ABORT" - call endrun('dycore_budget module: Mass not conserved in dry mass adjustment. See atm.log') - end if - if (abs(param-phys_total)>eps_mass) then - write(iulog,*) "Error: dMASS/dt parameterizations (pAP-pBP) .ne. dMASS/dt physics total (pAM-pBF)" - write(iulog,*) "dMASS/dt parameterizations (pAP-pBP) ",param," Pa" - write(iulog,*) "dMASS/dt physics total (pAM-pBF) ",phys_total," Pa" - call endrun('dycore_budget module: mass change not only due to parameterizations. See atm.log') - end if + write(iulog,*)" " + write(iulog,*)"======================================================================" + write(iulog,*)"Total energy diagnostics introduced in Lauritzen and Williamson (2019)" + write(iulog,*)"(DOI:10.1029/2018MS001549)" + write(iulog,*)"======================================================================" + write(iulog,*)" " + write(iulog,*)"Globally and vertically integrated total energy (E) diagnostics are" + write(iulog,*)"computed at various points in the physics and dynamics loops to compute" + write(iulog,*)"energy tendencies (dE/dt) and check for consistency (e.g., is E of" + write(iulog,*)"state passed to physics computed using dycore state variables the same" + write(iulog,*)"E of the state in the beginning of physics computed using the physics" + write(iulog,*)"representation of the state)" + write(iulog,*)" " + write(iulog,*)"Energy stages in physics:" + write(iulog,*)"-------------------------" + write(iulog,*)" " + write(iulog,*)" xxBF: state passed to parameterizations, before energy fixer" + write(iulog,*)" xxBP: after energy fixer, before parameterizations" + write(iulog,*)" xxAP: after last phys_update in parameterizations and state " + write(iulog,*)" saved for energy fixer" + write(iulog,*)" xxAM: after dry mass adjustment" + write(iulog,*)" history files saved off here" + write(iulog,*)" " + write(iulog,*)"where xx='ph','dy' " + write(iulog,*)" " + write(iulog,*)"Suffix ph is CAM physics total energy" + write(iulog,*)"(eq. 111 in Lauritzen et al. 2022; 10.1029/2022MS003117)" + write(iulog,*)" " + write(iulog,*)"Suffix dy is dycore energy computed in CAM physics using" + write(iulog,*)"CAM physics state variables" + write(iulog,*)" " + write(iulog,*)"Energy stages in dynamics" + write(iulog,*)"-------------------------" + write(iulog,*)" " + write(iulog,*)"suffix (dynamics)" + write(iulog,*)"dED: state from end of previous dynamics (= pBF + time sampling)" + write(iulog,*)" loop over vertical remapping and physics dribbling -------- (nsplit) -------" + write(iulog,*)" (dribbling and remapping always done together) |" + write(iulog,*)" dAF: state from previous remapping |" + write(iulog,*)" dBD: state after physics dribble, before dynamics |" + write(iulog,*)" loop over vertical Lagrangian dynamics --------rsplit------------- |" + write(iulog,*)" dynamics here | |" + write(iulog,*)" loop over hyperviscosity ----------hypervis_sub------------ | |" + write(iulog,*)" dBH state before hyperviscosity | | |" + write(iulog,*)" dCH state after hyperviscosity | | |" + write(iulog,*)" dAH state after hyperviscosity momentum heating | | |" + write(iulog,*)" end hyperviscosity loop ----------------------------------- | |" + write(iulog,*)" dBS state before del2 sponge | | |" + write(iulog,*)" dAS state after del2+mom heating sponge | | |" + write(iulog,*)" end of vertical Lagrangian dynamics loop ------------------------- |" + write(iulog,*)" dAD state after dynamics, before vertical remapping |" + write(iulog,*)" dAR state after vertical remapping |" + write(iulog,*)" end of remapping loop ------------------------------------------------------" + write(iulog,*)"dBF state passed to parameterizations = state after last remapping " + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)"FYI: all difference (diff) below are absolute normalized differences" + write(iulog,*)" " + write(iulog,*)"Consistency check 0:" + write(iulog,*)"--------------------" + write(iulog,*)" " + write(iulog,*)"For energetic consistency we require that dE/dt [W/m^2] from energy " + write(iulog,*)"fixer and all parameterizations computed using physics E and" + write(iulog,*)"dycore in physics E are the same! Checking:" + write(iulog,*)" " + write(iulog,*) " xx=ph xx=dy norm. diff." + write(iulog,*) " ----- ----- -----------" + do i=1,4 + diff = abs_diff(ph_EFIX(i),dy_EFIX(i),pf=pf) + write(iulog,fmt)"dE/dt energy fixer (xxBP-xxBF) ",str(i)," ",ph_EFIX(i), " ",dy_EFIX(i)," ",diff,pf + diff = abs_diff(ph_param(i),dy_param(i),pf=pf) + write(iulog,fmt)"dE/dt all parameterizations (xxAP-xxBP) ",str(i)," ",ph_param(i)," ",dy_param(i)," ",diff,pf + write(iulog,*) " " + end do + if (diff>eps) then + write(iulog,*)"FAIL" + call endrun(subname//"dE/dts in physics inconsistent") + end if + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)"dE/dt from dry-mass adjustment will differ if dynamics and physics use" + write(iulog,*)"different energy definitions! Checking:" + write(iulog,*)" " + write(iulog,*) " xx=ph xx=dy diff" + write(iulog,*) " ----- ----- ----" + do i=1,4 + diff = ph_dmea(i)-dy_dmea(i) + write(iulog,fmt)"dE/dt dry mass adjustment (xxAM-xxAP) ",str(i)," ",ph_dmea(i)," ",dy_dmea(i)," ",diff + write(iulog,*) "" + write(iulog,*) str(i),":" + write(iulog,*) "======" + write(iulog,*)"dE/dt dry mass adjustment (phAM-phAP)"," ",ph_dmea(i) + write(iulog,*)"dE/dt dry mass adjustment (dyAM-dyAP)"," ",dy_dmea(i) + write(iulog,*) " " + write(iulog,*) " " + end do + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)"Some energy budget observations:" + write(iulog,*)"--------------------------------" + write(iulog,*)" " + write(iulog,*)"Note that total energy fixer fixes:" + write(iulog,*) " " + write(iulog,*) "-dE/dt energy fixer(t=n) = dE/dt dry mass adjustment (t=n-1) +" + write(iulog,*) " dE/dt adiabatic dycore (t=n-1) +" + write(iulog,*) " dE/dt physics-dynamics coupling errors (t=n-1)" + write(iulog,*) " " + write(iulog,*) "(equation 23 in Lauritzen and Williamson (2019))" + write(iulog,*) " " + tmp = previous_dEdt_phys_dyn_coupl_err+previous_dEdt_adiabatic_dycore+previous_dEdt_dry_mass_adjust + diff = abs_diff(-dy_EFIX(1),tmp,pf) + write(iulog,*) "Check if that is the case:", pf, diff + write(iulog,*) " " - write(iulog,*)"dMASS/dt parameterizations (pAP-pBP) ",param," Pa" - write(iulog,*)"dMASS/dt physics total (pAM-pBF) ",phys_total," Pa" - write(iulog,*)" " - ! - ! detailed mass budget in dynamical core - ! - if (is_budget('dAD').and.is_budget('dBD').and.is_budget('dAR').and.is_budget('dCH')) then - call budget_get_global('dAD-dBD',m_cnst,mass_change__2D_dyn) - call budget_get_global('dAR-dAD',m_cnst,mass_change__vertical_remapping) - diff = mass_change__2D_dyn+mass_change__vertical_remapping - write(iulog,*)"dMASS/dt total adiabatic dynamics ",diff," Pa" - if (abs(diff)>eps_mass) then - write(iulog,*) "Error: mass non-conservation in dynamical core" - write(iulog,*) "(detailed budget below)" - write(iulog,*) " " - write(iulog,*)"dMASS/dt 2D dynamics (dAD-dBD) ",mass_change__2D_dyn," Pa" - if (is_budget('dAR').and.is_budget('dAD')) then - call budget_get_global('dAR',m_cnst,dar) - call budget_get_global('dAD',m_cnst,dad) - call budget_get_global('dAR-dAD',m_cnst,mass_change__vertical_remapping) - write(iulog,*)"dE/dt vertical remapping (dAR-dAD) ",mass_change__vertical_remapping - end if - write(iulog,*)" " - write(iulog,*)"Breakdown of 2D dynamics:" - write(iulog,*)" " - call budget_get_global('dAH-dCH',m_cnst,mass_change__heating_term_put_back_in) - call budget_get_global('dAH-dBH',m_cnst,mass_change__hypervis_total) - write(iulog,*)"dMASS/dt hypervis (dAH-dBH) ",mass_change__hypervis_total," Pa" - write(iulog,*)"dMASS/dt frictional heating (dAH-dCH) ",mass_change__heating_term_put_back_in," Pa" - error = mass_change__2D_dyn-mass_change__hypervis_total - write(iulog,*)"dMASS/dt residual (time truncation errors)",error," Pa" - end if - end if + + if (abs(diff)>eps) then + write(iulog,*) "dE/dt energy fixer(t=n) = ",dy_EFIX(1) + write(iulog,*) "dE/dt dry mass adjustment (t=n-1) = ",previous_dEdt_dry_mass_adjust + write(iulog,*) "dE/dt adiabatic dycore (t=n-1) = ",previous_dEdt_adiabatic_dycore + write(iulog,*) "dE/dt physics-dynamics coupling errors (t=n-1) = ",previous_dEdt_phys_dyn_coupl_err +! call endrun(subname//"Error in energy fixer budget") + end if + write(iulog,*) "" + dycore = -dy_EFIX(1)-previous_dEdt_phys_dyn_coupl_err-previous_dEdt_dry_mass_adjust + write(iulog,*) "Hence the dycore E dissipation estimated from energy fixer " + write(iulog,*) "based on previous time-step values is ",dycore," W/M^2" + write(iulog,*) " " + write(iulog,*) " " + write(iulog,*) "-------------------------------------------------------------------" + write(iulog,*) " Consistency check 1: state passed to physics same as end dynamics?" + write(iulog,*) "-------------------------------------------------------------------" + write(iulog,*) " " + write(iulog,*) "Is globally integrated total energy of state at the end of dynamics (dBF)" + write(iulog,*) "and beginning of physics (using dynamics in physics energy; dyBF) the same?" + write(iulog,*) "" + if (ntrac==0) then + if (abs(E_dyBF(1))>eps) then + diff = abs_diff(E_dBF(1),E_dyBF(1)) + if (abs(diff)eps) then + ! + ! if errors print details + ! + if (ntrac==0) then + if (ftype==1) then + write(iulog,*) "" + write(iulog,*) "You are using ftype==1 so physics-dynamics coupling errors should be round-off!" + write(iulog,*) "" + write(iulog,*) "Because of failure provide detailed diagnostics below:" + write(iulog,*) "" + else + write(iulog,*) "" + write(iulog,*) "Since ftype<>1 there are physics dynamics coupling errors" + write(iulog,*) "" + write(iulog,*) "Break-down below:" + write(iulog,*) "" + end if + else + write(iulog,*)" " + write(iulog,*)"Since you are using a separate physics grid, the physics tendencies" + write(iulog,*)"in the dynamical core will not match due to the tendencies being" + write(iulog,*)"interpolated from the physics to the dynamics grid:" + write(iulog,*)" " + end if + do i=1,4 + write(iulog,*) str(i),":" + write(iulog,*) "======" + diff = abs_diff(dy_phys_total(i),se_phys_total(i),pf=pf) + write(iulog,*) "dE/dt physics-dynamics coupling errors (diff) ",diff + write(iulog,*) "dE/dt physics tendency in dynamics (dBD-dAF) ",se_phys_total(i) + write(iulog,*) "dE/dt physics tendency in physics (pAM-pBF) ",dy_phys_total(i) + write(iulog,*) " " + end do + end if + write(iulog,*)" " + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" SE dycore energy tendencies" + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" " + ! write(iulog,*)"dE/dt dyn total (dycore+phys tendency (dBF-dED) ",dyn_total," W/M^2" + write(iulog,'(a46,F6.2,a6)')"dE/dt adiabatic dynamics ",dADIA," W/M^2" + write(iulog,*)" " + write(iulog,*)"Adiabatic dynamics can be divided into quasi-horizontal and vertical remapping: " + write(iulog,*)" " + write(iulog,'(a40,F6.2,a6)') "dE/dt 2D dynamics (dAD-dBD) ",rate_of_change_2D_dyn," W/M^2" + write(iulog,'(a40,F6.2,a6)') "dE/dt vertical remapping (dAR-dAD) ",rate_of_change_vertical_remapping," W/M^2" + + write(iulog,*) " " + write(iulog,*) "Breakdown of 2D dynamics:" + write(iulog,*) " " + write(iulog,'(a45,F6.2,a6)')" dE/dt hypervis del4 (dCH-dBH) ",diffusion_del4," W/M^2" + write(iulog,'(a45,F6.2,a6)')" dE/dt hypervis frictional heating (dAH-dCH) ",diffusion_fric," W/M^2" + write(iulog,'(a45,F6.2,a6)')" dE/dt hypervis del4 total (dAH-dBH) ",diffusion_del4_tot," W/M^2" + write(iulog,'(a45,F6.2,a6)')" dE/dt hypervis sponge total (dAS-dBS) ",diffusion_sponge," W/M^2" + write(iulog,'(a45,F6.2,a6)')" dE/dt explicit diffusion total ",diffusion_total," W/M^2" + twoDresidual = rate_of_change_2D_dyn-diffusion_total + write(iulog,'(a45,F6.2,a6)')" dE/dt residual (time-truncation errors) ",twoDresidual," W/M^2" + write(iulog,*)" " + write(iulog,*)" " +#ifdef xxx + write(iulog,*)" " + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" CAM physics energy tendencies (using pressure coordinate)" + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" " + write(iulog,'(a40,F6.2,a6)')"dE/dt energy fixer (phBP-phBF) ",ph_EFIX," W/M^2" + write(iulog,'(a40,F6.2,a6)')"dE/dt all parameterizations (phAP-phBP) ",ph_param," W/M^2" + write(iulog,'(a40,F6.2,a6)')"dE/dt dry mass adjustment (phAM-phAP) ",ph_DMEA," W/M^2" + write(iulog,'(a40,F6.2,a6)')"dE/dt physics total (phAM-phBF) ",ph_phys_total," W/M^2" + write(iulog,*)" " + write(iulog,*) " " + write(iulog,*) "-dE/dt energy fixer = dE/dt dry mass adjustment +" + write(iulog,*) " dE/dt dycore +" + write(iulog,*) " dE/dt physics-dynamics coupling errors +" + write(iulog,*) " dE/dt energy formula differences " + write(iulog,*) " " + write(iulog,*) "(equation 23 in Lauritzen and Williamson (2019))" + write(iulog,*) " " + dycore = -ph_EFIX-ph_DMEA + dycore = -ph_EFIX-previous_dEdt_dry_mass_adjust + write(iulog,*) "" + write(iulog,*) "Dycore TE dissipation estimated from physics in pressure coordinate:" + write(iulog,*) "(note: to avoid sampling error we need dE/dt from previous time-step)" + write(iulog,*) "" + write(iulog,*) "dE/dt adiabatic dycore estimated from physics (t=n-1) = " + write(iulog,'(a58,F6.2,a6)') "-dE/dt energy fixer(t=n)-dE/dt dry-mass adjust(t=n-1) = ",dycore," W/M^2" + write(iulog,*) "" + write(iulog,'(a58,F6.2,a6)') "dE/dt adiabatic dycore computed in dycore (t=n-1) = ",& + previous_dEdt_adiabatic_dycore," W/M^2" + write(iulog,'(a58,F6.2,a6)') "dE/dt dry-mass adjust (t=n-1) = ",& + previous_dEdt_dry_mass_adjust," W/M^2" + write(iulog,*) "" + if (abs(previous_dEdt_adiabatic_dycore)>eps) then + diff = abs((dycore-previous_dEdt_adiabatic_dycore)/previous_dEdt_adiabatic_dycore) + if (diff>eps) then + write(iulog,*) "energy budget not closed: previous_dEdt_adiabatic_dycore <> dycore" + write(iulog,*) "normalized difference is:",diff + ! call endrun(subname//"physics energy budget consistency error 2") + end if + end if + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" Physics dynamics coupling errors" + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" " + write(iulog,'(a46,F6.2,a6)')"dE/dt physics tendency in dynamics (dBD-dAF) ",se_phys_total_te," W/M^2" + write(iulog,'(a46,F6.2,a6)')"dE/dt physics tendency in physics (pAM-pBF) ",ph_phys_total," W/M^2" + write(iulog,*)" " + write(iulog,'(a46,F6.2,a6)')"dE/dt physics-dynamics coupling errors ",ph_phys_total-se_phys_total_te," W/M^2" + + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" Consistency checks" + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" " + ! + ! consistency check + ! + if (abs(ph_param+ph_EFIX+ph_DMEA-ph_phys_total)>eps) then + write(iulog,*) "Physics energy budget not adding up:" + write(iulog,*) "(phBP-pBF)+(phAP-pBP)+(pAM-pAP) does not add up to (pAM-pBF)",\ + abs(ph_param+ph_EFIX+ph_DMEA-ph_phys_total) + call endrun(subname//"physics energy budget consistency error") + endif + write(iulog,*) "" + write(iulog,*) "Is globally integrated total energy of state at the end of dynamics (dBF)" + write(iulog,*) "and beginning of physics (phBF) the same?" + write(iulog,*) "" + call budget_get_global('dBF' ,teidx,E_dBF) !state passed to physics + call budget_get_global('dyBF' ,teidx,E_dyBF) !state passed to physics + call budget_get_global('phBF',teidx,E_phBF)!state beginning physics + ! if (abs(E_phBF)>eps) then + diff = abs_diff(E_dBF,E_phBF) + if (abs(diff)eps_mass) then + write(iulog,*) "dMASS/dt energy fixer (pBP-pBF) ",pEFIX," Pa" + write(iulog,*) "ERROR: Mass not conserved in energy fixer. ABORT" + call endrun(subname//"Mass not conserved in energy fixer. See atm.log") + endif + if (abs(pDMEA)>eps_mass) then + write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",pDMEA," Pa" + write(iulog,*) "ERROR: Mass not conserved in dry mass adjustment. ABORT" + call endrun(subname//"Mass not conserved in dry mass adjustment. See atm.log") + end if + if (abs(param-phys_total)>eps_mass) then + write(iulog,*) "Error: dMASS/dt parameterizations (pAP-pBP) .ne. dMASS/dt physics total (pAM-pBF)" + write(iulog,*) "dMASS/dt parameterizations (pAP-pBP) ",param," Pa" + write(iulog,*) "dMASS/dt physics total (pAM-pBF) ",phys_total," Pa" + call endrun(subname//"mass change not only due to parameterizations. See atm.log") + end if + write(iulog,*)"dMASS/dt parameterizations (pAP-pBP) ",param," Pa" + write(iulog,*)"dMASS/dt physics total (pAM-pBF) ",phys_total," Pa" + write(iulog,*)" " + ! + ! detailed mass budget in dynamical core + ! + if (is_budget('dAD').and.is_budget('dBD').and.is_budget('dAR').and.is_budget('dCH')) then + call budget_get_global('dAD-dBD',m_cnst,mass_change__2D_dyn) + call budget_get_global('dAR-dAD',m_cnst,mass_change__vertical_remapping) + diff = mass_change__2D_dyn+mass_change__vertical_remapping + write(iulog,*)"dMASS/dt total adiabatic dynamics ",diff," Pa" + if (abs(diff)>eps_mass) then + write(iulog,*) "Error: mass non-conservation in dynamical core" + write(iulog,*) "(detailed budget below)" + write(iulog,*) " " + write(iulog,*)"dMASS/dt 2D dynamics (dAD-dBD) ",mass_change__2D_dyn," Pa" + if (is_budget('dAR').and.is_budget('dAD')) then + call budget_get_global('dAR',m_cnst,dar) + call budget_get_global('dAD',m_cnst,dad) + call budget_get_global('dAR-dAD',m_cnst,mass_change__vertical_remapping) + write(iulog,*)"dE/dt vertical remapping (dAR-dAD) ",mass_change__vertical_remapping + end if + write(iulog,*)" " + write(iulog,*)"Breakdown of 2D dynamics:" + write(iulog,*)" " + call budget_get_global('dAH-dCH',m_cnst,mass_change__heating_term_put_back_in) + call budget_get_global('dAH-dBH',m_cnst,mass_change__hypervis_total) + write(iulog,*)"dMASS/dt hypervis (dAH-dBH) ",mass_change__hypervis_total," Pa" + write(iulog,*)"dMASS/dt frictional heating (dAH-dCH) ",mass_change__heating_term_put_back_in," Pa" + error = mass_change__2D_dyn-mass_change__hypervis_total + write(iulog,*)"dMASS/dt residual (time truncation errors)",error," Pa" end if - write(iulog,*)"" - end if + end if + write(iulog,*)" " + if (is_budget('dBD').and.is_budget('dAF')) then + call budget_get_global('dBD',m_cnst,dbd) + call budget_get_global('dAF',m_cnst,daf) + call budget_get_global('dBD-dAF',m_cnst,mass_change__physics) + write(iulog,*)"dMASS/dt physics tendency in dynamics (dBD-dAF) ",mass_change__physics," Pa" + val = phys_total-mass_change__physics + write(iulog,*) "Mass physics dynamics coupling error:",val + end if + write(iulog,*)"" + end if end do - ! - ! save adiabatic dycore dE/dt and dry-mass adjustment to avoid samping error - ! - previous_dEdt_adiabatic_dycore = dADIA - previous_dEdt_dry_mass_adjust = ph_DMEA -end if + ! + ! save adiabatic dycore dE/dt and dry-mass adjustment to avoid samping error + ! + previous_dEdt_adiabatic_dycore = dADIA + previous_dEdt_dry_mass_adjust = dy_DMEA(1) + end if end subroutine print_budget !========================================================================================= -function abs_diff(a,b) - real(r8), intent(in) :: a,b - real(r8) :: abs_diff +function abs_diff(a,b,pf) + real(r8), intent(in) :: a,b + character(LEN=5), optional, intent(out):: pf + real(r8) :: abs_diff if (abs(b)>eps) then abs_diff = abs((b-a)/b) else abs_diff = abs(b-a) end if + If (present(pf)) then + if (abs_diff>eps) then + pf = ' FAIL' + else + pf = ' PASS' + end if + end if end function abs_diff end module dycore_budget diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index e094b890f9..bc2e3c5efe 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -25,7 +25,7 @@ module check_energy use gmean_mod, only: gmean use physconst, only: gravit, latvap, latice, cpair, rair - use air_composition, only: cpairv, rairv + use air_composition, only: cpairv, rairv, cpair_dycore use physics_types, only: physics_state, physics_tend, physics_ptend, physics_ptend_init use constituents, only: cnst_get_ind, pcnst, cnst_name, cnst_get_type_byind use time_manager, only: is_first_step @@ -240,7 +240,7 @@ subroutine check_energy_timestep_init(state, tend, pbuf, col_type) use cam_thermo, only: get_hydrostatic_energy use physics_buffer, only: physics_buffer_desc, pbuf_set_field use cam_abortutils, only: endrun - use dyn_tests_utils, only: vc_physics, vc_dycore, vc_height + use dyn_tests_utils, only: vc_physics, vc_dycore, vc_height, vc_dry_pressure use physics_types, only: phys_te_idx, dyn_te_idx !----------------------------------------------------------------------- ! Compute initial values of energy and water integrals, @@ -268,7 +268,7 @@ subroutine check_energy_timestep_init(state, tend, pbuf, col_type) if (state%psetcols == pcols) then cp_or_cv(:,:) = cpairv(:,:,lchnk) else if (state%psetcols > pcols .and. all(cpairv(:,:,lchnk) == cpair)) then - cp_or_cv(:,:) = cpair + cp_or_cv(1:ncol,:) = cpair else call endrun('check_energy_timestep_init: cpairv is not allowed to vary when subcolumns are turned on') end if @@ -286,13 +286,15 @@ subroutine check_energy_timestep_init(state, tend, pbuf, col_type) state%temp_ini(:ncol,:) = state%T(:ncol,:) state%z_ini(:ncol,:) = state%zm(:ncol,:) if (vc_dycore == vc_height) then + ! + ! MPAS specific hydrostatic energy computation (internal energy) ! ! compute cv if vertical coordinate is height: cv = cp - R ! if (state%psetcols == pcols) then - cp_or_cv(:,:) = cpairv(:,:,lchnk)-rairv(:,:,lchnk) + cp_or_cv(:ncol,:) = cpairv(:ncol,:,lchnk)-rairv(:ncol,:,lchnk) else - cp_or_cv(:,:) = cpair-rair + cp_or_cv(:ncol,:) = cpair-rair endif call get_hydrostatic_energy(state%q(1:ncol,1:pver,1:pcnst),.true., & @@ -301,11 +303,27 @@ subroutine check_energy_timestep_init(state, tend, pbuf, col_type) vc_dycore, ptop=state%pintdry(1:ncol,1), phis = state%phis(1:ncol), & z_mid = state%z_ini(1:ncol,:), & te = state%te_ini(1:ncol,dyn_te_idx), H2O = state%tw_ini(1:ncol,dyn_te_idx)) + else if (vc_dycore == vc_dry_pressure) then + ! + ! SE specific hydrostatic energy (enthalpy) + ! + if (state%psetcols == pcols) then + cp_or_cv(:ncol,:) = cpair_dycore(:ncol,:,lchnk) + else + cp_or_cv(:ncol,:) = cpair + endif + call get_hydrostatic_energy(state%q(1:ncol,1:pver,1:pcnst),.true., & + state%pdel(1:ncol,1:pver), cp_or_cv(1:ncol,1:pver), & + state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), state%T(1:ncol,1:pver), & + vc_dry_pressure, ptop=state%pintdry(1:ncol,1), phis = state%phis(1:ncol), & + te = state%te_ini(1:ncol,dyn_te_idx), H2O = state%tw_ini(1:ncol,dyn_te_idx)) else + ! + ! dycore energy is the same as physics + ! state%te_ini(1:ncol,dyn_te_idx) = state%te_ini(1:ncol,phys_te_idx) state%tw_ini(1:ncol,dyn_te_idx) = state%tw_ini(1:ncol,phys_te_idx) end if - state%te_cur(:ncol,:) = state%te_ini(:ncol,:) state%tw_cur(:ncol,:) = state%tw_ini(:ncol,:) @@ -419,7 +437,7 @@ end subroutine check_energy_budgets_init subroutine check_energy_chng(state, tend, name, nstep, ztodt, & flx_vap, flx_cnd, flx_ice, flx_sen) use cam_thermo, only: get_hydrostatic_energy - use dyn_tests_utils, only: vc_physics, vc_dycore, vc_height + use dyn_tests_utils, only: vc_physics, vc_dycore, vc_height, vc_dry_pressure use cam_abortutils, only: endrun use physics_types, only: phys_te_idx, dyn_te_idx !----------------------------------------------------------------------- @@ -486,7 +504,6 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & else call endrun('check_energy_chng: cpairv is not allowed to vary when subcolumns are turned on') end if - call get_hydrostatic_energy(state%q(1:ncol,1:pver,1:pcnst),.true., & state%pdel(1:ncol,1:pver), cp_or_cv(1:ncol,1:pver), & state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), state%T(1:ncol,1:pver), & @@ -561,14 +578,12 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & ! compute cv if vertical coordinate is height: cv = cp - R ! ! Note: cp_or_cv set above for pressure coordinate - ! if (state%psetcols == pcols) then - cp_or_cv(:,:) = cpairv(:,:,lchnk)-rairv(:,:,lchnk) + cp_or_cv(:ncol,:) = cpairv(:ncol,:,lchnk)-rairv(:ncol,:,lchnk) else - cp_or_cv(:,:) = cpair-rair + cp_or_cv(:ncol,:) = cpair-rair endif - scaling(:,:) = cpairv(:,:,lchnk)/cp_or_cv(:,:) !cp/cv scaling - + scaling(:,:) = cpairv(:,:,lchnk)/cp_or_cv(:,:) !cp/cv scaling temp(1:ncol,:) = state%temp_ini(1:ncol,:)+scaling(1:ncol,:)*(state%T(1:ncol,:)-state%temp_ini(1:ncol,:)) call get_hydrostatic_energy(state%q(1:ncol,1:pver,1:pcnst),.true., & state%pdel(1:ncol,1:pver), cp_or_cv(1:ncol,1:pver), & @@ -576,6 +591,25 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & vc_dycore, ptop=state%pintdry(1:ncol,1), phis = state%phis(1:ncol), & z_mid = state%z_ini(1:ncol,:), & te = state%te_cur(1:ncol,dyn_te_idx), H2O = state%tw_cur(1:ncol,dyn_te_idx)) + else if (vc_dycore == vc_dry_pressure) then + ! + ! SE specific hydrostatic energy + ! + if (state%psetcols == pcols) then + cp_or_cv(:ncol,:) = cpair_dycore(:ncol,:,lchnk) + else + cp_or_cv(:ncol,:) = cpair + endif + ! + ! enthalpy scaling for energy consistency + ! + scaling(:ncol,:) = cpairv(:ncol,:,lchnk)/cpair_dycore(:ncol,:,lchnk) + temp(1:ncol,:) = state%temp_ini(1:ncol,:)+scaling(1:ncol,:)*(state%T(1:ncol,:)-state%temp_ini(1:ncol,:)) + call get_hydrostatic_energy(state%q(1:ncol,1:pver,1:pcnst),.true., & + state%pdel(1:ncol,1:pver), cp_or_cv(1:ncol,1:pver), & + state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), temp(1:ncol,1:pver), & + vc_dry_pressure, ptop=state%pintdry(1:ncol,1), phis = state%phis(1:ncol), & + te = state%te_cur(1:ncol,dyn_te_idx), H2O = state%tw_cur(1:ncol,dyn_te_idx)) else state%te_cur(1:ncol,dyn_te_idx) = te(1:ncol) state%tw_cur(1:ncol,dyn_te_idx) = tw(1:ncol) @@ -1056,7 +1090,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) use cam_thermo, only: get_hydrostatic_energy,thermo_budget_num_vars,thermo_budget_vars, & wvidx,wlidx,wiidx,seidx,keidx,moidx,mridx,ttidx,teidx,poidx use cam_history, only: hist_fld_active, outfld - use dyn_tests_utils, only: vc_physics, vc_height + use dyn_tests_utils, only: vc_physics, vc_height, vc_dry_pressure use cam_abortutils, only: endrun use budgets, only: budget_info_byname use cam_history_support, only: max_fieldname_len @@ -1105,88 +1139,90 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) name_out6 = 'TT_' //trim(outfld_name_suffix) name_out7 = 'TE_' //trim(outfld_name_suffix) - lchnk = state%lchnk - ncol = state%ncol - - call budget_info_byname(trim(outfld_name_suffix),budget_ind=b_ind,state_ind=s_ind) + lchnk = state%lchnk + ncol = state%ncol - if (present(vc)) then - vc_loc = vc - else - vc_loc = vc_physics - end if + call budget_info_byname(trim(outfld_name_suffix),budget_ind=b_ind,state_ind=s_ind) - if (state%psetcols == pcols) then - if (vc_loc == vc_height) then - ! - ! compute cv if vertical coordinate is height: cv = cp - R - ! - cp_or_cv(:,:) = cpairv(:,:,lchnk)-rairv(:,:,lchnk)!cv - else - cp_or_cv(:,:) = cpairv(:,:,lchnk) !cp - end if - else - call endrun('calc_te_and_aam_budgets: energy diagnostics not implemented/tested for subcolumns') - end if + if (present(vc)) then + vc_loc = vc + else + vc_loc = vc_physics + end if + if (state%psetcols == pcols) then if (vc_loc == vc_height) then - scaling(:,:) = cpairv(:,:,lchnk)/cp_or_cv(:,:) !cp/cv scaling for temperature increment under constant volume + ! + ! compute cv if vertical coordinate is height: cv = cp - R + ! + cp_or_cv(:,:) = cpairv(:,:,lchnk)-rairv(:,:,lchnk)!cv + else if (vc_loc == vc_dry_pressure) then + cp_or_cv(:ncol,:) = cpair_dycore(:ncol,:,lchnk) else - scaling(:,:) = 1.0_r8 + cp_or_cv(:ncol,:) = cpairv(:ncol,:,lchnk) end if - ! scale accumulated temperature increment for constant volume (otherwise effectively do nothing) - temp(1:ncol,:) = state%temp_ini(1:ncol,:)+scaling(1:ncol,:)*(state%T(1:ncol,:)- state%temp_ini(1:ncol,:)) + else + call endrun('calc_te_and_aam_budgets: energy diagnostics not implemented/tested for subcolumns') + end if - call get_hydrostatic_energy(state%q(1:ncol,1:pver,1:pcnst),.true., & - state%pdel(1:ncol,1:pver), cp_or_cv(1:ncol,1:pver), & - state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), temp(1:ncol,1:pver), & - vc_loc, ptop=state%pintdry(1:ncol,1), phis = state%phis(1:ncol),& - z_mid = state%z_ini(1:ncol,:), se = se(1:ncol), & - po = po(1:ncol), ke = ke(1:ncol), wv = wv(1:ncol), liq = liq(1:ncol), & - ice = ice(1:ncol)) - - call cnst_get_ind('TT_LW' , ixtt , abort=.false.) - - tt = 0._r8 - if (ixtt > 1) then - if (name_out6 == 'TT_pAM'.or.name_out6 == 'TT_zAM') then - ! - ! after dme_adjust mixing ratios are all wet - ! - do k = 1, pver - do i = 1, ncol - tt_tmp = state%q(i,k,ixtt)*state%pdel(i,k)/gravit - tt (i) = tt(i) + tt_tmp - end do + if (vc_loc == vc_height) then + scaling(:ncol,:) = cpairv(:ncol,:,lchnk)/cp_or_cv(:ncol,:) !cp/cv scaling for temperature increment under constant volume + else if (vc_loc == vc_dry_pressure) then + scaling(:ncol,:) = cpairv(:ncol,:,lchnk)/cpair_dycore(:ncol,:,lchnk) + else + scaling(:ncol,:) = 1.0_r8 !internal energy / enthalpy same as CAM physics + end if + ! scale accumulated temperature increment for internal energy / enthalpy consistency + temp(1:ncol,:) = state%temp_ini(1:ncol,:)+scaling(1:ncol,:)*(state%T(1:ncol,:)- state%temp_ini(1:ncol,:)) + call get_hydrostatic_energy(state%q(1:ncol,1:pver,1:pcnst),.true., & + state%pdel(1:ncol,1:pver), cp_or_cv(1:ncol,1:pver), & + state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), temp(1:ncol,1:pver), & + vc_loc, ptop=state%pintdry(1:ncol,1), phis = state%phis(1:ncol), & + z_mid = state%z_ini(1:ncol,:), se = se(1:ncol), & + po = po(1:ncol), ke = ke(1:ncol), wv = wv(1:ncol), liq = liq(1:ncol), & + ice = ice(1:ncol)) + + call cnst_get_ind('TT_LW' , ixtt , abort=.false.) + tt = 0._r8 + if (ixtt > 1) then + if (name_out6 == 'TT_pAM'.or.name_out6 == 'TT_zAM') then + ! + ! after dme_adjust mixing ratios are all wet + ! + do k = 1, pver + do i = 1, ncol + tt_tmp = state%q(i,k,ixtt)*state%pdel(i,k)/gravit + tt (i) = tt(i) + tt_tmp end do - else - do k = 1, pver - do i = 1, ncol - tt_tmp = state%q(i,k,ixtt)*state%pdeldry(i,k)/gravit - tt (i) = tt(i) + tt_tmp - end do + end do + else + do k = 1, pver + do i = 1, ncol + tt_tmp = state%q(i,k,ixtt)*state%pdeldry(i,k)/gravit + tt (i) = tt(i) + tt_tmp end do - end if + end do end if + end if - state%te_budgets(1:ncol,teidx,s_ind)=state%te_budgets(1:ncol,teidx,s_ind)+se(1:ncol)+ke(1:ncol)+po(1:ncol) - state%te_budgets(1:ncol,seidx,s_ind)= state%te_budgets(1:ncol,seidx,s_ind)+se(1:ncol) - state%te_budgets(1:ncol,poidx,s_ind)= state%te_budgets(1:ncol,poidx,s_ind)+po(1:ncol) - state%te_budgets(1:ncol,keidx,s_ind)= state%te_budgets(1:ncol,keidx,s_ind)+ke(1:ncol) - state%te_budgets(1:ncol,wvidx,s_ind)= state%te_budgets(1:ncol,wvidx,s_ind)+wv(1:ncol) - state%te_budgets(1:ncol,wlidx,s_ind)= state%te_budgets(1:ncol,wlidx,s_ind)+liq(1:ncol) - state%te_budgets(1:ncol,wiidx,s_ind)= state%te_budgets(1:ncol,wiidx,s_ind)+ice(1:ncol) - state%te_budgets(1:ncol,ttidx,s_ind)= state%te_budgets(1:ncol,ttidx,s_ind)+tt(1:ncol) - state%budget_cnt(b_ind)=state%budget_cnt(b_ind)+1 - ! Output energy diagnostics - - call outfld(name_out1 ,se+po ,pcols ,lchnk ) - call outfld(name_out2 ,ke ,pcols ,lchnk ) - call outfld(name_out3 ,wv ,pcols ,lchnk ) - call outfld(name_out4 ,liq ,pcols ,lchnk ) - call outfld(name_out5 ,ice ,pcols ,lchnk ) - call outfld(name_out6 ,tt ,pcols ,lchnk ) - call outfld(name_out7 ,se+ke+po ,pcols ,lchnk ) + state%te_budgets(1:ncol,teidx,s_ind)=state%te_budgets(1:ncol,teidx,s_ind)+se(1:ncol)+ke(1:ncol)+po(1:ncol) + state%te_budgets(1:ncol,seidx,s_ind)= state%te_budgets(1:ncol,seidx,s_ind)+se(1:ncol) + state%te_budgets(1:ncol,poidx,s_ind)= state%te_budgets(1:ncol,poidx,s_ind)+po(1:ncol) + state%te_budgets(1:ncol,keidx,s_ind)= state%te_budgets(1:ncol,keidx,s_ind)+ke(1:ncol) + state%te_budgets(1:ncol,wvidx,s_ind)= state%te_budgets(1:ncol,wvidx,s_ind)+wv(1:ncol) + state%te_budgets(1:ncol,wlidx,s_ind)= state%te_budgets(1:ncol,wlidx,s_ind)+liq(1:ncol) + state%te_budgets(1:ncol,wiidx,s_ind)= state%te_budgets(1:ncol,wiidx,s_ind)+ice(1:ncol) + state%te_budgets(1:ncol,ttidx,s_ind)= state%te_budgets(1:ncol,ttidx,s_ind)+tt(1:ncol) + state%budget_cnt(b_ind)=state%budget_cnt(b_ind)+1 + ! Output energy diagnostics + + call outfld(name_out1 ,se+po ,pcols ,lchnk ) + call outfld(name_out2 ,ke ,pcols ,lchnk ) + call outfld(name_out3 ,wv ,pcols ,lchnk ) + call outfld(name_out4 ,liq ,pcols ,lchnk ) + call outfld(name_out5 ,ice ,pcols ,lchnk ) + call outfld(name_out6 ,tt ,pcols ,lchnk ) + call outfld(name_out7 ,se+ke+po ,pcols ,lchnk ) !!$ call outfld(name_out(seidx) ,se , pcols ,lchnk ) !!$ call outfld(name_out(keidx) ,ke , pcols ,lchnk ) diff --git a/src/physics/cam/physics_types.F90 b/src/physics/cam/physics_types.F90 index ace701d4bd..b5738a4e05 100644 --- a/src/physics/cam/physics_types.F90 +++ b/src/physics/cam/physics_types.F90 @@ -212,10 +212,11 @@ subroutine physics_update(state, ptend, dt, tend) !----------------------------------------------------------------------- ! Update the state and or tendency structure with the parameterization tendencies !----------------------------------------------------------------------- - use scamMod, only: scm_crm_mode, single_column - use phys_control, only: phys_getopts - use cam_thermo, only: cam_thermo_update ! Routine which updates physconst variables (WACCM-X) - use qneg_module, only: qneg3 + use scamMod, only: scm_crm_mode, single_column + use phys_control, only: phys_getopts + use cam_thermo, only: cam_thermo_dry_air_update ! Routine which updates physconst variables (WACCM-X) + use air_composition, only: dry_air_species_num + use qneg_module , only: qneg3 !------------------------------Arguments-------------------------------- type(physics_ptend), intent(inout) :: ptend ! Parameterization tendencies @@ -379,9 +380,8 @@ subroutine physics_update(state, ptend, dt, tend) !------------------------------------------------------------------------ ! Get indices for molecular weights and call WACCM-X cam_thermo_update !------------------------------------------------------------------------ - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then - call cam_thermo_update(state%q, state%t, state%lchnk, state%ncol, & - to_moist_factor=state%pdeldry(:ncol,:)/state%pdel(:ncol,:) ) + if (dry_air_species_num>0) then + call cam_thermo_dry_air_update(state%q, state%t, state%lchnk, state%ncol) endif !----------------------------------------------------------------------- @@ -1280,8 +1280,6 @@ subroutine physics_dme_adjust(state, tend, qini, liqini, iceini, dt) ! constituents, momentum, and total energy state%ps(:ncol) = state%pint(:ncol,1) do k = 1, pver -!#define phl_cam_development -#ifndef phl_cam_development tot_water(:ncol,1) = qini(:ncol,k)+liqini(:ncol,k)+iceini(:ncol,k) !initial total H2O tot_water(:ncol,2) = 0.0_r8 do m_cnst=dry_air_species_num+1,thermodynamic_active_species_num @@ -1289,21 +1287,17 @@ subroutine physics_dme_adjust(state, tend, qini, liqini, iceini, dt) tot_water(:ncol,2) = tot_water(:ncol,2)+state%q(:ncol,k,m) end do fdq(:ncol) = 1._r8 + tot_water(:ncol,2) - tot_water(:ncol,1) -#else - fdq(:ncol) = 1._r8 + state%q(:ncol,k,1) - qini(:ncol,k) -#endif - ! adjust constituents to conserve mass in each layer - do m = 1, pcnst - state%q(:ncol,k,m) = state%q(:ncol,k,m) / fdq(:ncol) - end do - -! compute new total pressure variables - state%pdel (:ncol,k ) = state%pdel(:ncol,k ) * fdq(:ncol) - state%ps(:ncol) = state%ps(:ncol) + state%pdel(:ncol,k) - state%pint (:ncol,k+1) = state%pint(:ncol,k ) + state%pdel(:ncol,k) - state%lnpint(:ncol,k+1) = log(state%pint(:ncol,k+1)) - state%rpdel (:ncol,k ) = 1._r8/ state%pdel(:ncol,k ) - !note that mid-level variables (e.g. pmid) are not recomputed + ! adjust constituents to conserve mass in each layer + do m = 1, pcnst + state%q(:ncol,k,m) = state%q(:ncol,k,m) / fdq(:ncol) + end do + ! compute new total pressure variables + state%pdel (:ncol,k ) = state%pdel(:ncol,k ) * fdq(:ncol) + state%ps(:ncol) = state%ps(:ncol) + state%pdel(:ncol,k) + state%pint (:ncol,k+1) = state%pint(:ncol,k ) + state%pdel(:ncol,k) + state%lnpint(:ncol,k+1) = log(state%pint(:ncol,k+1)) + state%rpdel (:ncol,k ) = 1._r8/ state%pdel(:ncol,k ) + !note that mid-level variables (e.g. pmid) are not recomputed end do if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 5c821393a9..c7f710d648 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -1413,7 +1413,7 @@ subroutine tphysac (ztodt, cam_in, & use cam_snapshot, only: cam_snapshot_all_outfld_tphysac use cam_snapshot_common,only: cam_snapshot_ptend_outfld use lunar_tides, only: lunar_tides_tend - + use cam_thermo, only: cam_thermo_water_update ! ! Arguments ! @@ -1903,6 +1903,7 @@ subroutine tphysac (ztodt, cam_in, & ! So, save off tracers if (.not.moist_mixing_ratio_dycore.and.& (hist_fld_active('SE_phAM').or.hist_fld_active('KE_phAM').or.hist_fld_active('WV_phAM').or.& + hist_fld_active('SE_dyAM').or.hist_fld_active('KE_dyAM').or.hist_fld_active('WV_dyAM').or.& hist_fld_active('WL_phAM').or.hist_fld_active('WI_phAM').or.hist_fld_active('MR_phAM').or.& hist_fld_active('MO_phAM'))) then tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) @@ -1910,9 +1911,10 @@ subroutine tphysac (ztodt, cam_in, & tmp_ps(:ncol) = state%ps(:ncol) call set_dry_to_wet(state) - call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) - + ! update cp/cv for energy computation based in updated water variables + call cam_thermo_water_update(state%q(:ncol,:,:), lchnk, ncol, & + to_dry_factor=state%pdel(:ncol,:)/state%pdeldry(:ncol,:)) call calc_te_and_aam_budgets(state, 'phAM') call calc_te_and_aam_budgets(state, 'dyAM', vc=vc_dycore) ! Restore pre-"physics_dme_adjust" tracers diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index 8155ea45f8..ae9bf3ffbb 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -1393,6 +1393,7 @@ subroutine tphysac (ztodt, cam_in, & use carma_flags_mod, only: carma_do_aerosol, carma_do_emission, carma_do_detrain use carma_flags_mod, only: carma_do_cldice, carma_do_cldliq, carma_do_wetdep use dyn_tests_utils, only: vc_dycore + use cam_thermo, only: cam_thermo_water_update ! ! Arguments ! @@ -2342,12 +2343,15 @@ subroutine tphysac (ztodt, cam_in, & ! FV: convert dry-type mixing ratios to moist here because physics_dme_adjust ! assumes moist. This is done in p_d_coupling for other dynamics. Bundy, Feb 2004. moist_mixing_ratio_dycore = dycore_is('LR').or. dycore_is('FV3') - if (moist_mixing_ratio_dycore) call set_dry_to_wet(state) ! Physics had dry, dynamics wants moist + ! Physics had dry, dynamics wants moist + ! Note: this operation will NOT be reverted with set_wet_to_dry after set_dry_to_wet call + if (moist_mixing_ratio_dycore) call set_dry_to_wet(state) ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. ! So, save off tracers if (.not.moist_mixing_ratio_dycore.and.& (hist_fld_active('SE_phAM').or.hist_fld_active('KE_phAM').or.hist_fld_active('WV_phAM').or.& + hist_fld_active('SE_dyAM').or.hist_fld_active('KE_dyAM').or.hist_fld_active('WV_dyAM').or.& hist_fld_active('WL_phAM').or.hist_fld_active('WI_phAM').or.hist_fld_active('MR_phAM').or.& hist_fld_active('MO_phAM'))) then tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) @@ -2355,9 +2359,10 @@ subroutine tphysac (ztodt, cam_in, & tmp_ps(:ncol) = state%ps(:ncol) call set_dry_to_wet(state) - - call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) + ! update cp/cv for energy computation based in updated water variables + call cam_thermo_water_update(state%q(:ncol,:,:), lchnk, ncol, & + to_dry_factor=state%pdel(:ncol,:)/state%pdeldry(:ncol,:)) call calc_te_and_aam_budgets(state, 'phAM') call calc_te_and_aam_budgets(state, 'dyAM', vc=vc_dycore) @@ -2373,7 +2378,6 @@ subroutine tphysac (ztodt, cam_in, & call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) end if - call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) if (trim(cam_take_snapshot_after) == "physics_dme_adjust") then diff --git a/src/utils/air_composition.F90 b/src/utils/air_composition.F90 index 367f52811a..4861842837 100644 --- a/src/utils/air_composition.F90 +++ b/src/utils/air_composition.F90 @@ -10,7 +10,9 @@ module air_composition public :: air_composition_readnl public :: air_composition_init - public :: air_composition_update + public :: dry_air_composition_update + public :: water_composition_update + ! get_cp_dry: (generalized) heat capacity for dry air public :: get_cp_dry ! get_cp: (generalized) heat capacity @@ -103,6 +105,8 @@ module air_composition ! mbarv: composition dependent atmosphere mean mass real(r8), public, protected, allocatable :: mbarv(:,:,:) + ! cpair_dycore: composition dependent specific heat at constant pressure + real(r8), public, protected, allocatable :: cpair_dycore(:,:,:) ! ! Interfaces for public routines interface get_cp_dry @@ -330,6 +334,10 @@ subroutine air_composition_init() if (ierr /= 0) then call endrun(errstr//"mbarv") end if + allocate(cpair_dycore(pcols,pver,begchunk:endchunk), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"cpair_dycore") + end if thermodynamic_active_species_idx = -HUGE(1) thermodynamic_active_species_idx_dycore = -HUGE(1) @@ -342,10 +350,11 @@ subroutine air_composition_init() !------------------------------------------------------------------------ ! Initialize constituent dependent properties !------------------------------------------------------------------------ - cpairv(:pcols, :pver, begchunk:endchunk) = cpair - rairv(:pcols, :pver, begchunk:endchunk) = rair - cappav(:pcols, :pver, begchunk:endchunk) = rair / cpair - mbarv(:pcols, :pver, begchunk:endchunk) = mwdry + cpairv(:pcols, :pver, begchunk:endchunk) = cpair + rairv(:pcols, :pver, begchunk:endchunk) = rair + cappav(:pcols, :pver, begchunk:endchunk) = rair / cpair + mbarv(:pcols, :pver, begchunk:endchunk) = mwdry + cpair_dycore(:pcols, :pver, begchunk:endchunk) = cpair ! if (dry_air_species_num > 0) then ! @@ -620,27 +629,49 @@ end subroutine air_composition_init !=========================================================================== !----------------------------------------------------------------------- - ! air_composition_update: Update the physics "constants" that vary + ! dry_air_composition_update: Update the physics "constants" that vary !------------------------------------------------------------------------- !=========================================================================== - subroutine air_composition_update(mmr, lchnk, ncol, to_moist_factor) - - real(r8), intent(in) :: mmr(:,:,:) ! constituents array + subroutine dry_air_composition_update(mmr, lchnk, ncol, to_dry_factor) + use cam_abortutils, only: endrun + !(mmr = dry mixing ratio, if not, use to_dry_factor to convert!) + real(r8), intent(in) :: mmr(:,:,:) ! mixing ratios for species dependent dry air integer, intent(in) :: lchnk ! Chunk number integer, intent(in) :: ncol ! number of columns - real(r8), optional, intent(in) :: to_moist_factor(:,:) + real(r8), optional, intent(in) :: to_dry_factor(:,:) call get_R_dry(mmr(:ncol, :, :), thermodynamic_active_species_idx, & - rairv(:ncol, :, lchnk), fact=to_moist_factor) - call get_cp_dry(mmr(:ncol,:,:), thermodynamic_active_species_idx, & - cpairv(:ncol,:,lchnk), fact=to_moist_factor) - call get_mbarv(mmr(:ncol,:,:), thermodynamic_active_species_idx, & - mbarv(:ncol,:,lchnk), fact=to_moist_factor) - + rairv(:ncol, :, lchnk), fact=to_dry_factor) + call get_cp_dry(mmr(:ncol,:,:), thermodynamic_active_species_idx, & + cpairv(:ncol,:,lchnk), fact=to_dry_factor) + call get_mbarv(mmr(:ncol,:,:), thermodynamic_active_species_idx, & + mbarv(:ncol,:,lchnk), fact=to_dry_factor) cappav(:ncol,:,lchnk) = rairv(:ncol,:,lchnk) / cpairv(:ncol,:,lchnk) + end subroutine dry_air_composition_update - end subroutine air_composition_update + !=========================================================================== + !----------------------------------------------------------------------- + ! dry_air_composition_update: Update the physics "constants" that vary xxx change description + !------------------------------------------------------------------------- + !=========================================================================== + + subroutine water_composition_update(mmr, lchnk, ncol, to_dry_factor) + use cam_abortutils, only: endrun + + real(r8), intent(in) :: mmr(:,:,:) ! constituents array + integer, intent(in) :: lchnk ! Chunk number + integer, intent(in) :: ncol ! number of columns + real(r8), optional, intent(in) :: to_dry_factor(:,:) + + real(r8), dimension(ncol,SIZE(mmr, 2),thermodynamic_active_species_num-dry_air_species_num) :: dry_mmr + integer, dimension(thermodynamic_active_species_num-dry_air_species_num) :: idx_water + character(len=*), parameter :: subname = 'water_composition_update' + integer :: i, num_water, idx_cam + + call get_cp(mmr(:ncol,:,:),.false.,cpair_dycore(:ncol,:,lchnk), factor=to_dry_factor, & + active_species_idx_dycore=thermodynamic_active_species_idx,cpdry=cpairv(:ncol,:,lchnk)) + end subroutine water_composition_update !=========================================================================== !*************************************************************************** @@ -750,29 +781,35 @@ end subroutine get_cp_dry_2hd ! !*************************************************************************** ! - subroutine get_cp_1hd(tracer, inv_cp, cp, dp_dry, active_species_idx_dycore) + subroutine get_cp_1hd(tracer, inv_cp, cp, factor, active_species_idx_dycore, cpdry) use cam_abortutils, only: endrun use string_utils, only: int2str ! Dummy arguments - ! tracedr: Tracer array + ! tracer: Tracer array + ! + ! factor not present then tracer must be dry mixing ratio + ! if factor present tracer*factor must be dry mixing ratio + ! real(r8), intent(in) :: tracer(:,:,:) - real(r8), optional, intent(in) :: dp_dry(:,:) ! inv_cp: output inverse cp instead of cp logical, intent(in) :: inv_cp real(r8), intent(out) :: cp(:,:) + ! dp: if provided then tracer is mass not mixing ratio + real(r8), optional, intent(in) :: factor(:,:) ! active_species_idx_dycore: array of indices for index of ! thermodynamic active species in dycore tracer array ! (if different from physics index) integer, optional, intent(in) :: active_species_idx_dycore(:) + real(r8),optional, intent(in) :: cpdry(:,:) - ! Local variables + ! LOCAL VARIABLES integer :: qdx, itrac real(r8) :: sum_species(SIZE(cp, 1), SIZE(cp, 2)) real(r8) :: sum_cp(SIZE(cp, 1), SIZE(cp, 2)) - real(r8) :: factor(SIZE(cp, 1), SIZE(cp, 2)) + real(r8) :: factor_local(SIZE(cp, 1), SIZE(cp, 2)) integer :: idx_local(thermodynamic_active_species_num) - character(len=*), parameter :: subname = 'get_cp_1hd: ' + character(LEN=*), parameter :: subname = 'get_cp_1hd: ' if (present(active_species_idx_dycore)) then if (SIZE(active_species_idx_dycore) /= & @@ -786,51 +823,57 @@ subroutine get_cp_1hd(tracer, inv_cp, cp, dp_dry, active_species_idx_dycore) idx_local = thermodynamic_active_species_idx end if - if (present(dp_dry)) then - factor = 1.0_r8 / dp_dry + if (present(factor)) then + factor_local = factor else - factor = 1.0_r8 + factor_local = 1.0_r8 end if + sum_species = 1.0_r8 ! all dry air species sum to 1 do qdx = dry_air_species_num + 1, thermodynamic_active_species_num - itrac = idx_local(qdx) - sum_species(:,:) = sum_species(:,:) + & - (tracer(:,:,itrac) * factor(:,:)) + itrac = idx_local(qdx) + sum_species(:,:) = sum_species(:,:) + (tracer(:,:,itrac) * factor_local(:,:)) end do if (dry_air_species_num == 0) then sum_cp = thermodynamic_active_species_cp(0) + else if (present(cpdry)) then + ! + ! if cpdry is known don't recompute + ! + sum_cp = cpdry else - call get_cp_dry(tracer, idx_local, sum_cp, fact=factor) + call get_cp_dry(tracer, idx_local, sum_cp, fact=factor_local) end if do qdx = dry_air_species_num + 1, thermodynamic_active_species_num - itrac = idx_local(qdx) - sum_cp(:,:) = sum_cp(:,:) + & - (thermodynamic_active_species_cp(qdx) * tracer(:,:,itrac) * & - factor(:,:)) + itrac = idx_local(qdx) + sum_cp(:,:) = sum_cp(:,:)+ & + thermodynamic_active_species_cp(qdx) * tracer(:,:,itrac)* factor_local(:,:) end do if (inv_cp) then - cp = sum_species / sum_cp + cp = sum_species / sum_cp else - cp = sum_cp / sum_species + cp = sum_cp / sum_species end if - - end subroutine get_cp_1hd + end subroutine get_cp_1hd !=========================================================================== - subroutine get_cp_2hd(tracer, inv_cp, cp, dp_dry, active_species_idx_dycore) + subroutine get_cp_2hd(tracer, inv_cp, cp, factor, active_species_idx_dycore, cpdry) ! Version of get_cp for arrays that have a second horizontal index use cam_abortutils, only: endrun use string_utils, only: int2str ! Dummy arguments ! tracer: Tracer array + ! real(r8), intent(in) :: tracer(:,:,:,:) - real(r8), optional, intent(in) :: dp_dry(:,:,:) ! inv_cp: output inverse cp instead of cp logical, intent(in) :: inv_cp real(r8), intent(out) :: cp(:,:,:) + real(r8), optional, intent(in) :: factor(:,:,:) + real(r8), optional, intent(in) :: cpdry(:,:,:) + ! active_species_idx_dycore: array of indicies for index of ! thermodynamic active species in dycore tracer array ! (if different from physics index) @@ -842,11 +885,17 @@ subroutine get_cp_2hd(tracer, inv_cp, cp, dp_dry, active_species_idx_dycore) character(len=*), parameter :: subname = 'get_cp_2hd: ' do jdx = 1, SIZE(cp, 2) - if (present(dp_dry)) then - call get_cp(tracer(:, jdx, :, :), inv_cp, cp(:, jdx, :), & - dp_dry=dp_dry(:, jdx, :), active_species_idx_dycore=active_species_idx_dycore) + if (present(factor).and.present(cpdry)) then + call get_cp(tracer(:, jdx, :, :), inv_cp, cp(:, jdx, :),& + factor=factor(:, jdx, :), active_species_idx_dycore=active_species_idx_dycore, cpdry=cpdry(:,jdx,:)) + else if (present(factor)) then + call get_cp(tracer(:, jdx, :, :), inv_cp, cp(:, jdx, :),& + factor=factor(:, jdx, :), active_species_idx_dycore=active_species_idx_dycore) + else if (present(cpdry)) then + call get_cp(tracer(:, jdx, :, :), inv_cp, cp(:, jdx, :),& + active_species_idx_dycore=active_species_idx_dycore, cpdry=cpdry(:,jdx,:)) else - call get_cp(tracer(:, jdx, :, :), inv_cp, cp(:, jdx, :), & + call get_cp(tracer(:, jdx, :, :), inv_cp, cp(:, jdx, :),& active_species_idx_dycore=active_species_idx_dycore) end if end do diff --git a/src/utils/cam_thermo.F90 b/src/utils/cam_thermo.F90 index 271782d815..5f821e0a21 100644 --- a/src/utils/cam_thermo.F90 +++ b/src/utils/cam_thermo.F90 @@ -18,6 +18,7 @@ module cam_thermo use air_composition, only: thermodynamic_active_species_liq_idx_dycore use air_composition, only: thermodynamic_active_species_ice_idx use air_composition, only: thermodynamic_active_species_ice_idx_dycore + use air_composition, only: dry_air_species_num use air_composition, only: enthalpy_reference_state use air_composition, only: mmro2, mmrn2, o2_mwi, n2_mwi, mbar @@ -33,8 +34,10 @@ module cam_thermo ! cam_thermo_init: Initialize constituent dependent properties public :: cam_thermo_init - ! cam_thermo_update: Update constituent dependent properties - public :: cam_thermo_update + ! cam_thermo_update: Update dry air composition dependent properties + public :: cam_thermo_dry_air_update + ! cam_thermo_update: Update water dependent properties + public :: cam_thermo_water_update ! get_enthalpy: enthalpy quantity = dp*cp*T public :: get_enthalpy ! get_virtual_temp: virtual temperature @@ -174,7 +177,7 @@ module cam_thermo integer, public, parameter :: wvidx = 1 integer, public, parameter :: wlidx = 2 integer, public, parameter :: wiidx = 3 - integer, public, parameter :: seidx = 4 ! enthalpy or internal energy (J/m2) index + integer, public, parameter :: seidx = 4 ! enthalpy or internal energy (W/m2) index integer, public, parameter :: poidx = 5 ! surface potential or potential energy index integer, public, parameter :: keidx = 6 ! kinetic energy index integer, public, parameter :: mridx = 7 @@ -243,39 +246,53 @@ end subroutine cam_thermo_init ! !*************************************************************************** ! - subroutine cam_thermo_update(mmr, T, lchnk, ncol, to_moist_factor) - use air_composition, only: air_composition_update + subroutine cam_thermo_dry_air_update(mmr, T, lchnk, ncol, to_dry_factor) + use air_composition, only: dry_air_composition_update use string_utils, only: int2str !----------------------------------------------------------------------- ! Update the physics "constants" that vary !------------------------------------------------------------------------- !------------------------------Arguments---------------------------------- - + !(mmr = dry mixing ratio, if not use to_moist_factor to convert) real(r8), intent(in) :: mmr(:,:,:) ! constituents array real(r8), intent(in) :: T(:,:) ! temperature integer, intent(in) :: lchnk ! Chunk number integer, intent(in) :: ncol ! number of columns - real(r8), optional, intent(in) :: to_moist_factor(:,:) + real(r8), optional, intent(in) :: to_dry_factor(:,:) ! !---------------------------Local storage------------------------------- real(r8):: sponge_factor(SIZE(mmr, 2)) character(len=*), parameter :: subname = 'cam_thermo_update: ' - - if (present(to_moist_factor)) then - if (SIZE(to_moist_factor, 1) /= ncol) then - call endrun(subname//'DIM 1 of to_moist_factor is'//int2str(SIZE(to_moist_factor,1))//'but should be'//int2str(ncol)) - end if + if (present(to_dry_factor)) then + if (SIZE(to_dry_factor, 1) /= ncol) then + call endrun(subname//'DIM 1 of to_dry_factor is'//int2str(SIZE(to_dry_factor,1))//'but should be'//int2str(ncol)) + end if end if - sponge_factor = 1.0_r8 - call air_composition_update(mmr, lchnk, ncol, to_moist_factor=to_moist_factor) + sponge_factor = 1.0_r8 + call dry_air_composition_update(mmr, lchnk, ncol, to_dry_factor=to_dry_factor) call get_molecular_diff_coef(T(:ncol,:), .true., sponge_factor, kmvis(:ncol,:,lchnk), & - kmcnd(:ncol,:,lchnk), tracer=mmr(:ncol,:,:), fact=to_moist_factor, & + kmcnd(:ncol,:,lchnk), tracer=mmr(:ncol,:,:), fact=to_dry_factor, & active_species_idx_dycore=thermodynamic_active_species_idx) + end subroutine cam_thermo_dry_air_update - end subroutine cam_thermo_update + subroutine cam_thermo_water_update(mmr, lchnk, ncol, to_dry_factor) + use air_composition, only: water_composition_update + !----------------------------------------------------------------------- + ! Update the physics "constants" that vary + !------------------------------------------------------------------------- + + !------------------------------Arguments---------------------------------- + + real(r8), intent(in) :: mmr(:,:,:) ! constituents array + integer, intent(in) :: lchnk ! Chunk number + integer, intent(in) :: ncol ! number of columns + real(r8), optional, intent(in) :: to_dry_factor(:,:) + ! + call water_composition_update(mmr, lchnk, ncol, to_dry_factor=to_dry_factor) + end subroutine cam_thermo_water_update !=========================================================================== @@ -1663,7 +1680,7 @@ subroutine get_hydrostatic_energy_1hd(tracer, moist_mixing_ratio, pdel_in, & pdel = pdel_in else pdel = pdel_in - do qdx = 1, thermodynamic_active_species_num + do qdx = dry_air_species_num+1, thermodynamic_active_species_num pdel(:,:) = pdel(:,:) + pdel_in(:, :)*tracer(:,:,species_idx(qdx)) end do end if From 190dd147b6ff7628a26c5e5f286e2ebcc1f683c1 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Wed, 22 Feb 2023 14:57:34 -0700 Subject: [PATCH 063/140] adopt new subroutine names in fv and mpas --- src/dynamics/fv/dp_coupling.F90 | 6 +++--- src/dynamics/mpas/dp_coupling.F90 | 9 +++++---- 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/src/dynamics/fv/dp_coupling.F90 b/src/dynamics/fv/dp_coupling.F90 index db8519619c..443bf6a2a9 100644 --- a/src/dynamics/fv/dp_coupling.F90 +++ b/src/dynamics/fv/dp_coupling.F90 @@ -77,7 +77,7 @@ subroutine d_p_coupling(grid, phys_state, phys_tend, pbuf2d, dyn_out) use ctem, only: ctem_diags, do_circulation_diags use diag_module, only: fv_diag_am_calc use gravity_waves_sources, only: gws_src_fnct - use cam_thermo, only: cam_thermo_update + use cam_thermo, only: cam_thermo_dry_air_update use shr_const_mod, only: shr_const_rwv use dyn_comp, only: frontgf_idx, frontga_idx, uzm_idx use qbo, only: qbo_use_forcing @@ -85,7 +85,7 @@ subroutine d_p_coupling(grid, phys_state, phys_tend, pbuf2d, dyn_out) use zonal_mean, only: zonal_mean_3D use d2a3dikj_mod, only: d2a3dikj use qneg_module, only: qneg3 - + use air_composition,only: dry_air_species_num !----------------------------------------------------------------------- implicit none !----------------------------------------------------------------------- @@ -572,7 +572,7 @@ subroutine d_p_coupling(grid, phys_state, phys_tend, pbuf2d, dyn_out) end do end do - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + if (dry_air_species_num>0) then !------------------------------------------------------------ ! Apply limiters to mixing ratios of major species !------------------------------------------------------------ diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index 8b3a48bd9f..4c300e527c 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -336,11 +336,12 @@ subroutine derived_phys(phys_state, phys_tend, pbuf2d) use check_energy, only: check_energy_timestep_init use shr_vmath_mod, only: shr_vmath_log use phys_control, only: waccmx_is - use cam_thermo, only: cam_thermo_update - use air_composition, only: rairv + use cam_thermo, only: cam_thermo_dry_air_update + use air_composition, only: rairv, dry_air_species_num use qneg_module, only: qneg3 use shr_const_mod, only: shr_const_rwv use constituents, only: qmin + ! Arguments type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) type(physics_tend ), intent(inout) :: phys_tend(begchunk:endchunk) @@ -442,7 +443,7 @@ subroutine derived_phys(phys_state, phys_tend, pbuf2d) end do - if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + if (dry_air_species_num>0) then !------------------------------------------------------------ ! Apply limiters to mixing ratios of major species !------------------------------------------------------------ @@ -453,7 +454,7 @@ subroutine derived_phys(phys_state, phys_tend, pbuf2d) ! Compute molecular viscosity(kmvis) and conductivity(kmcnd). ! Fill local zvirv variable; calculated for WACCM-X. !----------------------------------------------------------------------------- - call cam_thermo_update(phys_state(lchnk)%q, phys_state(lchnk)%t, lchnk, ncol) + call cam_thermo_dry_air_update(phys_state(lchnk)%q, phys_state(lchnk)%t, lchnk, ncol) zvirv(:,:) = shr_const_rwv / rairv(:,:,lchnk) -1._r8 else zvirv(:,:) = zvir From be96dfc7ebab1c3680bea5a93d93389f633edbe0 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 23 Feb 2023 11:58:40 -0700 Subject: [PATCH 064/140] refactor/simplify budget code to use history buffers --- bld/namelist_files/namelist_definition.xml | 12 - src/control/budgets.F90 | 1103 ++++--------------- src/control/cam_comp.F90 | 9 +- src/control/cam_history.F90 | 628 +++++------ src/control/cam_history_buffers.F90 | 18 +- src/control/cam_history_support.F90 | 32 +- src/dynamics/mpas/dp_coupling.F90 | 152 +-- src/dynamics/mpas/dycore_budget.F90 | 16 +- src/dynamics/mpas/dyn_comp.F90 | 277 +---- src/dynamics/mpas/dyn_grid.F90 | 25 + src/dynamics/se/dycore/global_norms_mod.F90 | 20 +- src/dynamics/se/dycore/prim_advance_mod.F90 | 67 +- src/dynamics/se/dycore/prim_driver_mod.F90 | 8 +- src/dynamics/se/dycore_budget.F90 | 57 +- src/dynamics/se/dyn_comp.F90 | 89 +- src/dynamics/se/dyn_grid.F90 | 25 +- src/infrastructure/phys_grid.F90 | 11 + src/physics/cam/cam_diagnostics.F90 | 71 +- src/physics/cam/check_energy.F90 | 28 +- src/physics/cam/phys_control.F90 | 16 +- src/physics/cam/phys_grid.F90 | 11 +- src/physics/cam/physpkg.F90 | 71 +- src/physics/cam_dev/physpkg.F90 | 43 +- src/utils/cam_grid_support.F90 | 52 +- src/utils/cam_thermo.F90 | 3 - 25 files changed, 864 insertions(+), 1980 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index d5bf7660e0..c0e35eb5b0 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -5126,18 +5126,6 @@ History tape number T/Q budget output is written to. Default: 1 - -Switch for budget diagnostic output -Default: .false. - - - -History tape number thermo budget output is written to. -Default: 1 - - Switch for diagnostic output used primarily for WACCM runs. diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index 3686fc028f..6120e08087 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -9,6 +9,7 @@ module budgets use cam_thermo, only: thermo_budget_vars, thermo_budget_vars_descriptor, & thermo_budget_vars_unit, thermo_budget_vars_massv, thermo_budget_num_vars use cam_history, only: addfld, add_default, horiz_only +use cam_history_support, only: max_fieldname_len,ptapes implicit none private @@ -19,137 +20,115 @@ module budgets module procedure budget_diff_add end interface budget_add -!interface budget_info -! module procedure abudget_info_byind -! module procedure budget_info_byname -!end interface budget_info - ! Public interfaces public :: & budget_init, &! initialize budget variables budget_add, &! add a budget to the list of budgets - budget_update, &! update budget diffs, outflds, store new globals. - budget_num_avail, &! returns the number of available slots in the budget array - budget_chk_dim, &! check that number of budgets added equals dimensions (budget_array_max) - budget_name_byind, &! return name of a budget budget_ind_byname, &! return budget index given name - budget_longname_byind, &! return longnamee of a budget - budget_type_byind, &! return stage or difference type of a budget - budget_info, &! return budget info by ind - budget_info_byname, &! return budget info by name - budget_cnt_adjust, &! advance or reset budget count - budget_count, &! return budget count - is_budget, &! return budget count -!jt is_budgetfile, &! return budget count - budget_get_global, &! return budget count - budget_put_global, &! return budget count - budget_write, &! write_budget: time to write global budget - + budget_get_global, &! return budget global + budget_put_global, &! put budget global budget_readnl, &! budget_readnl: read cam thermo namelist - budget_outfld ! Returns true if default CAM output was specified in the budget_stage_add calls. + is_budget ! return logical if budget_defined ! Public data -integer, parameter, public :: budget_array_max = 100 ! number of budget diffs -integer, public :: budget_cnt(budget_array_max) ! budget counts for normalization -logical, public :: budget_subcycle(budget_array_max) ! budget_subcycle counts +integer, parameter, public :: budget_array_max = 500 ! number of budget diffs integer, public :: budget_num = 0 ! -integer, public :: budget_num_phy = 0 ! -integer, public :: budget_num_dyn = 0 ! -integer, public :: budget_state_ind(budget_array_max) ! -logical, public, protected :: budget_out(budget_array_max) ! outfld this stage character(len=64), public, protected :: budget_name(budget_array_max) ! budget names character(len=128),public, protected :: budget_longname(budget_array_max) ! long name of budgets character(len=128),public, protected :: budget_stagename(budget_array_max) ! long name of budgets -integer, public, protected :: budget_stg1index(budget_array_max) -integer, public, protected :: budget_stg2index(budget_array_max) character(len=64), public, protected :: budget_stg1name(budget_array_max) character(len=64), public, protected :: budget_stg2name(budget_array_max) -integer, public, protected :: budget_stg1stateidx(budget_array_max) -integer, public, protected :: budget_stg2stateidx(budget_array_max) -real(r8), public, protected :: budget_globals(budget_array_max,thermo_budget_num_vars) - -integer, public, protected :: thermo_budget_averaging_n = 1 -integer, public, protected :: thermo_budget_histfile_num = 1 -logical, public, protected :: thermo_budget_history = .false. -character(len=8), public, protected :: thermo_budget_averaging_option = 'NONE' +integer, public :: thermo_budget_averaging_n = 1 +integer, public :: thermo_budget_histfile_num = 1 +logical, public :: thermo_budget_history = .false. +character(len=8), public :: thermo_budget_averaging_option = 'NONE' +integer, private :: stepsize ! ! Constants for each budget -!character*3, public, protected :: budget_type(budget_array_max)! stage or difference character*3, public :: budget_optype(budget_array_max)! stage or difference or sum character*3, public :: budget_pkgtype(budget_array_max)! phy or dyn !============================================================================================== CONTAINS !============================================================================================== + +subroutine budget_stage_add (name, pkgtype, longname, cslam) + use dycore, only: dycore_is -subroutine budget_stage_add (name, pkgtype, longname, outfld) - use dimensions_mod, only: ntrac - ! Register a budget. - - character(len=*), intent(in) :: & + character(len=*), intent(in) :: & name ! budget name used as variable name in history file output (8 char max) - character(len=*), intent(in) :: & + character(len=*), intent(in) :: & pkgtype ! budget type either phy or dyn - character(len=*), intent(in), optional :: & longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) logical, intent(in), optional :: & - outfld ! true => default CAM output of budget in kg/kg - - character(len=*), parameter :: sub='budget_stage_add' - character(len=128) :: errmsg - character (len=108) :: str1, str2, str3 - logical :: thermo_budget_hist - integer :: ivars + cslam ! true => CSLAM used to transport mass tracers + + character (len=128) :: errmsg + character (len=max_fieldname_len) :: str1 + character (len=128) :: str2, str3 + logical :: thermo_budget_hist + logical :: cslamtr ! using cslam transport for mass tracers + integer :: ivars + character(len=*), parameter :: sub='budget_stage_add' !----------------------------------------------------------------------- - budget_num = budget_num+1 - ! set budget name and constants - budget_name(budget_num) = name - if (present(longname)) then - budget_longname(budget_num) = longname - else - budget_longname(budget_num) = name - end if - - ! set outfld type - ! (false: the module declaring the budget is responsible for outfld calls) - if (present(outfld)) then - budget_out(budget_num) = outfld + if (thermo_budget_history) then + if (present(cslam)) then + cslamtr=cslam else - budget_out(budget_num) = .false. + cslamtr = .false. end if - budget_optype(budget_num)='stg' - budget_pkgtype(budget_num)=pkgtype - budget_stagename(budget_num)= trim(name) - do ivars=1, thermo_budget_num_vars + write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(name)) write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & TRIM(ADJUSTL(longname)) write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) - if (ntrac>0.and.thermo_budget_vars_massv(ivars)) then -!jt call addfld (TRIM(ADJUSTL(str1))//'&BG', horiz_only, 'C', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='FVM') - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'C', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='FVM') + + budget_num = budget_num+1 + ! set budget name and constants + budget_name(budget_num) = trim(str1) + if (present(longname)) then + budget_longname(budget_num) = trim(str2) else -!jt call addfld (TRIM(ADJUSTL(str1))//'&BG', horiz_only, 'C', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='GLL') - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'C', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='GLL') + budget_longname(budget_num) = trim(str1) end if -!jt call add_default(TRIM(ADJUSTL(str1))//'&BG', 0, 'C') - call add_default(TRIM(ADJUSTL(str1)), thermo_budget_histfile_num, 'C') - write(6,*)'adding default budget field ',TRIM(ADJUSTL(str1)),' on history file ',thermo_budget_histfile_num + + budget_optype(budget_num)='stg' + budget_pkgtype(budget_num)=pkgtype + budget_stagename(budget_num)= trim(name) + + if (pkgtype=='phy') then + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='physgrid') + else + if (dycore_is('SE')) then + if (cslamtr .and. thermo_budget_vars_massv(ivars)) then + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='FVM') + else + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='GLL') + end if + else if (dycore_is('MPAS')) then + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='mpas_cell') + else + call endrun(sub//'budget_add is only supported for MPAS and SE dycores') + call endrun(errmsg) + end if + end if + call add_default(TRIM(ADJUSTL(str1)), thermo_budget_histfile_num, 'N') end do - +end if end subroutine budget_stage_add !!$!============================================================================== -subroutine budget_diff_add (name, stg1name, stg2name, pkgtype, optype, longname, outfld) - use dimensions_mod, only: ntrac +subroutine budget_diff_add (name, stg1name, stg2name, pkgtype, optype, longname, cslam) + use dycore, only: dycore_is + ! Register a budget. @@ -166,447 +145,189 @@ subroutine budget_diff_add (name, stg1name, stg2name, pkgtype, optype, longname, longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) logical, intent(in), optional :: & - outfld ! true => default CAM output of budget in kg/kg + cslam ! true => use cslam to transport mass variables character(len=*), parameter :: sub='budget_diff_add' character(len=128) :: errmsg character(len=1) :: opchar character (len=256) :: str1, str2, str3, strstg1, strstg2 integer :: ivars + logical :: cslamtr ! using cslam transport for mass tracers !----------------------------------------------------------------------- - budget_num = budget_num + 1 - budget_pkgtype(budget_num)=pkgtype - - ! set budget name and constants - budget_name(budget_num) = name - if (present(longname)) then - budget_longname(budget_num) = longname + if (thermo_budget_history) then + if (present(cslam)) then + cslamtr=cslam else - budget_longname(budget_num) = name + cslamtr = .false. end if - if (optype=='dif') opchar='-' - if (optype=='sum') opchar='+' - if (optype=='stg') then - write(errmsg,*) sub//': FATAL: bad value optype should be sum of dif:', optype - call endrun(errmsg) - end if - budget_stg1name(budget_num) = trim(stg1name) - budget_stg2name(budget_num) = trim(stg2name) - budget_stagename(budget_num)= trim(stg1name)//opchar//trim(stg2name) - budget_stg1index(budget_num) = budget_ind_byname(trim(stg1name)) - budget_stg2index(budget_num) = budget_ind_byname(trim(stg2name)) - ! set outfld type - ! (false: the module declaring the budget is responsible for outfld calls) - if (present(outfld)) then - budget_out(budget_num) = outfld - else - budget_out(budget_num) = .false. - end if - - budget_optype(budget_num)=optype - ! register history budget variables do ivars=1, thermo_budget_num_vars + write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(name)) write(strstg1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stg1name)) write(strstg2,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stg2name)) write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & TRIM(ADJUSTL(longname)) write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) - if (ntrac>0.and.thermo_budget_vars_massv(ivars)) then -!jt call addfld (TRIM(ADJUSTL(str1))//'&BG', horiz_only, 'C', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='FVM') -!jt call addfld (TRIM(ADJUSTL(str1))//'&BG', horiz_only, 'C', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'C', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & - gridname='FVM',op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) - else -!jt call addfld (TRIM(ADJUSTL(str1))//'&BG', horiz_only, 'C', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'C', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & - gridname='GLL',op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) - endif -!jt call add_default(TRIM(ADJUSTL(str1))//'&BG', 0, 'C) - call add_default(TRIM(ADJUSTL(str1)), thermo_budget_histfile_num, 'C') - write(6,*)'adding default budget field ',TRIM(ADJUSTL(str1)),' on history file ',thermo_budget_histfile_num - end do - - end subroutine budget_diff_add -!============================================================================== - -function budget_num_avail() - - ! return number of available slots in the budget array - - integer budget_num_avail - - budget_num_avail = budget_array_max - budget_num - -end function budget_num_avail - -!============================================================================================== - -character*3 function budget_type_byind(ind) - - ! Return the type of a budget stage or difference - - !-----------------------------Arguments--------------------------------- - integer, intent(in) :: ind ! global budget index (in te array) - - !---------------------------Local workspace----------------------------- - character(len=*), parameter :: sub='budget_type_byind' - character(len=128) :: errmsg - !----------------------------------------------------------------------- - if (ind > 0 .and. ind <= budget_array_max) then - budget_type_byind = budget_optype(ind) - else - ! index out of range - write(errmsg,*) sub//': FATAL: bad value for budget index=', ind - call endrun(errmsg) - end if - -end function budget_type_byind - -!============================================================================================== - -subroutine budget_info_byname(name, budget_ind, longname, stg1name, stg1stateidx, stg1index, stg2name, stg2stateidx, stg2index, optype, pkgtype,state_ind,subcycle,outfld) - - ! Return the mixing ratio name of a budget - - !-----------------------------Arguments--------------------------------- - character(len=*), intent(in) :: name - character(len=*), intent(out), optional :: & - longname, &! budget long_name - stg1name, &! stage1 name value for difference budget - stg2name ! stage2 name value for difference budget - integer, intent(out), optional :: & - budget_ind, &! budget array index - state_ind, &! state budget array index - stg1stateidx, &! stage1 index for difference budget - stg2stateidx, &! stage2 index for difference budget - stg1index, &! stage1 budget index - stg2index ! stage2 budget index - character(len=3), intent(out), optional :: & - optype, &! budget type difference or stage - pkgtype ! physics or dynamics budget - logical, intent(out), optional :: & - subcycle, &! - outfld - - !---------------------------Local workspace----------------------------- - character(len=*), parameter :: sub='budget_info_byname' - character(len=128) :: errmsg - integer :: b_ind - !----------------------------------------------------------------------- - b_ind=budget_ind_byname(trim(name)) - if (b_ind > 0 .and. b_ind <= budget_array_max) then - if (present(budget_ind)) budget_ind=b_ind - if (present(longname)) longname=budget_longname(b_ind) - if (present(optype)) optype=budget_optype(b_ind) - if (present(pkgtype)) pkgtype=budget_pkgtype(b_ind) - if (present(state_ind)) state_ind=budget_state_ind(b_ind) - if (present(subcycle)) subcycle=budget_subcycle(b_ind) - if (present(outfld)) outfld=budget_out(b_ind) - if (budget_optype(b_ind)=='dif' .or. budget_optype(b_ind)=='sum') then - if (present(stg1name))stg1name=budget_stg1name(b_ind) - if (present(stg2name))stg2name=budget_stg2name(b_ind) - if (present(stg1stateidx)) stg1stateidx=budget_stg1stateidx(b_ind) - if (present(stg2stateidx)) stg2stateidx=budget_stg2stateidx(b_ind) - if (present(stg1index)) stg1index=budget_stg1index(b_ind) - if (present(stg2index)) stg2index=budget_stg2index(b_ind) + + + budget_num = budget_num + 1 + budget_pkgtype(budget_num)=pkgtype + + ! set budget name and constants + budget_name(budget_num) = trim(str1) + if (present(longname)) then + budget_longname(budget_num) = trim(str2) else - if (present(stg1name).or.present(stg2name).or.present(stg1stateidx).or.present(stg2stateidx) & - .or.present(stg1index).or.present(stg2index)) & - call endrun(sub//': stage1/2 info not applicable for a budget that is not a difference or sum') + budget_longname(budget_num) = trim(str1) end if - else - ! index out of range - write(errmsg,*) sub//': FATAL: bad value name:',name,' budget index=', b_ind - call endrun(errmsg) - end if - end subroutine budget_info_byname - - subroutine budget_info(budget_ind, name, longname, stg1name, stg1stateidx, stg1index, stg2name, stg2stateidx, stg2index, optype, pkgtype,state_ind,subcycle,outfld) - - ! Return the mixing ratio name of a budget - - !-----------------------------Arguments--------------------------------- - integer, intent(in) :: budget_ind - character(len=*), intent(out), optional :: & - name, &! budget long_name - longname, &! budget long_name - stg1name, &! stage1 name value for difference budget - stg2name ! stage2 name value for difference budget - integer, intent(out), optional :: & - state_ind, &! state budget array index - stg1stateidx,&! stage1 index for difference budget - stg2stateidx,&! stage2 index for difference budget - stg1index, &! stage1 budget index - stg2index ! stage2 budget index - character(len=3), intent(out), optional :: & - optype, &! budget type difference or stage - pkgtype ! physics or dynamics budget - logical, intent(out), optional :: & - subcycle, &! - outfld - - !---------------------------Local workspace----------------------------- - character(len=*), parameter :: sub='budget_info_byind' - character(len=128) :: errmsg - !----------------------------------------------------------------------- - if (budget_ind > 0 .and. budget_ind <= budget_array_max) then - if (present(outfld)) outfld=budget_out(budget_ind) - if (present(name)) name=budget_name(budget_ind) - if (present(longname)) longname=budget_longname(budget_ind) - if (present(optype)) optype=budget_optype(budget_ind) - if (present(pkgtype)) pkgtype=budget_pkgtype(budget_ind) - if (present(state_ind)) state_ind=budget_state_ind(budget_ind) - if (present(subcycle)) subcycle=budget_subcycle(budget_ind) - if (budget_optype(budget_ind)=='dif' .or. budget_optype(budget_ind)=='sum') then - if (present(stg1name))stg1name=budget_stg1name(budget_ind) - if (present(stg2name))stg2name=budget_stg2name(budget_ind) - if (present(stg1stateidx)) stg1stateidx=budget_stg1stateidx(budget_ind) - if (present(stg2stateidx)) stg2stateidx=budget_stg2stateidx(budget_ind) - if (present(stg1index)) stg1index=budget_stg1index(budget_ind) - if (present(stg2index)) stg2index=budget_stg2index(budget_ind) - else - if (present(stg1name).or.present(stg2name).or.present(stg1stateidx).or.present(stg2stateidx) & - .or.present(stg1index).or.present(stg2index)) & - call endrun(sub//': stage1/2 info not applicable for a budget that is not a difference or sum') + if (optype=='dif') opchar='-' + if (optype=='sum') opchar='+' + if (optype=='stg') then + write(errmsg,*) sub//': FATAL: bad value optype should be sum of dif:', optype + call endrun(errmsg) end if - else - ! index out of range - write(errmsg,*) sub//': FATAL: bad value name:',name,' budget index=', budget_ind - call endrun(errmsg) - end if - - end subroutine budget_info - -!============================================================================================== - -subroutine budget_cnt_adjust(ind,reset) - - ! Return the mixing ratio name of a budget - - !-----------------------------Arguments--------------------------------- - integer, intent(in) :: ind ! global budget index (in te array) - logical, intent(in),optional :: reset ! reset budget_cnt - !---------------------------Local workspace----------------------------- - character(len=*), parameter :: sub='budget_cnt_adjust' - character(len=128) :: errmsg - !----------------------------------------------------------------------- - if (ind > 0 .and. ind <= budget_array_max) then - budget_cnt(ind)=budget_cnt(ind)+1 - if (present(reset)) then - if (reset) then - budget_cnt(ind)=0 + budget_stg1name(budget_num) = trim(adjustl(strstg1)) + budget_stg2name(budget_num) = trim(adjustl(strstg2)) + budget_stagename(budget_num)= trim(adjustl(strstg1))//trim(opchar)//trim(adjustl(strstg2)) + budget_optype(budget_num)=optype + + + + if (pkgtype=='phy') then + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & + gridname='physgrid',op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) + else + if (dycore_is('SE')) then + if (cslamtr .and. thermo_budget_vars_massv(ivars)) then + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & + gridname='FVM',op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) + else + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & + gridname='GLL',op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) + end if + else if (dycore_is('MPAS')) then + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & + gridname='mpas_cell',op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) + else + call endrun(sub//'budget_add is only supported for MPAS and SE dycores') + call endrun(errmsg) end if end if - else - ! index out of range - write(errmsg,*) sub//': FATAL: bad index value for budget_cnt_adjust=', ind - call endrun(errmsg) - end if - + call add_default(TRIM(ADJUSTL(str1)), thermo_budget_histfile_num, 'N') + end do +end if + end subroutine budget_diff_add - end subroutine budget_cnt_adjust !============================================================================================== -subroutine budget_init(dyn_area,phy_area,npsq,ncsq,nets,nete) - real(r8), intent(in) :: dyn_area(npsq,nets:nete) - real(r8), intent(in) :: phy_area(ncsq,nets:nete) - integer, intent(in) :: npsq,nets,nete,ncsq +subroutine budget_init() + use time_manager, only: get_step_size - integer :: i,ie - ! Initial budget module variables. - - budget_cnt(:) = 0._r8 - budget_subcycle(:) = .false. - budget_num_dyn = 0 - budget_num_phy = 0 - budget_num = 0 - budget_state_ind(:) = 0 - budget_out(:) = .false. - budget_name(:) = 'UNSET' - budget_longname(:)= 'UNSET' - budget_stg1index(:) = 0 - budget_stg2index(:) = 0 - budget_stg1name(:)= 'UNSET' - budget_stg2name(:)= 'UNSET' - budget_subcycle(:)= .false. - -!jt call addfld ('dyn_area&BG', horiz_only, 'A', 'steradian', 'dynamics grid area' , gridname='GLL') -!jt call addfld ('phy_area&BG', horiz_only, 'A', 'steradian', 'physics grid area' , gridname='FVM') - call addfld ('dyn_area', horiz_only, 'A', 'steradian', 'dynamics grid area' , gridname='GLL') - call addfld ('phy_area', horiz_only, 'A', 'steradian', 'physics grid area' , gridname='FVM') -!!$ ! Create hbuf fields to weight global integrals -!!$ do ie=nets,nete -!!$ call outfld('dyn_area', dyn_area(:,ie), npsq, ie) -!!$ call outfld('phy_area', phy_area(:,ie), ncsq, ie) -!!$ end do + stepsize=get_step_size() end subroutine budget_init -!============================================================================================== - - -character*64 function budget_name_byind(ind) - - ! Return the mixing ratio name of a budget - - !-----------------------------Arguments--------------------------------- - integer, intent(in) :: ind ! global budget index (in te array) - !---------------------------Local workspace----------------------------- - character(len=*), parameter :: sub='budget_name_byind' - character(len=128) :: errmsg - !----------------------------------------------------------------------- - - if (ind > 0 .and. ind <= budget_array_max) then - budget_name_byind = budget_name(ind) - else - ! index out of range - write(errmsg,*) sub//': FATAL: bad value for budget index=', ind - call endrun(errmsg) - end if - -end function budget_name_byind - -!============================================================================================== - -character*128 function budget_longname_byind(ind) - - ! Return the mixing ratio name of a budget - - !-----------------------------Arguments--------------------------------- - integer, intent(in) :: ind ! global budget index (in te array) - - !---------------------------Local workspace----------------------------- - character(len=*), parameter :: sub='budget_name_byind' - character(len=128) :: errmsg - !----------------------------------------------------------------------- - - if (ind > 0 .and. ind <= budget_array_max) then - budget_longname_byind = budget_longname(ind) - else - ! index out of range - write(errmsg,*) sub//': FATAL: bad value for budget index=', ind - call endrun(errmsg) - end if - -end function budget_longname_byind - !============================================================================== -subroutine budget_get_global (name, me_idx, global, abort) - - ! Get the global integral of a budget. Optional abort argument allows returning - ! control to caller when budget name is not found. Default behavior is - ! to call endrun when name is not found. - - !-----------------------------Arguments--------------------------------- - character(len=*), intent(in) :: name ! budget name - integer, intent(in) :: me_idx ! mass energy variable index - real(r8), intent(out) :: global ! global budget index (in q array) - logical, optional, intent(in) :: abort ! optional flag controlling abort - - !---------------------------Local workspace----------------------------- - integer :: m ! budget index - logical :: abort_on_error - character(len=*), parameter :: sub='budget_get_global' - character(len=128) :: errmsg - !----------------------------------------------------------------------- - - ! Find budget name in list - do m = 1, budget_array_max - if (trim(name) == trim(budget_stagename(m)).or.trim(name)==trim(budget_name(m))) then - global = budget_globals(m,me_idx) - return - end if - end do - - ! Unrecognized name - abort_on_error = .true. - if (present(abort)) abort_on_error = abort - - if (abort_on_error) then - write(errmsg,*) sub//': FATAL: name not found: ', trim(name) - call endrun(errmsg) - end if - - end subroutine budget_get_global -!============================================================================== -!============================================================================== -subroutine budget_put_global (name, me_idx, global, abort) - - ! store the global integral of a budget. Optional abort argument allows returning - ! control to caller when budget name is not found. Default behavior is - ! to call endrun when name is not found. - - !-----------------------------Arguments--------------------------------- - character(len=*), intent(in) :: name ! budget name - integer, intent(in) :: me_idx! mass energy variable index - real(r8), intent(out) :: global ! global budget index (in q array) - logical, optional, intent(in) :: abort ! optional flag controlling abort - - !---------------------------Local workspace----------------------------- - integer :: m ! budget index - logical :: abort_on_error - character(len=*), parameter :: sub='budget_put_ind' - !----------------------------------------------------------------------- - - ! Find budget name in list - do m = 1, budget_array_max - if (trim(name) == trim(budget_stagename(m)).or.trim(name)==trim(budget_name(m))) then - budget_globals(m,me_idx) = global - return - end if - end do - - ! Unrecognized name - abort_on_error = .true. - if (present(abort)) abort_on_error = abort - - if (abort_on_error) then - call endrun(sub//': FATAL: name not found') - end if +subroutine budget_get_global (name, me_idx, global) + + use cam_history, only: get_field_properties + use cam_history_support, only: active_entry + use cam_thermo, only: thermo_budget_vars_massv + + ! Get the global integral of a budget. Optional abort argument allows returning + ! control to caller when budget name is not found. Default behavior is + ! to call endrun when name is not found. + + !-----------------------------Arguments--------------------------------- + character(len=*), intent(in) :: name ! budget name + integer, intent(in) :: me_idx ! mass energy variable index + real(r8), intent(out) :: global ! global budget index (in q array) + + !---------------------------Local workspace----------------------------- + type (active_entry), pointer :: tape(:) => null() ! history tapes + character (len=max_fieldname_len) :: str1 + character(len=128) :: errmsg + integer :: b_ind ! hentry index + integer :: f(ptapes),ff ! hentry index + integer :: idx,pidx,midx ! substring index for sum dif char + integer :: m ! budget index + logical :: found ! true if global integral found + + character(len=*), parameter :: sub='budget_get_global' + !----------------------------------------------------------------------- - end subroutine budget_put_global + str1='' + write(str1,*) TRIM(ADJUSTL(name)) + ! check for stagename short format (stg1//op/stg2) where stg1 is name without thermo string appended + midx=index(str1, '-') + pidx=index(str1, '+') + idx=midx+pidx + if (idx /= 0 .and. (midx==0 .or. pidx==0)) then + write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//trim(adjustl(str1(1:idx)))// & + TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//TRIM(ADJUSTL(str1(idx+1:))) + end if + b_ind=budget_ind_byname(trim(adjustl(str1))) + + if (idx>0 .and. budget_optype(b_ind) == 'stg') call endrun(sub//'FATAL not a difference budget but name contains + or - character') + + write(str1,*) TRIM(ADJUSTL(budget_name(b_ind))) + + ! Find budget name in list and return global value + call get_field_properties(trim(adjustl(str1)), found, tape_out=tape, ff_out=ff, f_out=f) + if (found.and.f(thermo_budget_histfile_num)>0) then + call tape(thermo_budget_histfile_num)%hlist(f(thermo_budget_histfile_num))%get_global(global) + if (.not. thermo_budget_vars_massv(me_idx)) global=global/stepsize + else + write(errmsg,*) sub//': FATAL: name not found: ', trim(name) + call endrun(errmsg) + end if + +end subroutine budget_get_global !============================================================================== - -subroutine budget_get_ind (name, budget_ind, abort) - - ! Get the index of a budget. Optional abort argument allows returning - ! control to caller when budget name is not found. Default behavior is - ! to call endrun when name is not found. - - !-----------------------------Arguments--------------------------------- - character(len=*), intent(in) :: name ! budget name - integer, intent(out) :: budget_ind ! global budget index (in q array) - logical, optional, intent(in) :: abort ! optional flag controlling abort - - !---------------------------Local workspace----------------------------- - integer :: m ! budget index - logical :: abort_on_error - character(len=*), parameter :: sub='budget_get_ind' - !----------------------------------------------------------------------- - - ! Find budget name in list - do m = 1, budget_array_max - if (trim(name) == trim(budget_name(m)).or.trim(name)==trim(budget_stagename(m))) then - budget_ind = m - return - end if - end do - - ! Unrecognized name - abort_on_error = .true. - if (present(abort)) abort_on_error = abort - - if (abort_on_error) then - call endrun(sub//': FATAL: name not found') - end if - -end subroutine budget_get_ind +subroutine budget_put_global (name, me_idx, global) + + use cam_history, only: get_field_properties + use cam_history_support, only: active_entry + use cam_thermo, only: thermo_budget_vars_massv + + ! Get the global integral of a budget. Optional abort argument allows returning + ! control to caller when budget name is not found. Default behavior is + ! to call endrun when name is not found. + + !-----------------------------Arguments--------------------------------- + character(len=*), intent(in) :: name ! budget name + integer, intent(in) :: me_idx ! mass energy variable index + real(r8), intent(in) :: global ! global budget index (in q array) + + !---------------------------Local workspace----------------------------- + type (active_entry), pointer :: tape(:) => null() ! history tapes + integer :: m ! budget index + integer :: f(ptapes),ff ! hentry index + character(len=*), parameter :: sub='budget_put_global' + character(len=128) :: errmsg + character (len=128) :: str1 + logical :: found ! true if global integral found + real(r8) :: global_normalized + !----------------------------------------------------------------------- + + ! append thermo field to stage name + write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(me_idx))),"_",TRIM(ADJUSTL(name)) + + ! Find budget name in list and push global value to hentry + call get_field_properties(trim(str1), found, tape_out=tape, ff_out=ff, f_out=f) + if (found.and.f(thermo_budget_histfile_num)>0) then + if (.not. thermo_budget_vars_massv(me_idx)) global_normalized=global/stepsize + call tape(thermo_budget_histfile_num)%hlist(f(thermo_budget_histfile_num))%put_global(global_normalized) + else + write(errmsg,*) sub//': FATAL: name not found: ', trim(name) + call endrun(errmsg) + end if + +end subroutine budget_put_global !============================================================================== - function budget_ind_byname (name) ! Get the index of a budget. Optional abort argument allows returning @@ -619,14 +340,12 @@ function budget_ind_byname (name) !---------------------------Local workspace----------------------------- integer :: budget_ind_byname ! function return integer :: m ! budget index - character(len=*), parameter :: sub='budget_ind_byname' + character(len=*), parameter :: sub='budget_ind_byname' !----------------------------------------------------------------------- - ! Find budget name in list - budget_ind_byname = -1 do m = 1, budget_array_max - if (trim(name) == trim(budget_name(m)).or.trim(name) == trim(budget_stagename(m))) then + if (trim(adjustl(name)) == trim(adjustl(budget_name(m))).or.trim(adjustl(name)) == trim(adjustl(budget_stagename(m)))) then budget_ind_byname = m return end if @@ -639,49 +358,7 @@ function budget_ind_byname (name) !============================================================================== end function budget_ind_byname -subroutine budget_chk_dim - - ! Check that the number of registered budgets is budget_array_max - ! Write budget list to log file. - - integer :: i, m - character(len=*), parameter :: sub='budget_chk_dim' - character(len=128) :: errmsg - !----------------------------------------------------------------------- - - if (masterproc) then - write(iulog,*) 'Budgets list:' - do i = 1, budget_num - write(iulog,'(2x,i4,2x,a8,2x,a128)') i, trim(budget_name(i)), trim(budget_longname(i)) - end do - end if - -end subroutine budget_chk_dim - -function budget_outfld(m) - - ! Query whether default CAM outfld calls should be made. - - !----------------------------------------------------------------------- - integer, intent(in) :: m ! budget index - - logical :: budget_outfld ! true => use default CAM outfld calls - - character(len=*), parameter :: sub='budget_outfld' - character(len=128) :: errmsg - !----------------------------------------------------------------------- - - if (m > 0 .and. m <= budget_array_max) then - budget_outfld = budget_out(m) - else - ! index out of range - write(errmsg,*) sub//': FATAL: bad value for budget diff index=', m - call endrun(errmsg) - end if - - end function budget_outfld - -function is_budget(name) + function is_budget(name) ! Get the index of a budget. Optional abort argument allows returning ! control to caller when budget name is not found. Default behavior is @@ -706,215 +383,13 @@ function is_budget(name) end if end do end function is_budget -!============================================================================== -function budget_count(ind) - - ! Query whether default CAM outfld calls should be made. - - !----------------------------------------------------------------------- - integer, intent(in) :: ind ! budget index - - integer :: budget_count ! true => use default CAM outfld calls - - character(len=*), parameter :: sub='budget_count' - character(len=128) :: errmsg - !----------------------------------------------------------------------- - - if (ind > 0 .and. ind <= budget_array_max) then - budget_count = budget_cnt(ind) - else - ! index out of range - write(errmsg,*) sub//': FATAL: bad value for budget diff index=', ind - call endrun(errmsg) - end if - - end function budget_count - - !============================================================================== - - logical function budget_write (step_offset) - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Set flags that will initiate dump to IC file when OUTFLD and - ! WSHIST are called - ! - !----------------------------------------------------------------------- - ! - use shr_kind_mod, only: r8=>SHR_KIND_R8, cs=>SHR_KIND_CS, cl=>SHR_KIND_CL - use shr_string_mod, only: shr_string_toUpper - use time_manager, only: timemgr_time_ge, timemgr_time_inc, get_curr_date, is_first_restart_step - use time_manager, only: get_step_size, get_nstep, is_last_step, is_first_step - use time_manager, only: get_start_date, get_stop_date - use cam_abortutils, only: endrun - use spmd_utils, only: masterproc, mstrid=>masterprocid, mpicom - use spmd_utils, only: mpi_integer, mpi_real8, mpi_logical, mpi_character - use cam_logfile, only: iulog - use shr_cal_mod, only: shr_cal_ymd2date - ! - ! Input/Output arguments - !----------------------- - integer, optional, intent(in) :: step_offset - - ! Local values - !---------------- - character(len=*), parameter :: subname = 'budget_write :: ' - - integer, save :: YMD_Next,Sec_Next, & - YMD_Start,Sec_Start,YMD_Stop,Sec_Stop - logical, save :: initialized=.false. - integer :: YMD,Sec,YMD_Curr,Sec_Curr,YMD_Curr_woff,Sec_Curr_woff - integer :: Year,Month,Day - integer :: dtime ! timestep size - integer :: nstep ! current timestep number - integer :: offset ! offset for writing thermo budget. - logical :: Update_Budget - - !-------------------------------------------------------------- - - budget_write = .false. - if (trim(shr_string_toUpper(thermo_budget_averaging_option)) == 'NONE') return - - offset=0 - if (present(step_offset)) offset=step_offset - - nstep = get_nstep() - dtime = get_step_size() - - ! Get Current time - !-------------------- - call get_curr_date(Year,Month,Day,Sec_Curr) - call shr_cal_ymd2date(Year,Month,Day,YMD_Curr) - - call get_curr_date(Year,Month,Day,Sec_Curr_woff,offset=offset) - call shr_cal_ymd2date(Year,Month,Day,YMD_Curr_woff) - - if (masterproc) write(iulog,*)'budget_write YMD_Curr, Sec_Curr, offset',YMD_Curr,Sec_Curr,offset - - ! Initialize budget update times on first step - if (.not. initialized) then - ! Get Start time - !-------------------- - call get_start_date(Year,Month,Day,Sec_Start) - call shr_cal_ymd2date(Year,Month,Day,YMD_Start) - - ! Get End time - !-------------------- - call get_stop_date(Year,Month,Day,Sec_Stop) - call shr_cal_ymd2date(Year,Month,Day,YMD_Stop) - - ! Get Next Update time - !-------------------- - if (thermo_budget_averaging_option == 'ENDOFRUN') then - YMD_Next=YMD_Stop - Sec_Next=Sec_Stop - else - YMD=YMD_Curr - Sec=Sec_Curr - if (thermo_budget_averaging_option == 'NSTEP') then - call timemgr_time_inc(YMD,Sec, & - YMD_Next,Sec_Next,inc_s=dtime*thermo_budget_averaging_n) - elseif (thermo_budget_averaging_option == 'NHOUR') then - call timemgr_time_inc(YMD,Sec, & - YMD_Next,Sec_Next,inc_h=thermo_budget_averaging_n) - elseif(thermo_budget_averaging_option == 'NDAY' ) then - call timemgr_time_inc(YMD,Sec, & - YMD_Next,Sec_Next,inc_d=thermo_budget_averaging_n) - elseif(thermo_budget_averaging_option == 'NMONTH' ) then - call get_curr_date(Year,Month,Day,Sec_Curr) - if (thermo_budget_averaging_n+Month.gt.12) then - Year=Year+(thermo_budget_averaging_n+Month)/12 - Month=mod(thermo_budget_averaging_n+Month,12) - else - Month=thermo_budget_averaging_n+Month - end if - call shr_cal_ymd2date(Year,Month,Day,YMD_Next) - Sec_Next=Sec_Curr - elseif(thermo_budget_averaging_option == 'NYEAR' ) then - call get_curr_date(Year,Month,Day,Sec_Curr) - call shr_cal_ymd2date(Year+thermo_budget_averaging_n,Month,Day,YMD_Next) - Sec_Next=Sec_Curr - end if - - if (masterproc) write(iulog,*)'init calc of next budget write ymdc/secc/ymdn/secn:',YMD_Curr,Sec_Curr,YMD_Next,Sec_Next - end if - - initialized=.true. - end if - - - ! If an offset is present don't reset YMD_Next,Sec_Next just return budget_write using offset - !-------------------------------------------------------------- - if (present(step_offset)) then - - call timemgr_time_ge(YMD_Next,Sec_Next, & - YMD_Curr_woff ,Sec_Curr_woff ,update_budget) - if (thermo_budget_averaging_option == 'NSTEP'.and.thermo_budget_averaging_n==1) then - budget_write = ( nstep+(abs(offset/dtime))==1 .or. ((nstep /= 0).and.update_budget) ) - else - budget_write = ((nstep /= 0).and.update_budget) - end if - if (masterproc) write(iulog,*)'checking for budget_write w/offset:',budget_write - - else - ! When past the NEXT time, Update budget - !-------------------------------------------------------------- - call timemgr_time_ge(YMD_Next,Sec_Next, & - YMD_Curr ,Sec_Curr ,Update_Budget) - if (masterproc) write(iulog,*)'checking for update_budget:',Update_Budget - - ! Reset YMD_Next and Sec_Next for next update - !-------------------------------------------------------------- - if (Update_Budget) then - if (thermo_budget_averaging_option == 'ENDOFRUN') then - YMD_Next=YMD_Stop - Sec_Next=Sec_Stop - else - YMD=YMD_Next - Sec=Sec_Next - if (thermo_budget_averaging_option == 'NSTEP') then - call timemgr_time_inc(YMD,Sec, & - YMD_Next,Sec_Next,inc_s=dtime*thermo_budget_averaging_n) - elseif (thermo_budget_averaging_option == 'NHOUR') then - call timemgr_time_inc(YMD,Sec, & - YMD_Next,Sec_Next,inc_h=thermo_budget_averaging_n) - elseif(thermo_budget_averaging_option == 'NDAY' ) then - call timemgr_time_inc(YMD,Sec, & - YMD_Next,Sec_Next,inc_d=thermo_budget_averaging_n) - elseif(thermo_budget_averaging_option == 'NMONTH' ) then - call get_curr_date(Year,Month,Day,Sec_Curr) - if (thermo_budget_averaging_n+Month.gt.12) then - Year=Year+(thermo_budget_averaging_n+Month)/12 - Month=mod(thermo_budget_averaging_n+Month,12) - else - Month=thermo_budget_averaging_n+Month - end if - call shr_cal_ymd2date(Year,Month,Day,YMD_Next) - Sec_Next=Sec_Curr - elseif(thermo_budget_averaging_option == 'NYEAR' ) then - call get_curr_date(Year,Month,Day,Sec_Curr) - call shr_cal_ymd2date(Year+thermo_budget_averaging_n,Month,Day,YMD_Next) - Sec_Next=Sec_Curr - end if - if (masterproc) write(iulog,*)'curr gt next, reset next,new values ymdn/secn',YMD_Next,Sec_Next - end if - end if - if (thermo_budget_averaging_option == 'NSTEP'.and.thermo_budget_averaging_n==1) then - budget_write = ( nstep+(abs(offset/dtime))==1 .or. ((nstep /= 0).and.update_budget) ) - else - budget_write = ((nstep /= 0).and.update_budget) - end if - end if - - return - end function budget_write !=========================================================================== ! Read namelist variables. subroutine budget_readnl(nlfile) use namelist_utils, only: find_group_name use spmd_utils, only: masterproc, mpicom, masterprocid - use spmd_utils, only: mpi_character, mpi_logical, mpi_real8, mpi_integer + use spmd_utils, only: mpi_character, mpi_logical, mpi_integer use cam_logfile, only: iulog use shr_string_mod, only: shr_string_toUpper @@ -994,155 +469,5 @@ subroutine budget_readnl(nlfile) end if end subroutine budget_readnl -!========================================================================================= - subroutine budget_update(pkgtype, mpi_comm_id) - -!!$ use shr_kind_mod, only: r8 => shr_kind_r8 -!!$ use shr_reprosum_mod, only: shr_reprosum_calc, shr_reprosum_tolExceeded -!!$ use shr_reprosum_mod, only: shr_reprosum_reldiffmax, shr_reprosum_recompute -!!$ use perf_mod, only: t_startf, t_stopf -!!$ use cam_logfile, only: iulog -!!$ use cam_thermo, only: thermo_budget_vars_massv -!!$ use cam_history_support, only: active_entry,ptapes -!!$ use cam_history, only: is_budgetfile -!!$ -!!$ ! arguments - character(len=3), intent(in) :: pkgtype - integer, intent(in) :: mpi_comm_id -!!$ -!!$ ! Local variables -!!$ integer :: s_ind,b_ind,n,ie,begdim3,enddim3,t -!!$ logical :: budget_outfld -!!$ -!!$ type (active_entry), pointer :: tape(:) => null() ! history tapes -!!$! real(r8) :: budgets_global(budget_num,thermo_budget_num_vars) -!!$! real(r8), allocatable, dimension(:,:,:) :: tmpgll,tmpfvm -!!$ real(r8),pointer :: hbuf0(:,:,:),hbuf1(:,:,:),hbuf2(:,:,:) ! history buffer -!!$ -!!$ !-------------------------------------------------------------------------------------- -!!$ call t_startf ('budget_update') -!!$ -!!$ if (thermo_budget_history) then -!!$ ! update energy budget differences -!!$ do t=1,ptapes -!!$ if(is_budgetfile(file_index=t)) then -!!$ do b_ind = 1,budget_num -! call budget_info(b_ind,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=s_ind) -!!$ if (budget_pkgtype(b_ind)==trim(pkgtype).and.(budget_optype(b_ind)=='dif'.or.budget_optype(b_ind)=='sum')) then -!!$ call get_field_properties(trim(budget_name(b_ind)), found, tape_out=tape, ff_out=ff0) -!!$ call get_field_properties(trim(budget_stg1name(b_ind)), found, tape_out=tape, ff_out=ff1) -!!$ call get_field_properties(trim(budget_stg2name(b_ind)), found, tape_out=tape, ff_out=ff2) -!!$ f0 = masterlist(ff0)%thisentry%htapeindx(t) -!!$ f1 = masterlist(ff1)%thisentry%htapeindx(t) -!!$ f2 = masterlist(ff2)%thisentry%htapeindx(t) -!!$ -!!$ call tape(t)%hlist(f0)%field%get_bounds(3, begdim3, enddim3) -!!$ ! call h_field_op(f0,f1,f2,tape(t),budget_optype(b_ind)) -!!$ hbuf0 => tape(t)%hlist(f0)%hbuf -!!$ hbuf1 => tape(t)%hlist(f1)%hbuf -!!$ hbuf2 => tape(t)%hlist(f2)%hbuf -!!$ do ie=begdim3,enddim3 -!!$ if (budget_optype(b_ind)=='dif') then -!!$ hbuf0(:,:,ie)=hbuf1(:,:,ie)-hbuf2(:,:,ie) -!!$ call outfld(trim(budget_name(b_ind)),hbuf0(:,:,ie),npsq,ie) -!!$ else if (budget_optype=='sum') then -!!$ hbuf0(:,:,ie)=hbuf1(:,:,ie)+hbuf2(:,:,ie) -!!$ call outfld(budget_name(b_ind),hbuf0(:,:,ie),npsq,ie) -!!$ else -!!$ call endrun('dyn_readnl: ERROR: budget_optype unknown:'//budget_optype) -!!$ end if -!!$ end do -!!$ end if -!!$ end do -!!$ end if -!!$ end do -!!$ end if -!!$ -!!$ ! update all dynamics energy budget globals -!!$ -!!$ allocate(tmpgll(np,np,nets:nete)) -!!$ if (ntrac>0) allocate(tmpfvm(nc,nc,nets:nete)) -!!$ -!!$ do b_ind=1,budget_num -!!$ call budget_info(b_ind,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=s_ind) -!!$ if (pkgtype(b_ind)=='dyn') then -!!$ do n=1,thermo_budget_num_vars -!!$ ! Normalize energy sums and convert to W/s -!!$ if (ntrac>0.and.thermo_budget_vars_massv(n)) then -!!$ tmpfvm=0._r8 -!!$ if (elem(nets)%derived%budget_cnt(b_ind).gt.0.) then -!!$ do ie=nets,nete -!!$ tmpfvm(:,:,ie)=fvm(ie)%budget(:,:,n,s_ind)/elem(ie)%derived%budget_cnt(b_ind) -!!$ enddo -!!$ end if -!!$ else -!!$ tmpgll=0._r8 -!!$ if (elem(nets)%derived%budget_cnt(b_ind).gt.0.) then -!!$ do ie=nets,nete -!!$ tmpgll(:,:,ie)=elem(ie)%derived%budget(:,:,n,s_ind)/elem(ie)%derived%budget_cnt(b_ind) -!!$ end do -!!$ end if -!!$ end if -!!$ -!!$ budgets_global(b_ind,n) = global_integral(fvm, hbuf(:,:,nets:nete),hybrid,nc,nets,nete) -!!$ -!!$ if (ntrac>0.and.thermo_budget_vars_massv(n)) then -!!$ budgets_global(b_ind,n) = global_integral(fvm, tmpfvm(:,:,nets:nete),hybrid,nc,nets,nete) -!!$ else -!!$ budgets_global(b_ind,n) = global_integral(elem, tmpgll(:,:,nets:nete),hybrid,np,nets,nete) -!!$ end if -!!$ -!!$ ! divide by time for proper units if not a mass budget. -!!$ if (.not.thermo_budget_vars_massv(n)) & -!!$ budgets_global(b_ind,n)=budgets_global(b_ind,n)/dtime -!!$ if (masterproc) then -!!$ if (ntrac>0.and.thermo_budget_vars_massv(n)) then -!!$ write(iulog,*)"putting global from fvm ",trim(budget_name)," m_cnst=",n," ",budgets_global(b_ind,n)," cnt/subcyc/sum_tmp=",elem(nets)%derived%budget_cnt(b_ind),elem(nets)%derived%budget_subcycle(b_ind),sum(tmpfvm(:,:,nets)) -!!$ else -!!$ write(iulog,*)"putting global from elem ",trim(budget_name)," m_cnst=",n," ",budgets_global(b_ind,n)," cnt/subcyc/sum_tmp=",elem(nets)%derived%budget_cnt(b_ind),elem(nets)%derived%budget_subcycle(b_ind),sum(tmpgll(:,:,nets)) -!!$ end if -!!$ call budget_put_global(trim(budget_name),n,budgets_global(b_ind,n)) -!!$ end if -!!$ end do -!!$ end if -!!$ end do -!!$ deallocate(tmpgll) -!!$ if (ntrac > 0) deallocate(tmpfvm) -!!$ -!!$ call t_stopf ('budget_update') - -end subroutine budget_update -!!$ !####################################################################### -!!$ -!!$ logical function is_budgetfile (file_index) -!!$ ! -!!$ !------------------------------------------------------------------------ -!!$ ! -!!$ ! Purpose: to determine: -!!$ ! -!!$ ! a) if an IC file is active in this model run at all -!!$ ! OR, -!!$ ! b) if it is active, is the current file index referencing the IC file -!!$ ! (IC file is always at ptapes) -!!$ ! -!!$ !------------------------------------------------------------------------ -!!$ ! -!!$ ! Arguments -!!$ ! -!!$ integer, intent(in), optional :: file_index ! index of file in question -!!$ -!!$ is_budgetfile = .false. -!!$ -!!$ if (present(file_index)) then -!!$!jt if (budgethist /= 'NONE' .and. file_index == ptapes) is_budgetfile = .true. -!!$ if (budgethist /= 'NONE' .and. file_index == thermo_budget_histfile_num) is_budgetfile = .true. -!!$ else -!!$ if (budgethist /= 'NONE' ) is_budgetfile = .true. -!!$ end if -!!$ -!!$ return -!!$ -!!$ end function is_budgetfile -!!$ end module budgets diff --git a/src/control/cam_comp.F90 b/src/control/cam_comp.F90 index 835fa3e452..9982df6d2c 100644 --- a/src/control/cam_comp.F90 +++ b/src/control/cam_comp.F90 @@ -16,9 +16,7 @@ module cam_comp use spmd_utils, only: masterproc, mpicom use cam_control_mod, only: cam_ctrl_init, cam_ctrl_set_orbit use runtime_opts, only: read_namelist -use time_manager, only: timemgr_init, get_step_size, & - get_nstep, is_first_step, is_first_restart_step - +use time_manager, only: timemgr_init, get_nstep use camsrfexch, only: cam_out_t, cam_in_t use ppgrid, only: begchunk, endchunk use physics_types, only: physics_state, physics_tend @@ -361,7 +359,8 @@ subroutine cam_run4( cam_out, cam_in, rstwr, nlend, & ! file output. ! !----------------------------------------------------------------------- - use cam_history, only: wshist, wrapup + use dycore_budget, only: print_budget + use cam_history, only: wshist, wrapup, hstwr use cam_restart, only: cam_write_restart use qneg_module, only: qneg_print_summary use time_manager, only: is_last_step @@ -404,6 +403,8 @@ subroutine cam_run4( cam_out, cam_in, rstwr, nlend, & call qneg_print_summary(is_last_step()) + call print_budget(hstwr) + call shr_sys_flush(iulog) end subroutine cam_run4 diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index a033290466..f5b02d5838 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -1,5 +1,5 @@ module cam_history -#define HDEBUG TRUE +#define HDEBUG1 FALSE !------------------------------------------------------------------------------------------- ! ! The cam_history module provides the user interface for CAM's history output capabilities. @@ -71,10 +71,10 @@ module cam_history type grid_area_entry integer :: decomp_type = -1 ! type of decomposition (e.g., physics or dynamics) - real(r8), allocatable :: gbuf(:,:,:) ! for area weights + real(r8), allocatable :: wbuf(:,:,:) ! for area weights end type grid_area_entry type (grid_area_entry), target, allocatable:: grid_wts(:) ! area wts for each decomp type - type (grid_area_entry), pointer :: allgrids(:) ! area wts for each decomp type + type (grid_area_entry), pointer :: allgrids_wt(:) ! area wts for each decomp type ! ! master_entry: elements of an entry in the master field list ! @@ -84,7 +84,7 @@ module cam_history character(len=max_fieldname_len) :: zonal_field = '' ! for vector fields character(len=1) :: avgflag(ptapes) ! averaging flag character(len=max_chars) :: time_op(ptapes) ! time operator (e.g. max, min, avg) - character(len=3) :: field_op = '' ! field derived from sum/dif of field1 and field2 + character(len=max_chars) :: field_op = '' ! field derived from sum/dif of field1 and field2 character(len=max_fieldname_len) :: op_field1 = '' ! first field name to be summed/diffed character(len=max_fieldname_len) :: op_field2 = '' ! second field name to be summed/diffed logical :: act_sometape ! Field is active on some tape @@ -125,7 +125,7 @@ module cam_history ! ! The size of these parameters should match the assignments in restart_vars_setnames and restart_dims_setnames below ! - integer, parameter :: restartvarcnt = 41 + integer, parameter :: restartvarcnt = 45 integer, parameter :: restartdimcnt = 10 type(rvar_id) :: restartvars(restartvarcnt) type(rdim_id) :: restartdims(restartdimcnt) @@ -181,7 +181,6 @@ module cam_history character(len=fieldname_lenp2) :: fexcl(pflds,ptapes) ! List of fields to rm from primary h-file character(len=fieldname_lenp2) :: fwrtpr(pflds,ptapes) ! List of fields to change default history output prec character(len=fieldname_suffix_len ) :: fieldname_suffix = '&IC' ! Suffix appended to field names for IC file - character(len=fieldname_suffix_len ) :: bfieldname_suffix = '&BG' ! Suffix appended to field names for IC file ! Parameters for interpolated output tapes logical, public :: interpolate_output(ptapes) = .false. @@ -190,8 +189,7 @@ module cam_history ! Allowed history averaging flags ! This should match namelist_definition.xml => avgflag_pertape (+ ' ') - ! The presence of 'ABI' and 'XML' in this string is a coincidence - character(len=8), parameter :: HIST_AVG_FLAGS = ' ABCIXML' + character(len=9), parameter :: HIST_AVG_FLAGS = ' ABILMNSX' character(len=22) ,parameter :: LT_DESC = 'mean (over local time)' ! local time description logical :: collect_column_output(ptapes) @@ -318,7 +316,6 @@ module cam_history public :: nfils, mfilt ! Functions -!jt public :: is_budgetfile ! Check if htape is a budget history file public :: history_readnl ! Namelist reader for CAM history public :: init_restart_history ! Write restart history data public :: write_restart_history ! Write restart history data @@ -329,7 +326,6 @@ module cam_history public :: history_initialized ! .true. iff cam history initialized public :: wrapup ! process history files at end of run public :: write_inithist ! logical flag to allow dump of IC history buffer to IC file -!jt public :: write_budgethist ! logical flag to allow dump of budget history buffer to budget file public :: addfld ! Add a field to history file public :: add_default ! Add the default fields public :: register_vector_field ! Register vector field set for interpolated output @@ -338,7 +334,7 @@ module cam_history public :: get_hist_restart_filepath ! Return the full filepath to the history restart file public :: hist_fld_active ! Determine if a field is active on any history file public :: hist_fld_col_active ! Determine if a field is active on any history file at - + ! each column in a chunk CONTAINS @@ -364,7 +360,7 @@ subroutine intht (model_doi_url_in) use cam_control_mod, only: restart_run, branch_run use sat_hist, only: sat_hist_init use spmd_utils, only: mpicom, masterprocid, mpi_character - use cam_grid_support, only: cam_grid_get_area + use cam_grid_support, only: cam_grid_get_areawt use cam_history_support, only: dim_index_2d ! !----------------------------------------------------------------------- @@ -388,11 +384,10 @@ subroutine intht (model_doi_url_in) integer :: i,k,c,ib,ie,jb,je,count ! index integer :: fdecomp ! field decomp type(dim_index_2d) :: dimind ! 2-D dimension index - real(r8), pointer :: area(:) ! pointer to area values for attribute + real(r8), pointer :: areawt(:) ! pointer to areawt values for attribute type(master_entry), pointer :: listentry character(len=32) :: fldname ! temp variable used to produce a left justified field name ! in the formatted logfile output -!jt class(cam_grid_attribute_t), pointer :: attr ! ! Save the DOI @@ -483,29 +478,30 @@ subroutine intht (model_doi_url_in) enddim2 = tape(t)%hlist(f)%field%enddim2 begdim3 = tape(t)%hlist(f)%field%begdim3 enddim3 = tape(t)%hlist(f)%field%enddim3 - if (masterproc) write(6,*)'allocating hbuf for field num',f,' name:',trim(tape(t)%hlist(f)%field%name) +!jt if (masterproc) write(iulog,*)'allocating hbuf for field num',f,' name:',trim(tape(t)%hlist(f)%field%name) allocate(tape(t)%hlist(f)%hbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) tape(t)%hlist(f)%hbuf = 0._r8 if (tape(t)%hlist(f)%avgflag .eq. 'S') then ! allocate the variance buffer for standard dev allocate(tape(t)%hlist(f)%sbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) tape(t)%hlist(f)%sbuf = 0._r8 endif - if (tape(t)%hlist(f)%avgflag .eq. 'C') then ! set up area weight buffer + if (tape(t)%hlist(f)%avgflag .eq. 'N') then ! set up areawt weight buffer fdecomp = tape(t)%hlist(f)%field%decomp_type - if (masterproc) write(6,*)'in avgflag = C field',f,' name:',trim(tape(t)%hlist(f)%field%name),'decomp=',fdecomp - if (any(allgrids(:)%decomp_type == fdecomp)) then - wtidx=MAXLOC(allgrids(:)%decomp_type, MASK = allgrids(:)%decomp_type .EQ. fdecomp) - if (masterproc) write(6,*)'found decomp in allgrids at index', wtidx - tape(t)%hlist(f)%gbuf => allgrids(wtidx(1))%gbuf - if (masterproc) write(6,*)'pointing allgrids gbuf to hlist gbuf' +!jt if (masterproc) write(iulog,*)'in avgflag = N field',f,' name:',trim(tape(t)%hlist(f)%field%name),'decomp=',fdecomp + if (any(allgrids_wt(:)%decomp_type == fdecomp)) then + wtidx=MAXLOC(allgrids_wt(:)%decomp_type, MASK = allgrids_wt(:)%decomp_type .EQ. fdecomp) +!jt if (masterproc) write(iulog,*)'found decomp in allgrids_wt at index', wtidx + tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf +!jt if (masterproc) write(iulog,*)'pointing allgrids_wt wbuf to hlist wbuf index',wtidx(1) else ! area weights not found for this grid, then create them - wtidx=MINLOC(allgrids(:)%decomp_type) - allgrids(wtidx)%decomp_type=fdecomp - area => cam_grid_get_area(fdecomp) - write(6,*)'shape area:',shape(area),' size area:',size(area),'shape gbuf:',shape(allgrids(wtidx(1))%gbuf), & - ' size gbuf:',size(allgrids(wtidx(1))%gbuf) - allocate(allgrids(wtidx(1))%gbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) + wtidx=MINLOC(allgrids_wt(:)%decomp_type) + allgrids_wt(wtidx)%decomp_type=fdecomp + areawt => cam_grid_get_areawt(fdecomp) +!jt write(iulog,*)'shape areawt:',shape(areawt),' size areawt:',size(areawt),'shape wbuf:',shape(allgrids_wt(wtidx(1))%wbuf), & +!jt ' size wbuf:',size(allgrids_wt(wtidx(1))%wbuf) + allocate(allgrids_wt(wtidx(1))%wbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) + allgrids_wt(wtidx(1))%wbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)=0._r8 count=0 do c=begdim3,enddim3 dimind = tape(t)%hlist(f)%field%get_dims(c) @@ -513,28 +509,25 @@ subroutine intht (model_doi_url_in) ie=dimind%end1 jb=dimind%beg2 je=dimind%end2 - write(6,*)'dimind(',ib,':',ie,',',jb,':',je,',',c,')' +!jt if (masterproc) write(iulog,*)'dimind ib:ie jb:je c=(',ib,':',ie,',',jb,':',je,',',c,')' do k=jb,je do i=ib,ie count=count+1 - allgrids(wtidx(1))%gbuf(i,k,c)=area(count) + allgrids_wt(wtidx(1))%wbuf(i,k,c)=areawt(count) end do end do end do - tape(t)%hlist(f)%gbuf => allgrids(wtidx(1))%gbuf -!jt write(6,*)'didnt find decomp in allgrids allocating at index', wtidx(1),'area(1:20)=',area(1:20),'gbuf=',allgrids(wtidx(1))%gbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3),'hlist gbuf=',tape(t)%hlist(f)%gbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3) - write(6,*)'didnt find decomp in allgrids allocating at index', wtidx(1),'area(1:40)=',area(1:40) + tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf +!jt if (masterproc) write(iulog,*)'didnt find decomp in allgrids_wt allocating at index', wtidx(1),'areawt(1:40)=',areawt(1:40) endif endif if(tape(t)%hlist(f)%field%flag_xyfill .or. (avgflag_pertape(t) .eq. 'L')) then allocate (tape(t)%hlist(f)%nacs(begdim1:enddim1,begdim3:enddim3)) - allocate (tape(t)%hlist(f)%nsteps(begdim1:enddim1,begdim3:enddim3)) else allocate (tape(t)%hlist(f)%nacs(1,begdim3:enddim3)) - allocate (tape(t)%hlist(f)%nsteps(1,begdim3:enddim3)) end if tape(t)%hlist(f)%nacs(:,:) = 0 - tape(t)%hlist(f)%nsteps(:,:) = 0 + tape(t)%hlist(f)%beg_nstep = 0 tape(t)%hlist(f)%field%meridional_complement = -1 tape(t)%hlist(f)%field%zonal_complement = -1 end do @@ -1045,10 +1038,13 @@ subroutine define_composed_field_ids(t) character(len=*), parameter :: subname='define_composed_field_ids' do f = 1, nflds(t) - write(6,*)'tape:',t,'nflds:',nflds(t) if (composed_field(trim(tape(t)%hlist(f)%field%name), & field1, field2)) then +!jt write(iulog,*)'tape:',t,'nflds:',nflds(t),'name:',trim(tape(t)%hlist(f)%field%name),'f1:',trim(field1),'f2:',trim(field2) if (len_trim(field1) > 0 .and. len_trim(field2) > 0) then + ! set field1/field2 names for htape from the masterfield list + tape(t)%hlist(f)%op_field1=trim(field1) + tape(t)%hlist(f)%op_field2=trim(field2) ! find ids for field1/2 do ff = 1, nflds(t) if (trim(field1) == trim(tape(t)%hlist(ff)%field%name)) & @@ -1061,12 +1057,12 @@ subroutine define_composed_field_ids(t) if (tape(t)%hlist(f)%field%op_field2_id == -1) & call endrun(trim(subname)//': No op_field2 match for '//trim(tape(t)%hlist(f)%field%name)) - write(iulog,'(a,i0,a)')'TAPE:',t,' composed fields' - write(iulog,'(a,a,a)')' field',trim(tape(t)%hlist(f)%field%name),' composed of ' - ff=tape(t)%hlist(f)%field%op_field1_id - write(iulog,'(a,a,a,i0)')' name=',trim(tape(t)%hlist(ff)%field%name),' field1_id:',ff - ff=tape(t)%hlist(f)%field%op_field2_id - write(iulog,'(a,a,a,i0)')' name=',trim(tape(t)%hlist(ff)%field%name),' field2_id:',ff +!jt write(iulog,'(a,i0,a)')'TAPE:',t,' composed fields' +!jt write(iulog,'(a,a,a)')' field',trim(tape(t)%hlist(f)%field%name),' composed of ',trim(tape(t)%hlist(f)%op_field1),' ',trim(tape(t)%hlist(f)%op_field1) +!jt ff=tape(t)%hlist(f)%field%op_field1_id +!jt write(iulog,'(a,a,a,i0)')' name=',trim(tape(t)%hlist(ff)%field%name),' field1_id:',ff +!jt ff=tape(t)%hlist(f)%field%op_field2_id +!jt write(iulog,'(a,a,a,i0)')' name=',trim(tape(t)%hlist(ff)%field%name),' field2_id:',ff else call endrun(trim(subname)//': Component fields not found for composed field') end if @@ -1215,6 +1211,25 @@ subroutine restart_vars_setnames() restartvars(rvindex)%fillset = .true. restartvars(rvindex)%ifill = 0 + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'beg_nstep' + restartvars(rvindex)%type = pio_int + restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%dims(1) = maxnflds_dim_ind + restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%fillset = .true. + restartvars(rvindex)%ifill = 0 + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'hbuf_integral' + restartvars(rvindex)%type = pio_double + restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%dims(1) = maxnflds_dim_ind + restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%fillset = .true. + restartvars(rvindex)%ifill = 0 + + rvindex = rvindex + 1 restartvars(rvindex)%name = 'avgflag' restartvars(rvindex)%type = pio_char @@ -1359,7 +1374,7 @@ subroutine restart_vars_setnames() restartvars(rvindex)%name = 'field_op' restartvars(rvindex)%type = pio_char restartvars(rvindex)%ndims = 3 - restartvars(rvindex)%dims(1) = 3 + restartvars(rvindex)%dims(1) = max_chars_dim_ind restartvars(rvindex)%dims(2) = maxnflds_dim_ind restartvars(rvindex)%dims(3) = ptapes_dim_ind @@ -1381,6 +1396,22 @@ subroutine restart_vars_setnames() restartvars(rvindex)%fillset = .true. restartvars(rvindex)%ifill = 0 + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'op_field1' + restartvars(rvindex)%type = pio_char + restartvars(rvindex)%ndims = 3 + restartvars(rvindex)%dims(1) = max_fieldname_len_dim_ind + restartvars(rvindex)%dims(2) = maxnflds_dim_ind + restartvars(rvindex)%dims(3) = ptapes_dim_ind + + rvindex = rvindex + 1 + restartvars(rvindex)%name = 'op_field2' + restartvars(rvindex)%type = pio_char + restartvars(rvindex)%ndims = 3 + restartvars(rvindex)%dims(1) = max_fieldname_len_dim_ind + restartvars(rvindex)%dims(2) = maxnflds_dim_ind + restartvars(rvindex)%dims(3) = ptapes_dim_ind + end subroutine restart_vars_setnames subroutine restart_dims_setnames() @@ -1530,6 +1561,8 @@ subroutine write_restart_history ( File, & type(var_desc_t), pointer :: longname_desc type(var_desc_t), pointer :: units_desc type(var_desc_t), pointer :: hwrt_prec_desc + type(var_desc_t), pointer :: hbuf_integral_desc + type(var_desc_t), pointer :: beg_nstep_desc type(var_desc_t), pointer :: xyfill_desc type(var_desc_t), pointer :: mdims_desc ! mdim name indices type(var_desc_t), pointer :: mdimname_desc ! mdim names @@ -1545,6 +1578,8 @@ subroutine write_restart_history ( File, & type(var_desc_t), pointer :: field_op_desc type(var_desc_t), pointer :: op_field1_id_desc type(var_desc_t), pointer :: op_field2_id_desc + type(var_desc_t), pointer :: op_field1_desc + type(var_desc_t), pointer :: op_field2_desc integer, allocatable :: allmdims(:,:,:) integer, allocatable :: xyfill(:,:) @@ -1646,6 +1681,8 @@ subroutine write_restart_history ( File, & decomp_type_desc => restartvar_getdesc('decomp_type') numlev_desc => restartvar_getdesc('numlev') hwrt_prec_desc => restartvar_getdesc('hwrt_prec') + hbuf_integral_desc => restartvar_getdesc('hbuf_integral') + beg_nstep_desc => restartvar_getdesc('beg_nstep') sseq_desc => restartvar_getdesc('sampling_seq') cm_desc => restartvar_getdesc('cell_methods') @@ -1667,6 +1704,8 @@ subroutine write_restart_history ( File, & field_op_desc => restartvar_getdesc('field_op') op_field1_id_desc => restartvar_getdesc('op_field1_id') op_field2_id_desc => restartvar_getdesc('op_field2_id') + op_field1_desc => restartvar_getdesc('op_field1') + op_field2_desc => restartvar_getdesc('op_field2') mdims_desc => restartvar_getdesc('mdims') mdimname_desc => restartvar_getdesc('mdimnames') @@ -1690,6 +1729,8 @@ subroutine write_restart_history ( File, & ierr = pio_put_var(File, numlev_desc,start,tape(t)%hlist(f)%field%numlev) ierr = pio_put_var(File, hwrt_prec_desc,start,tape(t)%hlist(f)%hwrt_prec) + ierr = pio_put_var(File, hbuf_integral_desc,start,tape(t)%hlist(f)%hbuf_integral) + ierr = pio_put_var(File, beg_nstep_desc,start,tape(t)%hlist(f)%beg_nstep) ierr = pio_put_var(File, sseq_desc,startc,tape(t)%hlist(f)%field%sampling_seq) ierr = pio_put_var(File, cm_desc,startc,tape(t)%hlist(f)%field%cell_methods) ierr = pio_put_var(File, longname_desc,startc,tape(t)%hlist(f)%field%long_name) @@ -1699,9 +1740,11 @@ subroutine write_restart_history ( File, & ierr = pio_put_var(File, fillval_desc,start, tape(t)%hlist(f)%field%fillvalue) ierr = pio_put_var(File, meridional_complement_desc,start, tape(t)%hlist(f)%field%meridional_complement) ierr = pio_put_var(File, zonal_complement_desc,start, tape(t)%hlist(f)%field%zonal_complement) - ierr = pio_put_var(File, field_op_desc,start, tape(t)%hlist(f)%field%field_op) + ierr = pio_put_var(File, field_op_desc,startc, tape(t)%hlist(f)%field%field_op) ierr = pio_put_var(File, op_field1_id_desc,start, tape(t)%hlist(f)%field%op_field1_id) ierr = pio_put_var(File, op_field2_id_desc,start, tape(t)%hlist(f)%field%op_field2_id) + ierr = pio_put_var(File, op_field1_desc,startc, tape(t)%hlist(f)%op_field1) + ierr = pio_put_var(File, op_field2_desc,startc, tape(t)%hlist(f)%op_field2) if(associated(tape(t)%hlist(f)%field%mdims)) then allmdims(1:size(tape(t)%hlist(f)%field%mdims),f,t) = tape(t)%hlist(f)%field%mdims else @@ -1765,11 +1808,13 @@ subroutine read_restart_history (File) use ioFileMod, only: getfil use sat_hist, only: sat_hist_define, sat_hist_init use cam_grid_support, only: cam_grid_read_dist_array, cam_grid_num_grids - use cam_history_support, only: get_hist_coord_index, add_hist_coord + use cam_history_support, only: get_hist_coord_index, add_hist_coord, dim_index_2d use constituents, only: cnst_get_ind, cnst_get_type_byind + use cam_grid_support, only: cam_grid_get_areawt use shr_sys_mod, only: shr_sys_getenv use spmd_utils, only: mpicom, mpi_character, masterprocid + use time_manager, only: get_nstep ! !----------------------------------------------------------------------- ! @@ -1793,9 +1838,11 @@ subroutine read_restart_history (File) character(len=max_string_len) :: locfn ! Local filename character(len=max_fieldname_len), allocatable :: tmpname(:,:) + character(len=max_fieldname_len), allocatable :: tmpf1name(:,:) + character(len=max_fieldname_len), allocatable :: tmpf2name(:,:) integer, allocatable :: decomp(:,:), tmpnumlev(:,:) integer, pointer :: nacs(:,:) ! outfld accumulation counter - integer, pointer :: nsteps(:,:) ! nstep accumulation counter + integer :: beg_nstep ! start timestep of this slice for nstep accumulation counter character(len=max_fieldname_len) :: fname_tmp ! local copy of field name character(len=max_fieldname_len) :: dname_tmp ! local copy of dim name @@ -1813,13 +1860,17 @@ subroutine read_restart_history (File) type(var_desc_t) :: field_op_desc type(var_desc_t) :: op_field1_id_desc type(var_desc_t) :: op_field2_id_desc + type(var_desc_t) :: op_field1_desc + type(var_desc_t) :: op_field2_desc + type(dim_index_2d) :: dimind ! 2-D dimension index integer, allocatable :: tmpprec(:,:) + real(r8), allocatable :: tmpintegral(:,:) + integer, allocatable :: tmpbeg_nstep(:,:) integer, allocatable :: xyfill(:,:) integer, allocatable :: allmdims(:,:,:) integer, allocatable :: is_subcol(:,:) integer, allocatable :: interp_output(:) integer :: nacsdimcnt, nacsval - integer :: nstepsdimcnt, nstepsval integer :: maxnflds, dimid ! List of active grids (first dim) for each tape (second dim) @@ -1837,6 +1888,8 @@ subroutine read_restart_history (File) integer :: fdecomp ! Grid ID for field integer :: idx character(len=3) :: mixing_ratio + integer :: c,ib,ie,jb,je,k,cnt,wtidx(1) + real(r8), pointer :: areawt(:) ! pointer to areawt values for attribute ! ! Get users logname and machine hostname @@ -1914,22 +1967,27 @@ subroutine read_restart_history (File) ierr = pio_inq_varid(File, 'lcltod_stop', vdesc) ierr = pio_get_var(File, vdesc, lcltod_stop(1:mtapes)) - - - allocate(tmpname(maxnflds, mtapes), decomp(maxnflds, mtapes), tmpnumlev(maxnflds,mtapes)) ierr = pio_inq_varid(File, 'field_name', vdesc) ierr = pio_get_var(File, vdesc, tmpname) - ierr = pio_inq_varid(File, 'decomp_type', vdesc) ierr = pio_get_var(File, vdesc, decomp) ierr = pio_inq_varid(File, 'numlev', vdesc) ierr = pio_get_var(File, vdesc, tmpnumlev) + allocate(tmpintegral(maxnflds,mtapes)) + ierr = pio_inq_varid(File, 'hbuf_integral',vdesc) + ierr = pio_get_var(File, vdesc, tmpintegral(:,:)) + + allocate(tmpprec(maxnflds,mtapes)) ierr = pio_inq_varid(File, 'hwrt_prec',vdesc) ierr = pio_get_var(File, vdesc, tmpprec(:,:)) + allocate(tmpbeg_nstep(maxnflds,mtapes)) + ierr = pio_inq_varid(File, 'beg_nstep',vdesc) + ierr = pio_get_var(File, vdesc, tmpbeg_nstep(:,:)) + allocate(xyfill(maxnflds,mtapes)) ierr = pio_inq_varid(File, 'xyfill', vdesc) ierr = pio_get_var(File, vdesc, xyfill) @@ -1995,6 +2053,13 @@ subroutine read_restart_history (File) end if end do + allocate(tmpf1name(maxnflds, mtapes), tmpf2name(maxnflds, mtapes)) + ierr = pio_inq_varid(File, 'op_field1', vdesc) + ierr = pio_get_var(File, vdesc, tmpf1name) + ierr = pio_inq_varid(File, 'op_field2', vdesc) + ierr = pio_get_var(File, vdesc, tmpf2name) + + ierr = pio_inq_varid(File, 'avgflag', avgflag_desc) ierr = pio_inq_varid(File, 'long_name', longname_desc) @@ -2033,7 +2098,9 @@ subroutine read_restart_history (File) ierr = pio_get_var(File,fillval_desc, (/f,t/), tape(t)%hlist(f)%field%fillvalue) ierr = pio_get_var(File,meridional_complement_desc, (/f,t/), tape(t)%hlist(f)%field%meridional_complement) ierr = pio_get_var(File,zonal_complement_desc, (/f,t/), tape(t)%hlist(f)%field%zonal_complement) - ierr = pio_get_var(File,field_op_desc, (/f,t/), tape(t)%hlist(f)%field%field_op) + tape(t)%hlist(f)%field%field_op(1:max_chars) = ' ' + ierr = pio_get_var(File,field_op_desc, (/1,f,t/), tape(t)%hlist(f)%field%field_op) + call strip_null(tape(t)%hlist(f)%field%field_op) ierr = pio_get_var(File,op_field1_id_desc, (/f,t/), tape(t)%hlist(f)%field%op_field1_id) ierr = pio_get_var(File,op_field2_id_desc, (/f,t/), tape(t)%hlist(f)%field%op_field2_id) ierr = pio_get_var(File,avgflag_desc, (/f,t/), tape(t)%hlist(f)%avgflag) @@ -2056,11 +2123,16 @@ subroutine read_restart_history (File) tape(t)%hlist(f)%field%is_subcol=.false. end if call strip_null(tmpname(f,t)) + call strip_null(tmpf1name(f,t)) + call strip_null(tmpf2name(f,t)) tape(t)%hlist(f)%field%name = tmpname(f,t) + tape(t)%hlist(f)%op_field1 = tmpf1name(f,t) + tape(t)%hlist(f)%op_field2 = tmpf2name(f,t) tape(t)%hlist(f)%field%decomp_type = decomp(f,t) tape(t)%hlist(f)%field%numlev = tmpnumlev(f,t) tape(t)%hlist(f)%hwrt_prec = tmpprec(f,t) - + tape(t)%hlist(f)%hbuf_integral = tmpintegral(f,t) + tape(t)%hlist(f)%beg_nstep = tmpbeg_nstep(f,t) ! If the field is an advected constituent set the mixing_ratio attribute fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) call cnst_get_ind(fname_tmp, idx, abort=.false.) @@ -2077,11 +2149,14 @@ subroutine read_restart_history (File) tape(t)%hlist(f)%field%mdims(i) = get_hist_coord_index(mdimnames(allmdims(i,f,t))) end do end if - end do end do - deallocate(tmpname, tmpnumlev, tmpprec, decomp, xyfill, is_subcol) + deallocate(tmpname, tmpnumlev, tmpprec, tmpbeg_nstep, decomp, xyfill, is_subcol) deallocate(mdimnames) + deallocate(tmpf1name,tmpf2name) + + allocate(grid_wts(cam_grid_num_grids() + 1)) + allgrids_wt => grid_wts allocate(gridsontape(cam_grid_num_grids() + 1, ptapes)) gridsontape = -1 @@ -2114,16 +2189,6 @@ subroutine read_restart_history (File) else allocate(tape(t)%hlist(f)%nacs(1,begdim3:enddim3)) end if - - if (associated(tape(t)%hlist(f)%nsteps)) then - deallocate(tape(t)%hlist(f)%nsteps) - end if - nullify(tape(t)%hlist(f)%nsteps) - if(tape(t)%hlist(f)%field%flag_xyfill .or. (avgflag_pertape(t)=='L')) then - allocate (tape(t)%hlist(f)%nsteps(begdim1:enddim1,begdim3:enddim3)) - else - allocate(tape(t)%hlist(f)%nsteps(1,begdim3:enddim3)) - end if ! initialize all buffers to zero - this will be overwritten later by the ! data in the history restart file if it exists. call h_zero(f,t) @@ -2138,7 +2203,43 @@ subroutine read_restart_history (File) exit end if end do - + ! + !rebuild area wt array and set field wbuf pointer + ! + if (tape(t)%hlist(f)%avgflag .eq. 'N') then ! set up area weight buffer + nullify(tape(t)%hlist(f)%wbuf) + + if (any(allgrids_wt(:)%decomp_type == tape(t)%hlist(f)%field%decomp_type)) then + wtidx=MAXLOC(allgrids_wt(:)%decomp_type, MASK = allgrids_wt(:)%decomp_type .EQ. fdecomp) + !jt if (masterproc) write(iulog,*)'found decomp in allgrids_wt at index', wtidx + tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf + !jt if (masterproc) write(iulog,*)'pointing allgrids_wt wbuf to hlist wbuf' + else + ! area weights not found for this grid, then create them + wtidx=MINLOC(allgrids_wt(:)%decomp_type) + allgrids_wt(wtidx)%decomp_type=fdecomp + areawt => cam_grid_get_areawt(fdecomp) + !jt write(iulog,*)'shape areawt:',shape(areawt),' size areawt:',size(areawt),'shape wbuf:',shape(allgrids_wt(wtidx(1))%wbuf), & + !jt ' size wbuf:',size(allgrids_wt(wtidx(1))%wbuf) + allocate(allgrids_wt(wtidx(1))%wbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) + cnt=0 + do c=begdim3,enddim3 + dimind = tape(t)%hlist(f)%field%get_dims(c) + ib=dimind%beg1 + ie=dimind%end1 + jb=dimind%beg2 + je=dimind%end2 + do k=jb,je + do i=ib,ie + cnt=cnt+1 + allgrids_wt(wtidx(1))%wbuf(i,k,c)=areawt(cnt) + end do + end do + end do + tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf + !jt if (masterproc) write(iulog,*)'didnt find decomp in allgrids_wt allocating at index', wtidx(1),'areawt(1:40)=',areawt(1:40) + endif + endif end do end do ! @@ -2169,7 +2270,7 @@ subroutine read_restart_history (File) do f = 1, nflds(t) fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) - if(masterproc) write(iulog, *) 'Reading history variable ',fname_tmp +!jt if(masterproc) write(iulog, *) 'Reading history variable ',fname_tmp ierr = pio_inq_varid(tape(t)%File, fname_tmp, vdesc) call cam_pio_var_info(tape(t)%File, vdesc, ndims, dimids, dimlens) @@ -2248,21 +2349,6 @@ subroutine read_restart_history (File) ierr = pio_inq_varid(tape(t)%File, trim(fname_tmp)//'_nacs', vdesc) call cam_pio_var_info(tape(t)%File, vdesc, nacsdimcnt, dimids, dimlens) - if(nstepsdimcnt > 0) then - if (nfdims > 2) then - ! nsteps only has 2 dims (no levels) - fdims(2) = fdims(3) - end if - allocate(tape(t)%hlist(f)%nsteps(begdim1:enddim1,begdim3:enddim3)) - nsteps => tape(t)%hlist(f)%nsteps(:,:) - call cam_grid_read_dist_array(tape(t)%File, fdecomp, fdims(1:2), & - dimlens(1:nstepsdimcnt), nsteps, vdesc) - else - allocate(tape(t)%hlist(f)%nsteps(1,begdim3:enddim3)) - ierr = pio_get_var(tape(t)%File, vdesc, nstepsval) - tape(t)%hlist(f)%nsteps(1,:)= nstepsval - end if - end do ! ! Done reading this history restart file @@ -2301,10 +2387,6 @@ subroutine read_restart_history (File) ! Initialize filename specifier for IC file hfilename_spec(t) = '%c.cam' // trim(inst_suffix) // '.i.%y-%m-%d-%s.nc' nfils(t) = 0 -!!$ else if (is_budgetfile(file_index=t)) then -!!$ ! Initialize filename specifier for budget file -!!$ hfilename_spec(t) = '%c.cam' // trim(inst_suffix) // '.b.%y-%m-%d-%s.nc' -!!$ nfils(t) = 0 else if (nflds(t) == 0) then nfils(t) = 0 else @@ -2338,9 +2420,6 @@ subroutine read_restart_history (File) ! Setup vector pairs for unstructured grid interpolation call setup_interpolation_and_define_vector_complements() -!jt ! Initialize fields ids of fields that are composed of 2 other existing fields -!jt call define_composed_field_ids() - if(mtapes/=ptapes .and. masterproc) then write(iulog,*) ' WARNING: Restart file ptapes setting ',mtapes,' not equal to model setting ',ptapes end if @@ -2430,7 +2509,7 @@ subroutine AvgflagToString(avgflag, time_op) time_op(:) = 'mean' case ('B') time_op(:) = 'mean00z' - case ('C') + case ('N') time_op(:) = 'mean_over_nsteps' case ('I') time_op(:) = ' ' @@ -2651,17 +2730,9 @@ subroutine fldlst () mfilt (ptapes) = 1 end if -!!$ if(is_budgetfile()) then -!!$ hfilename_spec(ptapes) = '%c.cam' // trim(inst_suffix) // '.b.%y-%m-%d-%s.nc' -!!$ -!!$ ncprec(ptapes) = pio_double -!!$ ndens (ptapes) = 1 -!!$ mfilt (ptapes) = 1 -!!$ end if - allocate(grid_wts(cam_grid_num_grids() + 1)) - allgrids => grid_wts + allgrids_wt => grid_wts allocate(gridsontape(cam_grid_num_grids() + 1, ptapes)) gridsontape = -1 @@ -2681,7 +2752,6 @@ subroutine fldlst () fieldontape = .false. if (ff > 0) then fieldontape = .true. -!jt else if ((.not. empty_htapes) .or. (is_initfile(file_index=t)) .or. (is_budgetfile(file_index=t))) then else if ((.not. empty_htapes) .or. (is_initfile(file_index=t))) then call list_index (fexcl(1,t), mastername, ff) if (ff == 0 .and. listentry%actflag(t)) then @@ -2743,8 +2813,8 @@ subroutine fldlst () do ff=1,nflds(t) nullify(tape(t)%hlist(ff)%hbuf) nullify(tape(t)%hlist(ff)%sbuf) + nullify(tape(t)%hlist(ff)%wbuf) nullify(tape(t)%hlist(ff)%nacs) - nullify(tape(t)%hlist(ff)%nsteps) nullify(tape(t)%hlist(ff)%varid) end do @@ -2766,7 +2836,6 @@ subroutine fldlst () if (ff > 0) then avgflag = getflag (fincl(ff,t)) call inifld (t, listentry, avgflag, prec_wrt) -!jt else if ((.not. empty_htapes) .or. (is_initfile(file_index=t)) .or. (is_budgetfile(file_index=t))) then else if ((.not. empty_htapes) .or. (is_initfile(file_index=t))) then call list_index (fexcl(1,t), mastername, ff) if (ff == 0 .and. listentry%actflag(t)) then @@ -2790,10 +2859,6 @@ subroutine fldlst () else call patch_init(t) end if - - ! Initialize the field ids for each composed field on tapes - call define_composed_field_ids(t) - ! ! Specification of tape contents now complete. Sort each list of active ! entries for efficiency in OUTFLD. Simple bubble sort. @@ -2819,6 +2884,9 @@ subroutine fldlst () end do end do + ! Initialize the field names/ids for each composed field on tapes + call define_composed_field_ids(t) + end do ! do t=1,ptapes deallocate(gridsontape) @@ -2872,8 +2940,6 @@ subroutine print_active_fldlst() if (is_initfile(file_index=t)) then write(iulog,*) ' Write frequency: ',inithist,' (INITIAL CONDITIONS)' -!!$ else if (is_budgetfile(file_index=t)) then -!!$ write(iulog,*) ' Write frequency: ',budgethist,' (MASS/ENERGY BUDGETS)' else if (nhtfrq(t) == 0) then write(iulog,*) ' Write frequency: MONTHLY' @@ -3027,7 +3093,6 @@ subroutine inifld (t, listentry, avgflag, prec_wrt) end if end if - #ifdef HDEBUG if (masterproc) then write(iulog,'(a,i0,3a,i0,a,i2)')'HDEBUG: ',__LINE__,' field ', & @@ -3036,9 +3101,6 @@ subroutine inifld (t, listentry, avgflag, prec_wrt) write(iulog,'(2a)')' units = ',trim(tape(t)%hlist(n)%field%units) write(iulog,'(a,i0)')' numlev = ',tape(t)%hlist(n)%field%numlev write(iulog,'(2a)')' avgflag = ',tape(t)%hlist(n)%avgflag - write(iulog,'(3a)')' time_op = "',trim(tape(t)%hlist(n)%time_op),'"' - write(iulog,'(a,i0)')' hwrt_prec = ',tape(t)%hlist(n)%hwrt_prec - write(iulog,'(a,a)')' field_op = ',tape(t)%hlist(n)%field%field_op end if #endif @@ -3184,7 +3246,6 @@ character(len=max_fieldname_len) function strip_suffix (name) strip_suffix(n:n) = name(n:n) if(name(n+1:n+1 ) == ' ' ) return if(name(n+1:n+fieldname_suffix_len) == fieldname_suffix) return - if(name(n+1:n+fieldname_suffix_len) == bfieldname_suffix) return end do strip_suffix(fieldname_len+1:max_fieldname_len) = name(fieldname_len+1:max_fieldname_len) @@ -3527,10 +3588,9 @@ end subroutine subcol_field_avg_handler type (active_entry), pointer :: otape(:) ! Local history_tape pointer real(r8),pointer :: hbuf(:,:) ! history buffer - real(r8),pointer :: gbuf(:,:) ! area weights for field + real(r8),pointer :: wbuf(:,:) ! area weights for field real(r8),pointer :: sbuf(:,:) ! variance buffer integer, pointer :: nacs(:) ! accumulation counter - integer, pointer :: nsteps(:) ! nstep accumulation counter integer :: begdim2, enddim2, endi integer :: phys_decomp type (dim_index_2d) :: dimind ! 2-D dimension index @@ -3567,10 +3627,9 @@ end subroutine subcol_field_avg_handler fillvalue = otape(t)%hlist(f)%field%fillvalue avgflag = otape(t)%hlist(f)%avgflag nacs => otape(t)%hlist(f)%nacs(:,c) - nsteps => otape(t)%hlist(f)%nsteps(:,c) hbuf => otape(t)%hlist(f)%hbuf(:,:,c) - if (associated(tape(t)%hlist(f)%gbuf)) then - gbuf => otape(t)%hlist(f)%gbuf(:,:,c) + if (associated(tape(t)%hlist(f)%wbuf)) then + wbuf => otape(t)%hlist(f)%wbuf(:,:,c) endif if (associated(tape(t)%hlist(f)%sbuf)) then sbuf => otape(t)%hlist(f)%sbuf(:,:,c) @@ -3645,9 +3704,9 @@ end subroutine subcol_field_avg_handler call hbuf_accum_add00z(hbuf, ufield, nacs, dimind, pcols, & flag_xyfill, fillvalue) - case ('C') ! Time average over nsteps + case ('N') ! Time average over nsteps call hbuf_accum_addnsteps(hbuf, ufield, nacs, dimind, pcols, & - flag_xyfill, fillvalue, nsteps) + flag_xyfill, fillvalue) case ('X') ! Maximum over time call hbuf_accum_max (hbuf, ufield, nacs, dimind, pcols, & @@ -3687,9 +3746,9 @@ end subroutine subcol_field_avg_handler call hbuf_accum_add00z(hbuf, field, nacs, dimind, idim, & flag_xyfill, fillvalue) - case ('C') ! Time average over nsteps + case ('N') ! Time average over nsteps call hbuf_accum_addnsteps (hbuf, field, nacs, dimind, idim, & - flag_xyfill, fillvalue, nsteps) + flag_xyfill, fillvalue) case ('X') ! Maximum over time call hbuf_accum_max (hbuf, field, nacs, dimind, idim, & @@ -3722,7 +3781,7 @@ end subroutine outfld !####################################################################### - subroutine get_field_properties(fname, found, tape_out, ff_out, no_tape_check_in) + subroutine get_field_properties(fname, found, tape_out, ff_out, no_tape_check_in, f_out) implicit none ! @@ -3745,6 +3804,7 @@ subroutine get_field_properties(fname, found, tape_out, ff_out, no_tape_check_in type(active_entry), pointer, optional :: tape_out(:) integer, intent(out), optional :: ff_out logical, intent(in), optional :: no_tape_check_in + integer, intent(out), optional :: f_out(:) ! ! Local variables @@ -3773,6 +3833,9 @@ subroutine get_field_properties(fname, found, tape_out, ff_out, no_tape_check_in if (present(ff_out)) then ff_out = -1 end if + if (present(f_out)) then + f_out = -1 + end if ! ! If ( ff < 0 ), the field is not defined on the masterlist. This check @@ -3806,8 +3869,12 @@ subroutine get_field_properties(fname, found, tape_out, ff_out, no_tape_check_in if (present(ff_out)) then ff_out = ff end if - ! We found the info so we are done with the loop - exit + if (present(f_out)) then + f_out(t) = masterlist(ff)%thisentry%htapeindx(t) + else + ! only need to loop through all ptapes if f_out present + exit + end if end if end do @@ -3919,9 +3986,8 @@ subroutine h_inquire (t) ierr=pio_inq_varid (tape(t)%File,'tsec ',tape(t)%tsecid) ierr=pio_inq_varid (tape(t)%File,'bdate ',tape(t)%bdateid) #endif -!jt if (.not. is_initfile(file_index=t).and. .not. is_budgetfile(file_index=t)) then - if (.not. is_initfile(file_index=t)) then - ! Don't write the GHG/Solar forcing data to the IC or budget files. It is never + if (.not. is_initfile(file_index=t) ) then + ! Don't write the GHG/Solar forcing data to the IC file. It is never ! read from that file so it's confusing to have it there. ierr=pio_inq_varid (tape(t)%File,'co2vmr ', tape(t)%co2vmrid) ierr=pio_inq_varid (tape(t)%File,'ch4vmr ', tape(t)%ch4vmrid) @@ -4045,7 +4111,6 @@ subroutine add_default (name, tindex, flag) ! Add to IC file if tindex = 0, reset to ptapes if (tindex == 0) then t = ptapes -!jt if ( .not. is_initfile(file_index=t) .and. .not. is_budgetfile(file_index=t) ) return if ( .not. is_initfile(file_index=t) ) return else t = tindex @@ -4164,7 +4229,6 @@ subroutine h_define (t, restart) integer :: chardim ! character dimension id integer :: dimenchar(2) ! character dimension ids integer :: nacsdims(2) ! dimension ids for nacs (used in restart file) - integer :: nstepsdims(2) ! dimension ids for nsteps (used in restart file) integer :: bnddim ! bounds dimension id integer :: timdim ! unlimited dimension id @@ -4409,9 +4473,8 @@ subroutine h_define (t, restart) ierr=pio_put_att (tape(t)%File, tape(t)%nscurid, 'long_name', trim(str)) -!jt if (.not. is_initfile(file_index=t) .and. .not. is_budgetfile(file_index=t)) then if (.not. is_initfile(file_index=t)) then - ! Don't write the GHG/Solar forcing data to the IC or budget file. + ! Don't write the GHG/Solar forcing data to the IC file. ierr=pio_def_var (tape(t)%File,'co2vmr ',pio_double,(/timdim/),tape(t)%co2vmrid) str = 'co2 volume mixing ratio' ierr=pio_put_att (tape(t)%File, tape(t)%co2vmrid, 'long_name', trim(str)) @@ -4565,7 +4628,6 @@ subroutine h_define (t, restart) do i = 1, num_hdims dimindex(i) = header_info(1)%get_hdimid(i) nacsdims(i) = header_info(1)%get_hdimid(i) - nstepsdims(i) = header_info(1)%get_hdimid(i) end do else if (patch_output) then ! All patches for this variable should be on the same grid @@ -4592,7 +4654,6 @@ subroutine h_define (t, restart) do i = 1, num_hdims dimindex(i) = header_info(grd)%get_hdimid(i) nacsdims(i) = header_info(grd)%get_hdimid(i) - nstepsdims(i) = header_info(grd)%get_hdimid(i) end do end if ! is_satfile @@ -4713,7 +4774,7 @@ subroutine h_define (t, restart) end if if (restart) then - ! For restart history files, we need to save accumulation counts and nsteps + ! For restart history files, we need to save accumulation counts fname_tmp = trim(fname_tmp)//'_nacs' if (.not. associated(tape(t)%hlist(f)%nacs_varid)) then allocate(tape(t)%hlist(f)%nacs_varid) @@ -4726,20 +4787,6 @@ subroutine h_define (t, restart) call cam_pio_def_var(tape(t)%File, trim(fname_tmp), pio_int, & tape(t)%hlist(f)%nacs_varid) end if - fname_tmp = trim(fname_tmp)//'_nsteps' - if (.not. associated(tape(t)%hlist(f)%nsteps_varid)) then - allocate(tape(t)%hlist(f)%nsteps_varid) - end if - if (size(tape(t)%hlist(f)%nsteps, 1) > 1) then - call cam_pio_def_var(tape(t)%File, trim(fname_tmp), pio_int, & - nstepsdims(1:num_hdims), tape(t)%hlist(f)%nsteps_varid) - else - ! Save just one value representing all chunks - call cam_pio_def_var(tape(t)%File, trim(fname_tmp), pio_int, & - tape(t)%hlist(f)%nsteps_varid) - end if - - ! for standard deviation if (associated(tape(t)%hlist(f)%sbuf)) then fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) @@ -4825,6 +4872,7 @@ end subroutine h_define subroutine h_normalize (f, t) use cam_history_support, only: dim_index_2d + use time_manager, only: get_nstep ! !----------------------------------------------------------------------- @@ -4850,10 +4898,13 @@ subroutine h_normalize (f, t) integer :: begdim3, enddim3 ! Chunk or block bounds integer :: k ! level integer :: i, ii + integer :: currstep, nsteps real(r8) :: variance, tmpfill logical :: flag_xyfill ! non-applicable xy points flagged with fillvalue character*1 :: avgflag ! averaging flag + character(len=max_chars) :: errmsg + character(len=*), parameter :: sub='H_NORMALIZE:' call t_startf ('h_normalize') @@ -4898,21 +4949,19 @@ subroutine h_normalize (f, t) end do end if end if - if (avgflag == 'C') then - if (size(tape(t)%hlist(f)%nsteps, 1) > 1) then - do k = jb, je - where (tape(t)%hlist(f)%nsteps(ib:ie,c) /= 0) - tape(t)%hlist(f)%hbuf(ib:ie,k,c) = & - tape(t)%hlist(f)%hbuf(ib:ie,k,c) & - / tape(t)%hlist(f)%nsteps(ib:ie,c) - endwhere - end do - else if(tape(t)%hlist(f)%nsteps(1,c) > 0) then + currstep=get_nstep() + if (avgflag == 'N' .and. currstep > 0) then +!jt if (masterproc) write(iulog,*)'normalizing ',tape(t)%hlist(f)%field%name,' currstep',currstep,'beg_nstep=',tape(t)%hlist(f)%beg_nstep + if( currstep > tape(t)%hlist(f)%beg_nstep) then + nsteps=currstep-tape(t)%hlist(f)%beg_nstep do k=jb,je tape(t)%hlist(f)%hbuf(ib:ie,k,c) = & tape(t)%hlist(f)%hbuf(ib:ie,k,c) & - / tape(t)%hlist(f)%nsteps(1,c) + / nsteps end do + else + write(errmsg,*) sub//'FATAL: nstep normalization is bad, currstep,beg_nstep, nsteps=',currstep, tape(t)%hlist(f)%beg_nstep + call endrun(errmsg) end if end if if (avgflag == 'S') then @@ -4942,6 +4991,7 @@ end subroutine h_normalize subroutine h_zero (f, t) use cam_history_support, only: dim_index_2d + use time_manager, only: get_nstep, is_first_restart_step ! !----------------------------------------------------------------------- ! @@ -4973,7 +5023,9 @@ subroutine h_zero (f, t) end if end do tape(t)%hlist(f)%nacs(:,:) = 0 - tape(t)%hlist(f)%nsteps(:,:) = 0 + + !Don't reset beg_nstep if this is a restart + if (.not. is_first_restart_step()) tape(t)%hlist(f)%beg_nstep = get_nstep() call t_stopf ('h_zero') @@ -5006,66 +5058,49 @@ subroutine h_global (f, t) integer :: ie ! dim3 index integer :: count ! integer :: i1 ! + integer :: j1 ! + integer :: fdims(3) ! integer :: comm_id! integer :: begdim1,enddim1,begdim2,enddim2,begdim3,enddim3 ! real(r8) :: globalsum(1) ! globalsum real(r8), allocatable :: globalarr(:) ! globalarr values for this pe - - + + call t_startf ('h_global') - if (masterproc) write(6,*)'h_global: field num:',f,'tape:',t,' name:',trim(tape(t)%hlist(f)%field%name),' gbuf associated?',associated(tape(t)%hlist(f)%gbuf) - if (associated(tape(t)%hlist(f)%gbuf) ) then - begdim1 = tape(t)%hlist(f)%field%begdim1 - enddim1 = tape(t)%hlist(f)%field%enddim1 - begdim2 = tape(t)%hlist(f)%field%begdim2 - enddim2 = tape(t)%hlist(f)%field%enddim2 - begdim3 = tape(t)%hlist(f)%field%begdim3 - enddim3 = tape(t)%hlist(f)%field%enddim3 - - allocate(globalarr((enddim1-begdim1+1)*(enddim2-begdim2+1)*(enddim3-begdim3+1))) - count=0 - globalarr=0._r8 - do ie = begdim3, enddim3 - dimind = tape(t)%hlist(f)%field%get_dims(ie) -!jt write(6,*)'t,f,begdim1,beg1,enddim1,end1=',t,f,begdim1,dimind%beg1,enddim1,dimind%end1 - write(6,*)'h_global:field:',trim(tape(t)%hlist(f)%field%name),'gbuf(',dimind%beg1,':',dimind%end1,',1,',ie,')=',tape(t)%hlist(f)%gbuf(dimind%beg1:dimind%end1,1,ie),'hbbuf(',dimind%beg1,':',dimind%end1,',1,',ie,')=',tape(t)%hlist(f)%hbuf(dimind%beg1:dimind%end1,1,ie) - do i1 = dimind%beg1, dimind%end1 -!jt do i1 = begdim1, enddim1 - count=count+1 - globalarr(count)=globalarr(count)+tape(t)%hlist(f)%hbuf(i1,1,ie)*tape(t)%hlist(f)%gbuf(i1,1,ie) + ! wbuf contains the area weighting for this field decomposition + if (associated(tape(t)%hlist(f)%wbuf) ) then + + begdim1 = tape(t)%hlist(f)%field%begdim1 + enddim1 = tape(t)%hlist(f)%field%enddim1 + fdims(1) = enddim1 - begdim1 + 1 + begdim2 = tape(t)%hlist(f)%field%begdim2 + enddim2 = tape(t)%hlist(f)%field%enddim2 + fdims(2) = enddim2 - begdim2 + 1 + begdim3 = tape(t)%hlist(f)%field%begdim3 + enddim3 = tape(t)%hlist(f)%field%enddim3 + fdims(3) = enddim3 - begdim3 + 1 + + allocate(globalarr(fdims(1)*fdims(2)*fdims(3))) + count=0 + globalarr=0._r8 + do ie = begdim3, enddim3 + dimind = tape(t)%hlist(f)%field%get_dims(ie) + do j1 = dimind%beg2, dimind%end2 + do i1 = dimind%beg1, dimind%end1 + count=count+1 + globalarr(count)=globalarr(count)+tape(t)%hlist(f)%hbuf(i1,j1,ie)*tape(t)%hlist(f)%wbuf(i1,j1,ie) + end do + end do end do - end do - ! call fixed-point algorithm - call shr_reprosum_calc (globalarr, globalsum, count, count, 1, commid=mpicom) - if (masterproc) write(6,*)'h_global:field:',trim(tape(t)%hlist(f)%field%name),'global integral=',globalsum/(4.0_r8*PI) - -!!$ call repro_sum(globarr, globsum, nsize_use, nelemd, nflds(t), commid=comm_id) -!!$ h(npts,npts,num_flds,nets:nete) -!!$ da = grid area wgt organized by hbuf dims ie all local cols from begdim3:enddim3 -!!$ global_integrals_general(h,comm_id,npts,da,nflds(t),begdim3,enddim3,I_sphere) -!!$ -!!$ -!!$!JMD print *,'global_integral: before loop' -!!$ do ie=dimind%beg3:dimind%end3 -!!$ do q=1,num_flds -!!$ do j=1,begnpts -!!$ do i=1,npts -!!$ J_tmp(ie,q) = J_tmp(ie,q) + da(i,j,ie)*h(i,j,q,ie) -!!$ end do -!!$ end do -!!$ end do -!!$ end do -!!$ do ie=nets,nete -!!$ global_shared_buf(ie,1:num_flds) = J_tmp(ie,:) -!!$ enddo -!!$ !JMD print *,'global_integral: before wrap_repro_sum' -!!$ call wrap_repro_sum(nvars=num_flds, comm=hybrid%par%comm) -!!$ !JMD print *,'global_integral: after wrap_repro_sum' -!!$ I_sphere(:) =global_shared_sum(1:num_flds) /(4.0_r8*PI) -!!$ - + ! call fixed-point algorithm + call shr_reprosum_calc (globalarr, globalsum, count, count, 1, commid=mpicom) + if (masterproc) write(iulog,*)'h_global:field:',trim(tape(t)%hlist(f)%field%name),' global integral=',globalsum(1) + ! store global entry for this history tape entry + call tape(t)%hlist(f)%put_global(globalsum(1)) + ! deallocate temp array + deallocate(globalarr) end if call t_stopf ('h_global') return @@ -5090,31 +5125,29 @@ subroutine h_field_op (f, t) ! type (dim_index_2d) :: dimind ! 2-D dimension index integer :: c ! chunk index - integer, pointer :: f1,f2 ! fields to be operated on + integer :: f1,f2 ! fields to be operated on integer :: begdim1, begdim2, begdim3 ! on-node chunk or lat start index integer :: enddim1, enddim2, enddim3 ! on-node chunk or lat end index - character(len=3) :: op ! field operation currently only sum/diff + character(len=max_chars) :: op ! field operation currently only sum/diff call t_startf ('h_field_op') - begdim1 = tape(t)%hlist(f)%field%begdim1 - enddim1 = tape(t)%hlist(f)%field%enddim1 - begdim2 = tape(t)%hlist(f)%field%begdim2 - enddim2 = tape(t)%hlist(f)%field%enddim2 + f1 = tape(t)%hlist(f)%field%op_field1_id + f2 = tape(t)%hlist(f)%field%op_field2_id + op = trim(adjustl(tape(t)%hlist(f)%field%field_op)) + begdim3 = tape(t)%hlist(f)%field%begdim3 enddim3 = tape(t)%hlist(f)%field%enddim3 - call tape(t)%hlist(f)%field%get_bounds(3, begdim3, enddim3) - f1 => tape(t)%hlist(f)%field%op_field1_id - f2 => tape(t)%hlist(f)%field%op_field2_id - op = tape(t)%hlist(f)%field%field_op - call tape(t)%hlist(f)%field%get_bounds(3, begdim3, enddim3) + dimind = tape(t)%hlist(f)%field%get_dims(begdim3) +!jt write(iulog,*)'diff fields',trim(tape(t)%hlist(f)%field%name),trim(tape(t)%hlist(f1)%field%name),' ids',f1,',',f2,' op=',trim(op),'sum f1=',sum(tape(t)%hlist(f1)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,begdim3)),sum(tape(t)%hlist(f2)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,begdim3)),sum(tape(t)%hlist(f1)%wbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,begdim3)) + do c = begdim3, enddim3 dimind = tape(t)%hlist(f)%field%get_dims(c) - if (op == 'dif') then + if (trim(op) == 'dif') then tape(t)%hlist(f)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) = & tape(t)%hlist(f1)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) - & tape(t)%hlist(f2)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) - else if (op == 'sum') then + else if (trim(op) == 'sum') then tape(t)%hlist(f)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) = & tape(t)%hlist(f1)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) - & tape(t)%hlist(f2)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) @@ -5123,17 +5156,10 @@ subroutine h_field_op (f, t) end if end do ! Set nsteps for composed fields using value of one of the component fields - tape(t)%hlist(f)%nsteps(:,:)=tape(t)%hlist(f1)%nsteps(:,:) + tape(t)%hlist(f)%beg_nstep=tape(t)%hlist(f1)%beg_nstep tape(t)%hlist(f)%nacs(:,:)=tape(t)%hlist(f1)%nacs(:,:) call t_stopf ('h_field_op') - if (masterproc) write(6,*)'h_field_op:field,f1name,f2name,op,f1,f1id,f2,f2id,nsteps,nacs,sumhbuf1,sumhbuf2=', & - trim(tape(t)%hlist(f)%field%name),trim(tape(t)%hlist(f1)%field%name),trim(tape(t)%hlist(f2)%field%name),op, & - f1,tape(t)%hlist(f)%field%op_field1_id,f2,tape(t)%hlist(f)%field%op_field2_id, & - tape(t)%hlist(f)%nsteps(begdim1,begdim3),tape(t)%hlist(f)%nacs(begdim1,begdim3), & - sum(tape(t)%hlist(f1)%hbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)), & - sum(tape(t)%hlist(f2)%hbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) - return end subroutine h_field_op @@ -5163,7 +5189,6 @@ subroutine dump_field (f, t, restart) integer :: fdims(8) ! Field file dim sizes integer :: frank ! Field file rank integer :: nacsrank ! Field file rank for nacs - integer :: nstepsrank ! Field file rank for nsteps type(dim_index_2d) :: dimind2 ! 2-D dimension index type(dim_index_3d) :: dimind ! 3-D dimension index integer :: adims(3) ! Field array dim sizes @@ -5332,22 +5357,6 @@ subroutine dump_field (f, t, restart) ierr = pio_put_var(tape(t)%File, tape(t)%hlist(f)%nacs_varid, & tape(t)%hlist(f)%nacs(:, bdim3:edim3)) end if - !! NSTEPS - if (size(tape(t)%hlist(f)%nsteps, 1) > 1) then - if (nadims > 2) then - adims(2) = adims(3) - nadims = 2 - end if - call cam_grid_dimensions(fdecomp, fdims(1:2), nstepsrank) - call cam_grid_write_dist_array(tape(t)%File, fdecomp, & - adims(1:nadims), fdims(1:nstepsrank), & - tape(t)%hlist(f)%nsteps, tape(t)%hlist(f)%nsteps_varid) - else - bdim3 = tape(t)%hlist(f)%field%begdim3 - edim3 = tape(t)%hlist(f)%field%enddim3 - ierr = pio_put_var(tape(t)%File, tape(t)%hlist(f)%nsteps_varid, & - tape(t)%hlist(f)%nsteps(:, bdim3:edim3)) - end if end if return @@ -5404,57 +5413,6 @@ end function write_inithist !####################################################################### - !####################################################################### - - logical function write_budgethist () - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Set flags that will initiate dump to BUDGET file when OUTFLD and - ! WSHIST are called - ! - !----------------------------------------------------------------------- - ! - use time_manager, only: get_nstep, get_curr_date, get_step_size, is_last_step - ! - ! Local workspace - ! - integer :: yr, mon, day ! year, month, and day components of - ! a date - integer :: nstep ! current timestep number - integer :: ncsec ! current time of day [seconds] - integer :: dtime ! timestep size - - !----------------------------------------------------------------------- - - write_budgethist = .false. - -!jt if(is_budgetfile()) then - - nstep = get_nstep() - call get_curr_date(yr, mon, day, ncsec) - - if(budgethist == 'STEP' ) then - write_budgethist = nstep /= 0 - elseif (budgethist == 'HOURLY') then - dtime = get_step_size() - write_budgethist = nstep /= 0 .and. mod( nstep, nint((3600._r8)/dtime) ) == 0 - elseif(budgethist == 'DAILY' ) then - write_budgethist = nstep /= 0 .and. ncsec == 0 - elseif(budgethist == 'MONTHLY' ) then - write_budgethist = nstep /= 0 .and. ncsec == 0 .and. day == 1 - elseif(budgethist == 'YEARLY' ) then - write_budgethist = nstep /= 0 .and. ncsec == 0 .and. day == 1 .and. mon == 1 - elseif(budgethist == 'ENDOFRUN' ) then - write_budgethist = nstep /= 0 .and. is_last_step() - end if -!jt end if - - return - end function write_budgethist - - !####################################################################### - subroutine wshist (rgnht_in) ! !----------------------------------------------------------------------- @@ -5470,7 +5428,6 @@ subroutine wshist (rgnht_in) use interp_mod, only: set_interp_hfile use datetime_mod, only: datetime use cam_pio_utils, only: cam_pio_closefile - use spmd_utils, only: mpicom logical, intent(in), optional :: rgnht_in(ptapes) ! @@ -5534,9 +5491,6 @@ subroutine wshist (rgnht_in) if( is_initfile(file_index=t) ) then hstwr(t) = write_inithist() prev = .false. -!!$ else if( is_budgetfile(file_index=t) ) then -!!$ hstwr(t) = write_budgethist() -!!$ prev = .false. else if (nhtfrq(t) == 0) then hstwr(t) = nstep /= 0 .and. day == 1 .and. ncsec == 0 @@ -5553,10 +5507,6 @@ subroutine wshist (rgnht_in) write(iulog,100) yr,mon,day,ncsec 100 format('WSHIST: writing time sample to Initial Conditions h-file', & ' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) -!!$ else if(is_budgetfile(file_index=t)) then -!!$ write(iulog,125) yr,mon,day,ncsec -!!$125 format('WSHIST: writing time sample to Budget h-file', & -!!$ ' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) else if(is_satfile(t)) then write(iulog,150) nfils(t),t,yr,mon,day,ncsec 150 format('WSHIST: writing sat columns ',i6,' to h-file ', & @@ -5582,8 +5532,6 @@ subroutine wshist (rgnht_in) hrestpath(t)=fname else if(is_initfile(file_index=t)) then fname = interpret_filename_spec( hfilename_spec(t) ) -!!$ else if(is_budgetfile(file_index=t)) then -!!$ fname = interpret_filename_spec( hfilename_spec(t) ) else fname = interpret_filename_spec( hfilename_spec(t), number=(t-1), & prev=prev ) @@ -5630,9 +5578,8 @@ subroutine wshist (rgnht_in) ierr = pio_put_var (tape(t)%File, tape(t)%nscurid,(/start/), (/count1/),(/nscur/)) ierr = pio_put_var (tape(t)%File, tape(t)%dateid,(/start/), (/count1/),(/ncdate/)) -!jt if (.not. is_initfile(file_index=t) .and. .not. is_budgetfile(file_index=t)) then if (.not. is_initfile(file_index=t)) then - ! Don't write the GHG/Solar forcing data to the IC or budget file. + ! Don't write the GHG/Solar forcing data to the IC file. ierr=pio_put_var (tape(t)%File, tape(t)%co2vmrid,(/start/), (/count1/),(/chem_surfvals_co2_rad(vmr_in=.true.)/)) ierr=pio_put_var (tape(t)%File, tape(t)%ch4vmrid,(/start/), (/count1/),(/chem_surfvals_get('CH4VMR')/)) ierr=pio_put_var (tape(t)%File, tape(t)%n2ovmrid,(/start/), (/count1/),(/chem_surfvals_get('N2OVMR')/)) @@ -5689,19 +5636,22 @@ subroutine wshist (rgnht_in) ierr = pio_put_var (tape(t)%File, tape(t)%date_writtenid, startc, countc, (/cdate/)) ierr = pio_put_var (tape(t)%File, tape(t)%time_writtenid, startc, countc, (/ctime/)) - if(.not. restart) then - !$OMP PARALLEL DO PRIVATE (F) - do f=1,nflds(t) - ! First compose field if needed - if (tape(t)%hlist(f)%field%is_composed()) then - call h_field_op (f, t) - end if - ! Normalized averaged fields - if (tape(t)%hlist(f)%avgflag /= 'I') then - call h_normalize (f, t) - end if - end do - end if + !$OMP PARALLEL DO PRIVATE (F) + do f=1,nflds(t) + ! First compose field if needed +!jt if(masterproc) write(iulog,*)'checking if field ',trim(tape(t)%hlist(f)%field%name),' is composed',tape(t)%hlist(f)%field%is_composed() + if (tape(t)%hlist(f)%field%is_composed()) then +!jt if (masterproc) write(iulog,*)'field ',trim(tape(t)%hlist(f)%field%name),' is composed',tape(t)%hlist(f)%field%is_composed() + call h_field_op (f, t) + end if +!jt if (masterproc) write(iulog,*)'restart flag is',restart, 'false to normalize field' + if(.not. restart) then + ! Normalized averaged fields + if (tape(t)%hlist(f)%avgflag /= 'I') then + call h_normalize (f, t) + end if + end if + end do ! ! Write field to history tape. Note that this is NOT threaded due to netcdf limitations ! @@ -5711,13 +5661,11 @@ subroutine wshist (rgnht_in) end do call t_stopf ('dump_field') ! - ! If this is a budget field calculate globals and write out energy budget + ! Calculate globals ! -!jt if (is_budgetfile(file_index=t)) then - do f=1,nflds(t) - call h_global(f, t) - end do -!jt end if + do f=1,nflds(t) + call h_global(f, t) + end do ! ! Zero history buffers and accumulators now that the fields have been written. ! @@ -5819,7 +5767,7 @@ subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & use cam_history_support, only: fillvalue, hist_coord_find_levels use cam_grid_support, only: cam_grid_id, cam_grid_is_zonal use cam_grid_support, only: cam_grid_get_coord_names - use constituents, only: pcnst, cnst_get_ind, cnst_get_type_byind + use constituents, only: cnst_get_ind, cnst_get_type_byind ! ! Arguments @@ -5908,6 +5856,8 @@ subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & listentry%field%field_op = '' listentry%field%op_field1_id = -1 listentry%field%op_field2_id = -1 + listentry%op_field1 = '' + listentry%op_field2 = '' listentry%htapeindx(:) = -1 listentry%act_sometape = .false. listentry%actflag(:) = .false. @@ -6013,8 +5963,8 @@ subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & listentry%field%field_op = op if (present(op_f1name).and.present(op_f2name)) then ! Look for the field IDs - f1listentry => get_entry_by_name(masterlinkedlist, op_f1name) - f2listentry => get_entry_by_name(masterlinkedlist, op_f2name) + f1listentry => get_entry_by_name(masterlinkedlist, trim(op_f1name)) + f2listentry => get_entry_by_name(masterlinkedlist, trim(op_f2name)) if (associated(f1listentry).and.associated(f2listentry)) then listentry%op_field1=trim(op_f1name) listentry%op_field2=trim(op_f2name) @@ -6050,6 +6000,7 @@ subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & end subroutine addfld_nd !####################################################################### + ! field_part_of_vector: Determinie if fname is part of a vector set ! Optionally fill in the names of the vector set fields logical function field_part_of_vector(fname, meridional_name, zonal_name) @@ -6104,8 +6055,10 @@ logical function composed_field(fname, fname1, fname2) ! Local variables type(master_entry), pointer :: listentry +!jt write(iulog,*)'checking masterlinked list for field name=',trim(fname) listentry => get_entry_by_name(masterlinkedlist, fname) if (associated(listentry)) then +!jt write(iulog,*)'composed field name f1 f2=',trim(listentry%field%name),trim(listentry%op_field1),trim(listentry%op_field2) if ( (len_trim(listentry%op_field1) > 0) .or. & (len_trim(listentry%op_field2) > 0)) then composed_field = .true. @@ -6116,6 +6069,7 @@ logical function composed_field(fname, fname1, fname2) fname2 = listentry%op_field2 end if else +!jt write(iulog,*)'lens op field1/2=',len_trim(listentry%op_field1),'/',len_trim(listentry%op_field2) composed_field = .false. end if else diff --git a/src/control/cam_history_buffers.F90 b/src/control/cam_history_buffers.F90 index 77cea6cfd6..ae3c927517 100644 --- a/src/control/cam_history_buffers.F90 +++ b/src/control/cam_history_buffers.F90 @@ -112,26 +112,21 @@ end subroutine hbuf_accum_add !####################################################################### - subroutine hbuf_accum_addnsteps (buf8, field, nacs, dimind, idim, flag_xyfill, fillvalue, nsteps) - use time_manager, only: get_nstep + subroutine hbuf_accum_addnsteps (buf8, field, nacs, dimind, idim, flag_xyfill, fillvalue) ! !----------------------------------------------------------------------- ! ! Purpose: Add the values of field to 2-D hbuf. - ! Increment accumulation counter by 1 and nsteps counter by 1 as ! !----------------------------------------------------------------------- ! real(r8), pointer :: buf8(:,:) ! 2-D history buffer integer, pointer :: nacs(:) ! accumulation counter - integer, pointer :: nsteps(:)! nstep accumulation counter integer, intent(in) :: idim ! Longitude dimension of field array logical, intent(in) :: flag_xyfill ! non-applicable xy points flagged with fillvalue real(r8), intent(in ) :: field(idim,*) ! real*8 array type (dim_index_2d), intent(in ) :: dimind ! 2-D dimension index real(r8), intent(in) :: fillvalue - integer, save :: nstep_save - integer :: nstep_curr ! ! Local indices ! @@ -139,7 +134,6 @@ subroutine hbuf_accum_addnsteps (buf8, field, nacs, dimind, idim, flag_xyfill, f integer :: i,k ! indices call dimind%dim_sizes(ieu, jeu) - nstep_curr=get_nstep() if (flag_xyfill) then do k=1,jeu @@ -156,11 +150,6 @@ subroutine hbuf_accum_addnsteps (buf8, field, nacs, dimind, idim, flag_xyfill, f do i=1,ieu if (field(i,1) /= fillvalue) then nacs(i) = nacs(i) + 1 - if (nstep_curr > nstep_save) then - nsteps(i) = nsteps(i) + 1 - nstep_save=nstep_curr - nsteps(i) = 1 - end if end if end do else @@ -170,11 +159,6 @@ subroutine hbuf_accum_addnsteps (buf8, field, nacs, dimind, idim, flag_xyfill, f end do end do nacs(1) = nacs(1) + 1 - if (nstep_curr > nstep_save) then - nsteps(1) = nsteps(1) + 1 - nstep_save=nstep_curr - nsteps(1) = 1 - end if end if return diff --git a/src/control/cam_history_support.F90 b/src/control/cam_history_support.F90 index 466b5c4f78..b77a31bcf9 100644 --- a/src/control/cam_history_support.F90 +++ b/src/control/cam_history_support.F90 @@ -10,7 +10,6 @@ module cam_history_support !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! use shr_kind_mod, only: r8=>shr_kind_r8, shr_kind_cl, shr_kind_cxx - use shr_sys_mod, only: shr_sys_flush use pio, only: var_desc_t, file_desc_t use cam_abortutils, only: endrun use cam_logfile, only: iulog @@ -26,7 +25,7 @@ module cam_history_support integer, parameter, public :: max_string_len = shr_kind_cxx integer, parameter, public :: max_chars = shr_kind_cl ! max chars for char variables integer, parameter, public :: fieldname_len = 32 ! max chars for field name - integer, parameter, public :: fieldname_suffix_len = 3 ! length of field name suffix ("&IC" and "&BG") + integer, parameter, public :: fieldname_suffix_len = 3 ! length of field name suffix ("&IC") integer, parameter, public :: fieldname_lenp2 = fieldname_len + 2 ! allow for extra characters ! max_fieldname_len = max chars for field name (including suffix) integer, parameter, public :: max_fieldname_len = fieldname_len + fieldname_suffix_len @@ -118,7 +117,7 @@ module cam_history_support integer :: meridional_complement ! meridional field id or -1 integer :: zonal_complement ! zonal field id or -1 - character(len=3) :: field_op ! 'sum' or 'dif' + character(len=max_chars) :: field_op = '' ! 'sum' or 'dif' integer :: op_field1_id ! first field id to be summed/diffed or -1 integer :: op_field2_id ! second field id to be summed/diffed or -1 @@ -161,21 +160,24 @@ module cam_history_support type (field_info) :: field ! field information character(len=1) :: avgflag ! averaging flag character(len=max_chars) :: time_op ! time operator (e.g. max, min, avg) + character(len=max_fieldname_len) :: op_field1 ! field1 name for sum/dif operation + character(len=max_fieldname_len) :: op_field2 ! field2 name for sum/dif operation integer :: hwrt_prec ! history output precision real(r8), pointer :: hbuf(:,:,:) => NULL() - real(r8) :: hbuf_area_wgt_integral! area weighted integral of active field field + real(r8) :: hbuf_integral ! area weighted integral of active field real(r8), pointer :: sbuf(:,:,:) => NULL() ! for standard deviation - real(r8), pointer :: gbuf(:,:,:) => NULL() ! pointer to area weights + real(r8), pointer :: wbuf(:,:,:) => NULL() ! pointer to area weights type(var_desc_t), pointer :: varid(:) => NULL() ! variable ids integer, pointer :: nacs(:,:) => NULL() ! accumulation counter type(var_desc_t), pointer :: nacs_varid => NULL() - integer, pointer :: nsteps(:,:) => NULL() ! accumulation counter - type(var_desc_t), pointer :: nsteps_varid=> NULL() + integer :: beg_nstep ! starting time step for nstep normalization + type(var_desc_t), pointer :: beg_nstep_varid=> NULL() type(var_desc_t), pointer :: sbuf_varid => NULL() - type(var_desc_t), pointer :: gbuf_varid => NULL() + type(var_desc_t), pointer :: wbuf_varid => NULL() contains procedure :: get_global => hentry_get_global + procedure :: put_global => hentry_put_global end type hentry !--------------------------------------------------------------------------- @@ -450,7 +452,7 @@ end function field_info_get_dims_3d ! field_info_is_composed: Return whether this field is composed of two other fields logical function field_info_is_composed(this) class(field_info) :: this - field_info_is_composed = (this%field_op=='sum' .or. this%field_op=='dif') + field_info_is_composed = (trim(adjustl(this%field_op))=='sum' .or. trim(adjustl(this%field_op))=='dif') end function field_info_is_composed ! field_info_get_shape: Return a pointer to the field's global shape. @@ -527,7 +529,7 @@ subroutine hentry_get_global(this, gval) class(hentry) :: this real(r8), intent(out) :: gval - gval=this%hbuf_area_wgt_integral + gval=this%hbuf_integral end subroutine hentry_get_global @@ -537,7 +539,7 @@ subroutine hentry_put_global(this, gval) class(hentry) :: this real(r8), intent(in) :: gval - this%hbuf_area_wgt_integral=gval + this%hbuf_integral=gval end subroutine hentry_put_global @@ -689,16 +691,8 @@ subroutine history_patch_write_vals(this, File) type(cam_grid_patch_t), pointer :: patchptr type(var_desc_t), pointer :: vardesc => NULL() ! PIO var desc character(len=128) :: errormsg - character(len=max_chars) :: lat_name - character(len=max_chars) :: lon_name - character(len=max_chars) :: col_name - character(len=max_chars) :: temp_str - integer :: dimid ! PIO dimension ID integer :: num_patches - integer :: temp1, temp2 - integer :: latid, lonid ! Coordinate dims integer :: i - logical :: col_only num_patches = size(this%patches) if (.not. associated(this%header_info)) then diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index 8b3a48bd9f..984bdd8d93 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -47,6 +47,7 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) ! dry air mass. use cam_history, only : hist_fld_active use mpas_constants, only : Rv_over_Rd => rvord + use budgets, only : thermo_budget_history ! arguments type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) @@ -70,9 +71,6 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) real(r8), pointer :: w(:,:) real(r8), pointer :: theta_m(:,:) real(r8), pointer :: tracers(:,:,:) - real(r8), pointer :: budgets(:,:,:)! energy/mass budgets se,ke,wv,liq,ice - integer, pointer :: budgets_cnt(:)! energy/mass budgets se,ke,wv,liq,ice - integer, pointer :: budgets_subcycle_cnt(:)! energy/mass budgets se,ke,wv,liq,ice integer :: lchnk, icol, icol_p, k, kk ! indices over chunks, columns, physics columns and layers integer :: i, m, ncols, blockid integer :: block_index @@ -91,10 +89,7 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) character(len=*), parameter :: subname = 'd_p_coupling' !---------------------------------------------------------------------------- - compute_energy_diags=& - (hist_fld_active('SE_dBF').or.hist_fld_active('SE_dAP').or.hist_fld_active('SE_dAM').or.& - hist_fld_active('KE_dBF').or.hist_fld_active('KE_dAP').or.hist_fld_active('KE_dAM').or.& - hist_fld_active('WV_dBF').or.hist_fld_active('WV_dAP').or.hist_fld_active('WV_dAM')) + compute_energy_diags=thermo_budget_history nCellsSolve = dyn_out % nCellsSolve index_qv = dyn_out % index_qv @@ -109,15 +104,11 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) theta_m => dyn_out % theta_m exner => dyn_out % exner tracers => dyn_out % tracers - budgets => dyn_out % te_budgets - budgets_cnt => dyn_out % budgets_cnt - budgets_subcycle_cnt => dyn_out % budgets_subcycle_cnt if (compute_energy_diags) then call tot_energy(nCellsSolve, plev,size(tracers, 1), index_qv, zz(:,1:nCellsSolve), zint(:,1:nCellsSolve), & rho_zz(:,1:nCellsSolve), theta_m(:,1:nCellsSolve), tracers(:,:,1:nCellsSolve),& - ux(:,1:nCellsSolve),uy(:,1:nCellsSolve),'dBF', & - budgets,budgets_cnt,budgets_subcycle_cnt) + ux(:,1:nCellsSolve),uy(:,1:nCellsSolve),'dBF') end if ! ! diagnose pintdry, pmiddry, pmid @@ -546,9 +537,6 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn integer :: iCell,k character(len=*), parameter :: subname = 'dp_coupling:derived_tend' - real(r8), pointer :: budgets(:,:,:)! energy/mass budgets se,ke,wv,liq,ice - integer, pointer :: budgets_cnt(:)! energy/mass budgets se,ke,wv,liq,ice - integer, pointer :: budgets_subcycle_cnt(:)! energy/mass budgets se,ke,wv,liq,ice !---------------------------------------------------------------------------- nEdges = dyn_in % nEdges @@ -566,9 +554,6 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn rho_zz => dyn_in % rho_zz tracers => dyn_in % tracers index_qv = dyn_in % index_qv - budgets => dyn_in % te_budgets - budgets_cnt => dyn_in % budgets_cnt - budgets_subcycle_cnt => dyn_in % budgets_subcycle_cnt !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Momentum tendency @@ -654,8 +639,7 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn nCellsSolve, plev, size(tracers, 1), index_qv, zz(:,1:nCellsSolve), zint(:,1:nCellsSolve), rho_zz(:,1:nCellsSolve), & theta_m_new, tracers(:,:,1:nCellsSolve), & ux(:,1:nCellsSolve)+dtime*u_tend(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve), & - uy(:,1:nCellsSolve)+dtime*v_tend(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve),'dAP', & - budgets,budgets_cnt,budgets_subcycle_cnt) + uy(:,1:nCellsSolve)+dtime*v_tend(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve),'dAP') ! revert do m=1,thermodynamic_active_species_num idx_dycore = thermodynamic_active_species_idx_dycore(m) @@ -669,8 +653,7 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn nCellsSolve, plev, size(tracers, 1), index_qv, zz(:,1:nCellsSolve), zint(:,1:nCellsSolve), & rho_zz(:,1:nCellsSolve), theta_m_new, tracers(:,:,1:nCellsSolve), & ux(:,1:nCellsSolve)+dtime*u_tend(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve), & - uy(:,1:nCellsSolve)+dtime*v_tend(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve),'dAM', & - budgets,budgets_cnt,budgets_subcycle_cnt) + uy(:,1:nCellsSolve)+dtime*v_tend(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve),'dAM') end if ! ! Update halo for rtheta_m tendency @@ -818,17 +801,18 @@ subroutine hydrostatic_pressure(nCells, nVertLevels, qsize, index_qv, zz, zgrid, end subroutine hydrostatic_pressure -subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, theta_m, q, ux,uy,outfld_name_suffix,te_budgets,budgets_cnt,budgets_subcycle_cnt) +subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, theta_m, q, ux,uy,outfld_name_suffix) use physconst, only: rair, cpair, gravit,cappa!=R/cp (dry air) use mpas_constants, only: p0,cv,rv,rgas,cp use cam_history, only: outfld, hist_fld_active use mpas_constants, only: Rv_over_Rd => rvord use air_composition, only: thermodynamic_active_species_ice_idx_dycore,thermodynamic_active_species_liq_idx_dycore use air_composition, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_liq_num - use budgets, only: budget_array_max,budget_info_byname use cam_thermo, only: wvidx,wlidx,wiidx,seidx,poidx,keidx,moidx,mridx,ttidx,teidx,thermo_budget_num_vars use dyn_tests_utils, only: vcoord=>vc_height - use cam_thermo, only: get_hydrostatic_energy + use cam_thermo, only: get_hydrostatic_energy,wvidx,wlidx,wiidx,seidx,poidx,keidx,moidx,mridx,ttidx,teidx, & + thermo_budget_num_vars,thermo_budget_vars + use cam_history_support, only: max_fieldname_len ! Arguments integer, intent(in) :: nCells integer, intent(in) :: nVertLevels @@ -841,15 +825,11 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t real(r8), dimension(qsize,nVertLevels, nCells), intent(in) :: q ! tracer array real(r8), dimension(nVertLevels, nCells), intent(in) :: ux ! A-grid zonal velocity component real(r8), dimension(nVertLevels, nCells), intent(in) :: uy ! A-grid meridional velocity component - real(r8), dimension(budget_array_max, thermo_budget_num_vars, nCells), intent(inout) :: te_budgets ! energy/mass budget arrays - integer, dimension(budget_array_max), intent(inout) :: budgets_cnt ! budget counts for normalization - integer, dimension(budget_array_max), intent(inout) :: budgets_subcycle_cnt ! budget counts for normalization character*(*), intent(in) :: outfld_name_suffix ! suffix for "outfld" names ! Local variables integer :: iCell, k, idx, idx_tmp - integer :: s_ind,b_ind - logical :: b_subcycle + integer :: i real(r8) :: rho_dz,theta,pk,ptop,exner,dz,rhod real(r8), dimension(nCells,nVertLevels) :: temperature, pdeldry, cp_or_cv, zcell, u, v real(r8), dimension(nCells) :: phis @@ -859,32 +839,27 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t real(r8), dimension(nCells) :: liq !total column integrated liquid real(r8), dimension(nCells) :: ice !total column integrated ice - character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 - - name_out1 = 'SE_' //trim(outfld_name_suffix) - name_out2 = 'KE_' //trim(outfld_name_suffix) - name_out3 = 'WV_' //trim(outfld_name_suffix) - name_out4 = 'WL_' //trim(outfld_name_suffix) - name_out5 = 'WI_' //trim(outfld_name_suffix) - name_out6 = 'PO_' //trim(outfld_name_suffix) - - if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2).or.hist_fld_active(name_out3).or.& - hist_fld_active(name_out4).or.hist_fld_active(name_out5).or.hist_fld_active(name_out6)) then - - kinetic_energy = 0.0_r8 - potential_energy = 0.0_r8 - internal_energy = 0.0_r8 - water_vapor = 0.0_r8 - tracers = 0.0_r8 - - do iCell = 1, nCells - do k = 1, nVertLevels + character(len=max_fieldname_len) :: name_out(thermo_budget_num_vars) + + + do i=1,thermo_budget_num_vars + name_out(i)=trim(thermo_budget_vars(i))//'_'//trim(outfld_name_suffix) + end do + + kinetic_energy = 0.0_r8 + potential_energy = 0.0_r8 + internal_energy = 0.0_r8 + water_vapor = 0.0_r8 + tracers = 0.0_r8 + + do iCell = 1, nCells + do k = 1, nVertLevels dz = zgrid(k+1,iCell) - zgrid(k,iCell) zcell(iCell,k) = 0.5_r8*(zgrid(k,iCell)+zgrid(k+1,iCell))-zgrid(1,iCell) rhod = zz(k,iCell) * rho_zz(k,iCell) theta = theta_m(k,iCell)/(1.0_r8 + Rv_over_Rd *q(index_qv,k,iCell))!convert theta_m to theta exner = (rgas*rhod*theta_m(k,iCell)/p0)**(rgas/cv) - + temperature(iCell,k) = exner*theta pdeldry(iCell,k) = gravit*rhod*dz cp_or_cv(iCell,k) = cv @@ -892,63 +867,24 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t v(iCell,k) = uy(k,iCell) phis(iCell) = zgrid(1,iCell)*gravit do idx=1,thermodynamic_active_species_num - idx_tmp = thermodynamic_active_species_idx_dycore(idx) - tracers(iCell,k,idx_tmp) = q(idx_tmp,k,iCell) + idx_tmp = thermodynamic_active_species_idx_dycore(idx) + tracers(iCell,k,idx_tmp) = q(idx_tmp,k,iCell) end do - end do - enddo - call get_hydrostatic_energy(tracers, .false., pdeldry, cp_or_cv, u, v, temperature, & - vcoord=vcoord, phis = phis, z_mid=zcell, dycore_idx=.true., & - se=internal_energy, po =potential_energy, ke =kinetic_energy, & - wv=water_vapor , liq=liq , ice=ice) - - call outfld(name_out1,internal_energy ,ncells,1) - call outfld(name_out2,kinetic_energy ,ncells,1) - call outfld(name_out3,water_vapor ,ncells,1) - call outfld(name_out6,potential_energy,ncells,1) - - call budget_info_byname(trim(outfld_name_suffix),budget_ind=b_ind,state_ind=s_ind,subcycle=b_subcycle) - ! reset all when cnt is 0 - write(iulog,*)'dpc calc se,ke ',s_ind,',1:3,1 is ',internal_energy(1),' ',kinetic_energy(1) - write(iulog,*)'dpc budgets initial ',s_ind,',1:3,1 is ',te_budgets(s_ind,1,1),' ',te_budgets(s_ind,2,1),' ',te_budgets(s_ind,3,1) - if (budgets_cnt(b_ind) == 0) then - budgets_subcycle_cnt(b_ind) = 0 - te_budgets(s_ind,:,:)=0.0_r8 - end if - if (b_subcycle) then - budgets_subcycle_cnt(b_ind) = budgets_subcycle_cnt(b_ind) + 1 - if (budgets_subcycle_cnt(b_ind) == 1) then - budgets_cnt(b_ind) = budgets_cnt(b_ind) + 1 - end if - else - budgets_cnt(b_ind) = budgets_cnt(b_ind) + 1 - budgets_subcycle_cnt(b_ind) = 1 - !not subcycling so don't sum just replace previous budget values - te_budgets(s_ind,:,:)=0._r8 - end if - - te_budgets(s_ind,teidx,:)=te_budgets(s_ind,teidx,:)+potential_energy+internal_energy+kinetic_energy - te_budgets(s_ind,seidx,:)=te_budgets(s_ind,seidx,:)+internal_energy - te_budgets(s_ind,keidx,:)=te_budgets(s_ind,keidx,:)+kinetic_energy - te_budgets(s_ind,poidx,:)=te_budgets(s_ind,poidx,:)+potential_energy - te_budgets(s_ind,wvidx,:)=te_budgets(s_ind,wvidx,:)+water_vapor - - write(iulog,*)'tot_e te_budget for this proc ',s_ind,',1:3,1 is ',te_budgets(s_ind,1,1),' ',te_budgets(s_ind,2,1),' ',te_budgets(s_ind,3,1) - ! - ! vertical integral of total liquid water - ! - if (hist_fld_active(name_out4)) then - call outfld(name_out4,liq,ncells,1) - te_budgets(s_ind,wlidx,:)=te_budgets(s_ind,wlidx,:)+liq - end if - ! - ! vertical integral of total frozen (ice) water - ! - if (hist_fld_active(name_out5)) then - call outfld(name_out5,ice,ncells,1) - te_budgets(s_ind,wiidx,:)=te_budgets(s_ind,wiidx,:)+ice - end if - end if - end subroutine tot_energy + end do + enddo + call get_hydrostatic_energy(tracers, .false., pdeldry, cp_or_cv, u, v, temperature, & + vcoord=vcoord, phis = phis, z_mid=zcell, dycore_idx=.true., & + se=internal_energy, po =potential_energy, ke =kinetic_energy, & + wv=water_vapor , liq=liq , ice=ice) + + call outfld(name_out(seidx),internal_energy ,ncells,1) + call outfld(name_out(poidx),potential_energy,ncells,1) + call outfld(name_out(keidx),kinetic_energy ,ncells,1) + call outfld(name_out(wvidx),water_vapor ,ncells,1) + call outfld(name_out(wlidx),liq ,ncells,1) + call outfld(name_out(wiidx),ice ,ncells,1) + call outfld(name_out(teidx),potential_energy+internal_energy+kinetic_energy,ncells,1) + +end subroutine tot_energy end module dp_coupling diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index ada3f2ab49..6db3cca9f5 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -9,21 +9,19 @@ module dycore_budget contains !========================================================================================= -subroutine print_budget() +subroutine print_budget(hstwr) - use budgets, only: budget_get_global + use budgets, only: budget_get_global, thermo_budget_histfile_num use spmd_utils, only: masterproc use cam_logfile, only: iulog use cam_abortutils, only: endrun use cam_thermo, only: teidx, thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv + + ! arguments + logical, intent(in) :: hstwr(:) + ! Local variables - integer :: b_ind,s_ind,is1,is2 - logical :: budget_outfld - character(len=64) :: name_out1,name_out2,name_out3,name_out4,name_out5,budget_name,name_out(9) - character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn real(r8),allocatable :: tmp(:,:) - real(r8), pointer :: te_budgets(:,:,:)! energy/mass budgets se,ke,wv,liq,ice - integer, pointer :: budgets_cnt(:) ! budget counts for normalizating sum integer :: i character(len=*), parameter :: subname = 'check_energy:print_budgets' @@ -38,7 +36,7 @@ subroutine print_budget() character(LEN=5) :: pf! pass or fail identifier !-------------------------------------------------------------------------------------- - if (masterproc) then + if (masterproc .and. hstwr(thermo_budget_histfile_num)) then call budget_get_global('phAP-phBP',teidx,ph_param) call budget_get_global('phBP-phBF',teidx,ph_EFIX) call budget_get_global('phAM-phAP',teidx,ph_dmea) diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index 57fbf4fc72..65bc0b797b 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -40,6 +40,7 @@ module dyn_comp use mpas_timekeeping, only : MPAS_TimeInterval_type use cam_mpas_subdriver, only: cam_mpas_global_sum_real +use budgets, only: budget_add implicit none @@ -150,14 +151,6 @@ module dyn_comp ! from physics [kg K/m^3/s] (nver,ncol) real(r8), dimension(:,:), pointer :: rho_tend ! Dry air density tendency ! from physics [kg/m^3/s] (nver,ncol) - ! - ! Energy Budgets - ! - real(r8), dimension(:,:), pointer :: budgets_global ! global averages (budget_array_max,thermo_budget_num_vars) - real(r8), dimension(:,:,:),pointer :: te_budgets ! Energy budgets (budget_array_max,thermo_budget_num_vars,ncells) - integer, dimension(:), pointer :: budgets_cnt ! budget counts (budget_array_max) - integer, dimension(:), pointer :: budgets_subcycle_cnt ! subcycle count (budget_array_max) - end type dyn_import_t type dyn_export_t @@ -224,14 +217,6 @@ module dyn_comp ! (nver,nvtx) real(r8), dimension(:,:), pointer :: divergence ! Horizontal velocity divergence [s^-1] ! (nver,ncol) - ! - ! Energy Budgets - ! - real(r8), dimension(:,:), pointer :: budgets_global ! global averages (budget_array_max,thermo_budget_num_vars) - real(r8), dimension(:,:,:),pointer :: te_budgets ! Energy budgets (budget_array_max,thermo_budget_num_vars,ncells) - integer, dimension(:), pointer :: budgets_cnt ! budget counts (budget_array_max) - integer, dimension(:), pointer :: budgets_subcycle_cnt ! subcycle count (budget_array_max) - end type dyn_export_t real(r8), parameter :: rad2deg = 180.0_r8 / pi @@ -327,8 +312,6 @@ subroutine dyn_init(dyn_in, dyn_out) use air_composition, only : thermodynamic_active_species_liq_num, thermodynamic_active_species_ice_num use cam_mpas_subdriver, only : domain_ptr, cam_mpas_init_phase4 use cam_mpas_subdriver, only : cam_mpas_define_scalars - use cam_thermo, only: thermo_budget_vars, thermo_budget_vars_descriptor, & - thermo_budget_vars_unit, thermo_budget_vars_massv, thermo_budget_num_vars use mpas_pool_routines, only : mpas_pool_get_subpool, mpas_pool_get_array, mpas_pool_get_dimension, & mpas_pool_get_config use mpas_timekeeping, only : MPAS_set_timeInterval @@ -336,7 +319,9 @@ subroutine dyn_init(dyn_in, dyn_out) use mpas_constants, only : mpas_constants_compute_derived use dyn_tests_utils, only : vc_dycore, vc_height, string_vc, vc_str_lgth use constituents, only : cnst_get_ind - use budgets, only : budget_array_max, budget_info, budget_add, budget_num, thermo_budget_history + use phys_control, only: phys_getopts + use budgets, only: thermo_budget_history + ! arguments: type(dyn_import_t), intent(inout) :: dyn_in type(dyn_export_t), intent(inout) :: dyn_out @@ -382,11 +367,6 @@ subroutine dyn_init(dyn_in, dyn_out) integer :: istage, ivars, m character (len=108) :: str1, str2, str3 character (len=vc_str_lgth) :: vc_str - character(len=64) :: budget_name - character(len=128) :: budget_longname - character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn - logical :: budget_outfld - !------------------------------------------------------- vc_dycore = vc_height @@ -497,7 +477,6 @@ subroutine dyn_init(dyn_in, dyn_out) dyn_out % rho => dyn_in % rho dyn_out % ux => dyn_in % ux dyn_out % uy => dyn_in % uy - dyn_out % areaCell => dyn_in % areaCell allocate(dyn_out % pmiddry(nVertLevels, nCells), stat=ierr) if( ierr /= 0 ) call endrun(subname//': failed to allocate dyn_out%pmiddry array') @@ -505,23 +484,6 @@ subroutine dyn_init(dyn_in, dyn_out) allocate(dyn_out % pintdry(nVertLevels+1, nCells), stat=ierr) if( ierr /= 0 ) call endrun(subname//': failed to allocate dyn_out%pintdry array') - allocate(dyn_out % te_budgets(budget_array_max, thermo_budget_num_vars, nCellsSolve), stat=ierr) - if( ierr /= 0 ) call endrun(subname//': failed to allocate dyn_out%budgets') - - allocate(dyn_out % budgets_cnt(budget_array_max), stat=ierr) - if( ierr /= 0 ) call endrun(subname//': failed to allocate dyn_out%budgets') - - allocate(dyn_out % budgets_subcycle_cnt(budget_array_max), stat=ierr) - if( ierr /= 0 ) call endrun(subname//': failed to allocate dyn_out%budgets') - - allocate(dyn_out % budgets_global(budget_array_max,thermo_budget_num_vars), stat=ierr) - if( ierr /= 0 ) call endrun(subname//': failed to allocate dyn_out%budgets') - - dyn_in % te_budgets => dyn_out % te_budgets - dyn_in % budgets_global => dyn_out % budgets_global - dyn_in % budgets_cnt => dyn_out % budgets_cnt - dyn_in % budgets_subcycle_cnt => dyn_out % budgets_subcycle_cnt - call mpas_pool_get_array(diag_pool, 'vorticity', dyn_out % vorticity) call mpas_pool_get_array(diag_pool, 'divergence', dyn_out % divergence) @@ -574,68 +536,48 @@ subroutine dyn_init(dyn_in, dyn_out) ! ! initialize history for MPAS energy budgets - ! call addfld for every thermo_budget_category and stage as well as calling add_budget for each stage - ! - do istage = 1, num_stages - do ivars=1, thermo_budget_num_vars - write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stage(istage))) - write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & - TRIM(ADJUSTL(stage_txt(istage))) - write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), gridname='mpas_cell') - end do - ! Register stages for budgets - call budget_add(TRIM(ADJUSTL(stage(istage))), pkgtype='dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) - end do + if (thermo_budget_history) then + ! Register stages for budgets + + do istage = 1, num_stages + call budget_add(TRIM(ADJUSTL(stage(istage))), 'dyn', longname=TRIM(ADJUSTL(stage_txt(istage)))) + end do + + ! + ! initialize MPAS energy budgets + ! add budgets that are derived from stages + ! + + call budget_add('mpas_param','dAP','dBF',pkgtype='dyn',optype='dif',longname="dE/dt parameterizations+efix in dycore (dparam)(dAP-dBF)") + call budget_add('mpas_dmea' ,'dAM','dAP',pkgtype='dyn',optype='dif',longname="dE/dt dry mass adjustment in dycore (dAM-dAP)") + call budget_add('mpas_phys_total' ,'dAM','dBF',pkgtype='dyn',optype='dif',longname="dE/dt physics total in dycore (phys) (dAM-dBF)") + end if + ! ! initialize CAM thermodynamic infrastructure ! do m=1,thermodynamic_active_species_num - thermodynamic_active_species_idx_dycore(m) = dyn_out % cam_from_mpas_cnst(thermodynamic_active_species_idx(m)) - if (masterproc) then - write(iulog,'(a,2I4)') subname//": m,thermodynamic_active_species_idx_dycore: ",m,thermodynamic_active_species_idx_dycore(m) - end if + thermodynamic_active_species_idx_dycore(m) = dyn_out % cam_from_mpas_cnst(thermodynamic_active_species_idx(m)) + if (masterproc) then + write(iulog,'(a,2I4)') subname//": m,thermodynamic_active_species_idx_dycore: ",m,thermodynamic_active_species_idx_dycore(m) + end if end do do m=1,thermodynamic_active_species_liq_num - thermodynamic_active_species_liq_idx_dycore(m) = dyn_out % cam_from_mpas_cnst(thermodynamic_active_species_liq_idx(m)) - if (masterproc) then - write(iulog,'(a,2I4)') subname//": m,thermodynamic_active_species_idx_liq_dycore: ",m,thermodynamic_active_species_liq_idx_dycore(m) - end if + thermodynamic_active_species_liq_idx_dycore(m) = dyn_out % cam_from_mpas_cnst(thermodynamic_active_species_liq_idx(m)) + if (masterproc) then + write(iulog,'(a,2I4)') subname//": m,thermodynamic_active_species_idx_liq_dycore: ",m,thermodynamic_active_species_liq_idx_dycore(m) + end if end do do m=1,thermodynamic_active_species_ice_num - thermodynamic_active_species_ice_idx_dycore(m) = dyn_out % cam_from_mpas_cnst(thermodynamic_active_species_ice_idx(m)) - if (masterproc) then - write(iulog,'(a,2I4)') subname//": m,thermodynamic_active_species_idx_ice_dycore: ",m,thermodynamic_active_species_ice_idx_dycore(m) - end if + thermodynamic_active_species_ice_idx_dycore(m) = dyn_out % cam_from_mpas_cnst(thermodynamic_active_species_ice_idx(m)) + if (masterproc) then + write(iulog,'(a,2I4)') subname//": m,thermodynamic_active_species_idx_ice_dycore: ",m,thermodynamic_active_species_ice_idx_dycore(m) + end if end do - - ! - ! initialize MPAS energy budgets - ! add budgets that are derived from stages - ! - - call budget_add('mpas_param','dAP','dBF',pkgtype='dyn',optype='dif',longname="dE/dt parameterizations+efix in dycore (dparam)(dAP-dBF)",outfld=.false.) - call budget_add('mpas_dmea' ,'dAM','dAP',pkgtype='dyn',optype='dif',longname="dE/dt dry mass adjustment in dycore (dAM-dAP)",outfld=.false.) - call budget_add('mpas_phys_total' ,'dAM','dBF',pkgtype='dyn',optype='dif',longname="dE/dt physics total in dycore (phys) (dAM-dBF)",outfld=.false.) - ! call addfield for budget diff/sum that we just added above - if (thermo_budget_history) then - do m=1,budget_num - call budget_info(m,name=budget_name,longname=budget_longname,pkgtype=budget_pkgtype,optype=budget_optype) - if (trim(budget_pkgtype)=='dyn'.and.(trim(budget_optype)=='dif'.or.trim(budget_optype)=='sum')) then - do ivars=1, thermo_budget_num_vars - write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(budget_name)) - write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & - TRIM(ADJUSTL(budget_longname)) - write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='mpas_cell') - end do - end if - end do - end if end subroutine dyn_init - + !========================================================================================= subroutine dyn_run(dyn_in, dyn_out) @@ -644,7 +586,6 @@ subroutine dyn_run(dyn_in, dyn_out) use cam_mpas_subdriver, only : domain_ptr use mpas_pool_routines, only : mpas_pool_get_subpool, mpas_pool_get_array use mpas_derived_types, only : mpas_pool_type - use budgets, only : budget_write ! Advances the dynamics state provided in dyn_in by one physics ! timestep to produce dynamics state held in dyn_out. @@ -675,157 +616,8 @@ subroutine dyn_run(dyn_in, dyn_out) dyn_out % rho_zz => dyn_in % rho_zz dyn_out % tracers => dyn_in % tracers - ! update energy budgets calculated from snapshots (stages) - - dtime = get_step_size() - if(budget_write(step_offset=nint(dtime))) then - call budget_update(dyn_in%nCellsSolve,dyn_out) - else - call budget_update_dyn_cnts(dyn_in%nCellsSolve,dyn_out) - end if end subroutine dyn_run -subroutine budget_update(nCells,dyn_out) - - use cam_thermo, only : thermo_budget_num_vars,thermo_budget_vars_massv,wvidx,wlidx,wiidx,seidx,keidx,poidx,moidx,mridx,ttidx,teidx - use budgets, only : budget_num, budget_info, budget_put_global - use air_composition, only : thermodynamic_active_species_liq_num, thermodynamic_active_species_ice_num - - ! arguments - integer, intent(in) :: nCells ! Number of cells, including halo cells - type (dyn_export_t), intent(in) :: dyn_out - - ! Local variables - real(r8), pointer :: te_budgets(:,:,:) ! energy/mass budgets se,ke,wv,liq,ice - integer, pointer :: budgets_cnt(:) ! budget counts for normalizating sum - integer, pointer :: budgets_subcycle_cnt(:) ! budget counts for normalizating sum - integer :: b_ind,s_ind,is1,is2,i - logical :: budget_outfld - character(len=64) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6,name_out7,budget_name - character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn - real(r8) :: tmp(thermo_budget_num_vars,nCells) - real(r8), pointer :: areaCell(:) ! cell area (m^2) - real(r8), pointer :: budgets_global(:,:) - real(r8) :: dtime - real(r8) :: sphere_surface_area - real(r8), dimension(:) :: glob(nCells,thermo_budget_num_vars) - - !-------------------------------------------------------------------------------------- - - te_budgets => dyn_out % te_budgets - budgets_cnt => dyn_out % budgets_cnt - budgets_subcycle_cnt => dyn_out % budgets_subcycle_cnt - - do b_ind=1,budget_num - call budget_info(b_ind,optype=budget_optype, pkgtype=budget_pkgtype,state_ind=s_ind,outfld=budget_outfld,name=budget_name) - if (budget_pkgtype=='dyn') then - if (budget_optype /= 'stg') then - call budget_info(b_ind,stg1stateidx=is1, stg2stateidx=is2) - if (budget_optype=='dif') then - te_budgets(s_ind,:,:)=(te_budgets(is1,:,:)-te_budgets(is2,:,:)) - else if (budget_optype=='sum') then - te_budgets(s_ind,:,:)=(te_budgets(is1,:,:)+te_budgets(is2,:,:)) - end if - ! - ! Output energy diagnostics - ! -!jt if (budget_outfld) then - name_out1 = 'SE_' //trim(budget_name) - name_out2 = 'KE_' //trim(budget_name) - name_out3 = 'WV_' //trim(budget_name) - name_out4 = 'WL_' //trim(budget_name) - name_out5 = 'WI_' //trim(budget_name) - name_out6 = 'PO_' //trim(budget_name) - name_out7 = 'TE_' //trim(budget_name) - call outfld(name_out1, te_budgets(s_ind,seidx,:), nCells, 1) - call outfld(name_out2, te_budgets(s_ind,keidx,:), nCells, 1) - call outfld(name_out6, te_budgets(s_ind,poidx,:), nCells, 1) - call outfld(name_out7, te_budgets(s_ind,teidx,:), nCells, 1) - ! - ! sum over vapor - call outfld(name_out3, te_budgets(s_ind,wvidx,:), nCells, 1) - ! - ! sum over liquid water - if (thermodynamic_active_species_liq_num>0) & - call outfld(name_out4, te_budgets(s_ind,wlidx,:), nCells, 1) - ! - ! sum over ice water - if (thermodynamic_active_species_ice_num>0) & - call outfld(name_out5, te_budgets(s_ind,wiidx,:), nCells, 1) -!jt end if - budgets_cnt(b_ind)=budgets_cnt(b_ind)+1 - end if - end if - end do - - areaCell => dyn_out % areaCell - budgets_global => dyn_out % budgets_global - - ! Get CAM time step - dtime = get_step_size() - - do b_ind=1,budget_num - call budget_info(b_ind,name=budget_name,pkgtype=budget_pkgtype,optype=budget_optype,state_ind=s_ind) - if (budget_pkgtype=='dyn') then - ! Normalize energy sums and convert to W/s - ! (3) compute average global integrals of budgets - sphere_surface_area = cam_mpas_global_sum_real(areaCell(1:nCells)) - do i=1,thermo_budget_num_vars - glob(1:nCells,i) = te_budgets(s_ind,i,1:nCells)*areaCell(1:nCells)/sphere_surface_area - budgets_global(b_ind,i) = cam_mpas_global_sum_real(glob(1:nCells,i))/budgets_cnt(b_ind) - ! divide by time for proper units if not a mass budget. - if (.not.thermo_budget_vars_massv(i)) & - budgets_global(b_ind,i)=budgets_global(b_ind,i)/dtime - if (masterproc) & - write(iulog,*)"putting global ",trim(budget_name)," m_cnst=",i," ",budgets_global(b_ind,i)," cnt=",budgets_cnt(b_ind),budgets_subcycle_cnt(b_ind) - call budget_put_global(trim(budget_name),i,budgets_global(b_ind,i)) - end do - ! reset dyn budget states and counts - te_budgets(s_ind,:,:)=0._r8 - budgets_cnt(b_ind)=0 - budgets_subcycle_cnt(b_ind)=0 - end if - end do - -end subroutine budget_update -!========================================================================================= -subroutine budget_update_dyn_cnts(nCells,dyn_out) - - use budgets, only : budget_num, budget_info - - ! arguments - integer, intent(in) :: nCells ! Number of cells, including halo cells - type (dyn_export_t), intent(in) :: dyn_out - - ! Local variables - integer, pointer :: budgets_cnt(:) ! budget counts for normalizating sum - integer, pointer :: budgets_subcycle_cnt(:) ! budget subcycle counts - integer :: b_ind,s_ind - logical :: budget_outfld - character(len=64) :: budget_name - character(len=3) :: budget_pkgtype,budget_optype ! budget type phy or dyn - - !-------------------------------------------------------------------------------------- - -!jt if (thermo_budget_history) then - budgets_cnt => dyn_out % budgets_cnt - budgets_subcycle_cnt => dyn_out % budgets_subcycle_cnt - - - do b_ind=1,budget_num - call budget_info(b_ind,optype=budget_optype, pkgtype=budget_pkgtype,state_ind=s_ind,outfld=budget_outfld,name=budget_name) - if (budget_pkgtype=='dyn') then - ! subcycle cnt reset when cnt advanced, subcycles increase between cnts - budgets_subcycle_cnt(b_ind)=0 - ! need to update dif and sum budget_counts for normalization, stage cnt updates are done in tot_energy - if (budget_optype=='dif'.or.budget_optype=='sum') & - budgets_cnt(b_ind)=budgets_cnt(b_ind)+1 - end if - end do -!jt end if - -end subroutine budget_update_dyn_cnts -!========================================================================================= subroutine dyn_final(dyn_in, dyn_out) @@ -903,7 +695,6 @@ subroutine dyn_final(dyn_in, dyn_out) nullify(dyn_out % uy) deallocate(dyn_out % pmiddry) deallocate(dyn_out % pintdry) - deallocate(dyn_out % te_budgets) nullify(dyn_out % vorticity) nullify(dyn_out % divergence) diff --git a/src/dynamics/mpas/dyn_grid.F90 b/src/dynamics/mpas/dyn_grid.F90 index c8efc66123..3fbed4890f 100644 --- a/src/dynamics/mpas/dyn_grid.F90 +++ b/src/dynamics/mpas/dyn_grid.F90 @@ -545,6 +545,7 @@ subroutine define_cam_grids() real(r8), dimension(:), pointer :: latCell ! cell center latitude (radians) real(r8), dimension(:), pointer :: lonCell ! cell center longitude (radians) real(r8), dimension(:), pointer :: areaCell ! cell areas in m^2 + real(r8), dimension(:), pointer :: areaWeight! normalized cell areas weights integer, dimension(:), pointer :: indexToEdgeID ! global indices of edge nodes real(r8), dimension(:), pointer :: latEdge ! edge node latitude (radians) @@ -555,6 +556,13 @@ subroutine define_cam_grids() real(r8), dimension(:), pointer :: lonVertex ! vertex node longitude (radians) integer :: ierr character(len=*), parameter :: subname = 'dyn_grid::define_cam_grids' + integer :: hdim1_d ! Global Longitudes or global grid size (nCells_g) + integer :: hdim2_d ! Latitudes or 1 for unstructured grids + integer :: num_levels ! Number of levels + integer :: index_model_top_layer + integer :: index_surface_layer + logical :: unstructured + type (physics_column_t), allocatable :: dyn_cols(:) !---------------------------------------------------------------------------- call mpas_pool_get_subpool(domain_ptr % blocklist % structs, 'mesh', meshPool) @@ -578,6 +586,13 @@ subroutine define_cam_grids() lon_coord => horiz_coord_create('lonCell', 'nCells', nCells_g, 'longitude', & 'degrees_east', 1, nCellsSolve, lonCell(1:nCellsSolve)*rad2deg, map=gidx) + allocate(areaWeight(nCellsSolve), stat=ierr) + if( ierr /= 0 ) call endrun(subname//':failed to allocate area_weight :'//int2str(__LINE__)) +!jt allocate(dyn_cols(nCellsSolve), stat=ierr) +!jt if( ierr /= 0 ) call endrun(subname//':failed to allocate dyn_columns :'//int2str(__LINE__)) + call get_dyn_grid_info(hdim1_d, hdim2_d, num_levels, index_model_top_layer, index_surface_layer, unstructured, dyn_cols) + + ! Map for cell centers grid allocate(grid_map(3, nCellsSolve), stat=ierr) if( ierr /= 0 ) call endrun(subname//':failed to allocate grid_map array at line:'//int2str(__LINE__)) @@ -586,11 +601,19 @@ subroutine define_cam_grids() grid_map(1, i) = i grid_map(2, i) = 1 grid_map(3, i) = gidx(i) + areaWeight(i) = dyn_cols(i)%weight end do ! cell center grid for I/O using MPAS names call cam_grid_register('mpas_cell', dyn_decomp, lat_coord, lon_coord, & grid_map, block_indexed=.false., unstruct=.true.) + call cam_grid_attribute_register('mpas_cell', 'area_cell', 'mpas cell areas', & + 'nCells', areaCell, map=gidx) + call cam_grid_attribute_register('mpas_cell', 'area_weight_mpas', 'mpas area weight', & + 'nCells', areaWeight, map=gidx) + + nullify(areaWeight) ! areaWeight belongs to grid now + nullify(areaCell) ! areaCell belongs to grid now ! create new coordinates and grid using CAM names lat_coord => horiz_coord_create('lat', 'ncol', nCells_g, 'latitude', & @@ -603,6 +626,8 @@ subroutine define_cam_grids() ! gidx can be deallocated. Values are copied into the coordinate and attribute objects. deallocate(gidx) + deallocate(dyn_cols) + ! grid_map memory cannot be deallocated. The cam_filemap_t object just points ! to it. Pointer can be disassociated. nullify(grid_map) ! Map belongs to grid now diff --git a/src/dynamics/se/dycore/global_norms_mod.F90 b/src/dynamics/se/dycore/global_norms_mod.F90 index 4ec5143e34..5551d813e7 100644 --- a/src/dynamics/se/dycore/global_norms_mod.F90 +++ b/src/dynamics/se/dycore/global_norms_mod.F90 @@ -35,7 +35,7 @@ module global_norms_mod subroutine global_integrals(elem, h,hybrid,npts,num_flds,nets,nete,I_sphere) use hybrid_mod, only: hybrid_t use element_mod, only: element_t - use dimensions_mod, only: np, nelemd + use dimensions_mod, only: np use physconst, only: pi use parallel_mod, only: global_shared_buf, global_shared_sum @@ -46,7 +46,6 @@ subroutine global_integrals(elem, h,hybrid,npts,num_flds,nets,nete,I_sphere) real (kind=r8) :: I_sphere(num_flds) - real (kind=r8) :: I_priv real (kind=r8) :: I_shared common /gblintcom/I_shared ! @@ -84,7 +83,6 @@ end subroutine global_integrals subroutine global_integrals_general(h,hybrid,npts,da,num_flds,nets,nete,I_sphere) use hybrid_mod, only: hybrid_t - use dimensions_mod, only: nc, nelemd use physconst, only: pi use parallel_mod, only: global_shared_buf, global_shared_sum @@ -95,7 +93,6 @@ subroutine global_integrals_general(h,hybrid,npts,da,num_flds,nets,nete,I_sphere real (kind=r8) :: I_sphere(num_flds) - real (kind=r8) :: I_priv real (kind=r8) :: I_shared common /gblintcom/I_shared ! @@ -141,7 +138,7 @@ end subroutine global_integrals_general function global_integral_elem(elem, h,hybrid,npts,nets,nete) result(I_sphere) use hybrid_mod, only: hybrid_t use element_mod, only: element_t - use dimensions_mod, only: np, nelemd + use dimensions_mod, only: np use physconst, only: pi use parallel_mod, only: global_shared_buf, global_shared_sum @@ -152,7 +149,6 @@ function global_integral_elem(elem, h,hybrid,npts,nets,nete) result(I_sphere) real (kind=r8) :: I_sphere - real (kind=r8) :: I_priv real (kind=r8) :: I_shared common /gblintcom/I_shared @@ -203,7 +199,6 @@ function global_integral_fvm(fvm, h,hybrid,npts,nets,nete) result(I_sphere) real (kind=r8) :: I_sphere - real (kind=r8) :: I_priv real (kind=r8) :: I_shared common /gblintcom/I_shared @@ -261,23 +256,22 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& ! worse viscosity CFL (given by dtnu) is not violated by reducing ! viscosity coefficient in regions where CFL is violated ! - use hybrid_mod, only: hybrid_t, PrintHybrid + use hybrid_mod, only: hybrid_t use element_mod, only: element_t - use dimensions_mod, only: np,ne,nelem,nelemd,nc,nhe,qsize,ntrac,nlev,large_Courant_incr + use dimensions_mod, only: np,ne,nelem,nc,nhe,ntrac,nlev,large_Courant_incr use dimensions_mod, only: nu_scale_top,nu_div_lev,nu_lev,nu_t_lev use quadrature_mod, only: gausslobatto, quadrature_t use reduction_mod, only: ParallelMin,ParallelMax use physconst, only: ra, rearth, pi - use control_mod, only: nu, nu_div, nu_q, nu_p, nu_t, nu_top, fine_ne, rk_stage_user, max_hypervis_courant + use control_mod, only: nu, nu_div, nu_q, nu_p, nu_t, nu_top, fine_ne, max_hypervis_courant use control_mod, only: tstep_type, hypervis_power, hypervis_scaling use control_mod, only: sponge_del4_nu_div_fac, sponge_del4_nu_fac, sponge_del4_lev use cam_abortutils, only: endrun use parallel_mod, only: global_shared_buf, global_shared_sum use edge_mod, only: initedgebuffer, FreeEdgeBuffer, edgeVpack, edgeVunpack use bndry_mod, only: bndry_exchange - use time_mod, only: tstep use mesh_mod, only: MeshUseMeshFile use dimensions_mod, only: ksponge_end, kmvis_ref, kmcnd_ref,rho_ref use physconst, only: cpair @@ -303,8 +297,8 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& real (kind=r8) :: x, y, noreast, nw, se, sw real (kind=r8), dimension(np,np,nets:nete) :: zeta real (kind=r8) :: lambda_max, lambda_vis, min_gw, lambda,umax, ugw - real (kind=r8) :: scale1,scale2,scale3, max_laplace,z(nlev) - integer :: ie,corner, i, j, rowind, colind, k + real (kind=r8) :: scale1, max_laplace,z(nlev) + integer :: ie, i, j, rowind, colind, k type (quadrature_t) :: gp character(LEN=256) :: rk_str diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index b1905b411f..d29e40ed66 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -57,9 +57,9 @@ subroutine prim_advance_exp(elem, fvm, deriv, hvcoord, hybrid,dt, tl, nets, net use dimensions_mod, only: lcp_moist use fvm_control_volume_mod, only: fvm_struct use cam_thermo, only: get_kappa_dry - use air_composition, only: thermodynamic_active_species_num, dry_air_species_num + use air_composition, only: thermodynamic_active_species_num use air_composition, only: thermodynamic_active_species_idx_dycore, get_cp - use physconst, only: cpair, rair + use physconst, only: cpair implicit none type (element_t), intent(inout), target :: elem(:) @@ -74,7 +74,6 @@ subroutine prim_advance_exp(elem, fvm, deriv, hvcoord, hybrid,dt, tl, nets, net ! Local real (kind=r8) :: dt_vis, eta_ave_w - real (kind=r8) :: dp(np,np) integer :: ie,nm1,n0,np1,k,qn0,m_cnst, nq real (kind=r8) :: inv_cp_full(np,np,nlev,nets:nete) real (kind=r8) :: qwater(np,np,nlev,thermodynamic_active_species_num,nets:nete) @@ -446,11 +445,11 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, ! For correct scaling, dt2 should be the same 'dt2' used in the leapfrog advace ! ! - use physconst, only: gravit, cappa, cpair, tref, lapse_rate + use physconst, only: cappa, cpair use cam_thermo, only: get_molecular_diff_coef, get_rho_dry use dimensions_mod, only: np, nlev, nc, ntrac, npsq, qsize, ksponge_end use dimensions_mod, only: nu_scale_top,nu_lev,kmvis_ref,kmcnd_ref,rho_ref,km_sponge_factor - use dimensions_mod, only: kmvisi_ref,kmcndi_ref,nu_t_lev + use dimensions_mod, only: nu_t_lev use control_mod, only: nu, nu_t, hypervis_subcycle,hypervis_subcycle_sponge, nu_p, nu_top use control_mod, only: molecular_diff use hybrid_mod, only: hybrid_t!, get_loop_ranges @@ -489,16 +488,13 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, type (EdgeDescriptor_t) :: desc real (kind=r8), dimension(np,np) :: lap_t,lap_dp - real (kind=r8), dimension(np,np) :: tmp, tmp2 real (kind=r8), dimension(np,np,ksponge_end,nets:nete):: kmvis,kmcnd,rho_dry - real (kind=r8), dimension(np,np,ksponge_end+1):: kmvisi,kmcndi real (kind=r8), dimension(np,np,nlev) :: tmp_kmvis,tmp_kmcnd real (kind=r8), dimension(np,np,2) :: lap_v - real (kind=r8) :: v1,v2,v1new,v2new,dt,heating,T0,T1 + real (kind=r8) :: v1,v2,v1new,v2new,dt,heating real (kind=r8) :: laplace_fluxes(nc,nc,4) real (kind=r8) :: rhypervis_subcycle real (kind=r8) :: nu_ratio1, ptop, inv_rho - real (kind=r8), dimension(ksponge_end) :: dtemp,du,dv real (kind=r8) :: nu_temp, nu_dp, nu_velo if (nu_t == 0 .and. nu == 0 .and. nu_p==0 ) return; @@ -516,7 +512,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! do ic=1,hypervis_subcycle - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dBH',subcycle=.true.) + call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dBH') rhypervis_subcycle=1.0_r8/real(hypervis_subcycle,kind=r8) call biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend,hvcoord) @@ -676,7 +672,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, enddo end do - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dCH',subcycle=.true.) + call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dCH') do ie=nets,nete !$omp parallel do num_threads(vert_num_threads), private(k,i,j,v1,v2,heating) do k=kbeg,kend @@ -696,7 +692,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, enddo enddo enddo - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dAH',subcycle=.true.) + call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dAH') end do ! @@ -771,7 +767,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, ! Horizontal Laplacian diffusion ! dt=dt2/hypervis_subcycle_sponge - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dBS',subcycle=.true.) + call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dBS') kblk = ksponge_end do ic=1,hypervis_subcycle_sponge rhypervis_subcycle=1.0_r8/real(hypervis_subcycle_sponge,kind=r8) @@ -957,7 +953,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, end do end do call t_stopf('sponge_diff') - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dAS',subcycle=.true.) + call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dAS') end subroutine advance_hypervis_dp @@ -983,7 +979,7 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& ! allows us to fuse these two loops for more cache reuse ! ! =================================== - use dimensions_mod, only: np, nc, nlev, ntrac, ksponge_end + use dimensions_mod, only: np, nc, nlev, ntrac use hybrid_mod, only: hybrid_t use element_mod, only: element_t use derivative_mod, only: derivative_t, divergence_sphere, gradient_sphere, vorticity_sphere @@ -992,12 +988,10 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& use edgetype_mod, only: edgedescriptor_t use bndry_mod, only: bndry_exchange use hybvcoord_mod, only: hvcoord_t - use physconst, only: epsilo use cam_thermo, only: get_gz, get_virtual_temp use air_composition, only: thermodynamic_active_species_num, dry_air_species_num - use air_composition, only: thermodynamic_active_species_idx_dycore, get_cp_dry, get_R_dry + use air_composition, only: get_cp_dry, get_R_dry use physconst, only: tref,cpair,gravit,lapse_rate - use time_mod, only : tevolve implicit none integer, intent(in) :: np1,nm1,n0,nets,nete @@ -1028,9 +1022,7 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& real (kind=r8), dimension(np,np) :: vgrad_T ! v.grad(T) real (kind=r8), dimension(np,np) :: Ephi ! kinetic energy + PHI term real (kind=r8), dimension(np,np,2,nlev) :: grad_p_full - real (kind=r8), dimension(np,np,2,nlev) :: grad_p_m_pmet! gradient(p - p_met) real (kind=r8), dimension(np,np,nlev) :: vort ! vorticity - real (kind=r8), dimension(np,np,nlev) :: p_dry ! pressure dry real (kind=r8), dimension(np,np,nlev) :: dp_dry ! delta pressure dry real (kind=r8), dimension(np,np,nlev) :: R_dry, cp_dry! real (kind=r8), dimension(np,np,nlev) :: p_full ! pressure @@ -1053,7 +1045,7 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& real (kind=r8) :: sum_water(np,np,nlev), density_inv(np,np) real (kind=r8) :: E,v1,v2,glnps1,glnps2 integer :: i,j,k,kptr,ie - real (kind=r8) :: u_m_umet, v_m_vmet, t_m_tmet, ptop + real (kind=r8) :: ptop !JMD call t_barrierf('sync_compute_and_apply_rhs', hybrid%par%comm) call t_adj_detailf(+1) @@ -1447,17 +1439,17 @@ subroutine distribute_flux_at_corners(cflux, corners, getmapP) endif end subroutine distribute_flux_at_corners - subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suffix, subcycle) + subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suffix) use dimensions_mod, only: npsq,nlev,np,lcp_moist,nc,ntrac,qsize use physconst, only: gravit, cpair, rearth, omega use element_mod, only: element_t - use cam_history, only: outfld, hist_fld_active + use cam_history, only: outfld use cam_history_support, only: max_fieldname_len use constituents, only: cnst_get_ind use string_utils, only: strlist_get_ind use hycoef, only: hyai, ps0 use fvm_control_volume_mod, only: fvm_struct - use cam_thermo, only: get_dp, MASS_MIXING_RATIO,wvidx,wlidx,wiidx,seidx,poidx,keidx,moidx,mridx,ttidx,teidx, & + use cam_thermo, only: get_dp, MASS_MIXING_RATIO,wvidx,wlidx,wiidx,seidx,keidx,moidx,mridx,ttidx,teidx, & thermo_budget_num_vars,thermo_budget_vars use cam_thermo, only: get_hydrostatic_energy use air_composition, only: thermodynamic_active_species_idx_dycore, get_cp @@ -1465,17 +1457,14 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf use air_composition, only: thermodynamic_active_species_liq_num,thermodynamic_active_species_liq_idx use air_composition, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_ice_idx use dimensions_mod, only: cnst_name_gll - use cam_logfile, only: iulog - use spmd_utils, only: masterproc - use time_manager, only: get_step_size use dyn_tests_utils, only: vcoord=>vc_dry_pressure + use budgets, only: thermo_budget_history !------------------------------Arguments-------------------------------- type (element_t) , intent(inout) :: elem(:) type(fvm_struct) , intent(inout) :: fvm(:) integer , intent(in) :: tl, tl_qdp,nets,nete character*(*) , intent(in) :: outfld_name_suffix ! suffix for "outfld" names - logical, optional, intent(in) :: subcycle ! true if called inside subcycle loop !---------------------------Local storage------------------------------- @@ -1493,7 +1482,6 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf real(kind=r8) :: pdel(np,np,nlev) real(kind=r8) :: cp(np,np,nlev) - real(kind=r8) :: dtime ! time_step ! ! global axial angular momentum (AAM) can be separated into one part (mr) associatedwith the relative motion ! of the atmosphere with respect to the planets surface (also known as wind AAM) and another part (mo) @@ -1504,18 +1492,17 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf real(kind=r8) :: mo(npsq) ! mass AAM real(kind=r8) :: mr_cnst, mo_cnst, cos_lat, mr_tmp, mo_tmp - integer :: ie,i,j,k,budget_ind,state_ind,idx,idx_tmp + integer :: ie,i,j,k,idx,idx_tmp integer :: ixwv,ixcldice, ixcldliq, ixtt ! CLDICE, CLDLIQ and test tracer indices character(len=max_fieldname_len) :: name_out(thermo_budget_num_vars) !----------------------------------------------------------------------- + if (thermo_budget_history) then do i=1,thermo_budget_num_vars name_out(i)=trim(thermo_budget_vars(i))//'_'//trim(outfld_name_suffix) end do - dtime=get_step_size() - if (ntrac>0) then ixwv = 1 call cnst_get_ind('CLDLIQ' , ixcldliq, abort=.false.) @@ -1555,15 +1542,12 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf phis=elem(ie)%state%phis(:,j),dycore_idx=.true., & se=se(:,j), po=po(:,j), ke=ke(:,j), wv=wv(:,j), liq=liq(:,j), ice=ice(:,j)) end do - ! - ! Normalize energy variables by dtime for W/s -!jt se(:)=se(:)/dtime -!jt ke(:)=ke(:)/dtime ! ! Output energy diagnostics on GLL grid ! call outfld(name_out(seidx) ,se ,npsq,ie) call outfld(name_out(keidx) ,ke ,npsq,ie) + call outfld(name_out(teidx) ,ke+se+po ,npsq,ie) ! ! mass variables are output on CSLAM grid if using CSLAM else GLL grid ! @@ -1657,8 +1641,6 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf mr_tmp = mr_cnst*elem(ie)%state%v(i,j,1,k,tl)*pdel(i,j,k)*cos_lat mo_tmp = mo_cnst*pdel(i,j,k)*cos_lat**2 -!jt mr (i+(j-1)*np) = mr (i+(j-1)*np) + mr_tmp/dtime -!jt mo (i+(j-1)*np) = mo (i+(j-1)*np) + mo_tmp/dtime mr (i+(j-1)*np) = mr (i+(j-1)*np) + mr_tmp mo (i+(j-1)*np) = mo (i+(j-1)*np) + mo_tmp end do @@ -1667,14 +1649,14 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf call outfld(name_out(mridx) ,mr ,npsq,ie) call outfld(name_out(moidx) ,mo ,npsq,ie) end do - + endif ! if thermo budget history end subroutine calc_tot_energy_dynamics subroutine output_qdp_var_dynamics(qdp,nx,num_trac,nets,nete,outfld_name) - use dimensions_mod, only: nlev,ntrac - use cam_history , only: outfld, hist_fld_active + use dimensions_mod, only: nlev + use cam_history , only: hist_fld_active use constituents , only: cnst_get_ind !------------------------------Arguments-------------------------------- @@ -1748,7 +1730,6 @@ subroutine compute_omega(hybrid,n0,qn0,elem,deriv,nets,nete,dt,hvcoord) use bndry_mod, only: bndry_exchange use viscosity_mod, only: biharmonic_wk_omega use cam_thermo, only: get_dp, MASS_MIXING_RATIO - use air_composition,only: thermodynamic_active_species_num use air_composition,only: thermodynamic_active_species_idx_dycore implicit none type (hybrid_t) , intent(in) :: hybrid @@ -1763,7 +1744,7 @@ subroutine compute_omega(hybrid,n0,qn0,elem,deriv,nets,nete,dt,hvcoord) real (kind=r8) :: dp_full(np,np,nlev) real (kind=r8) :: p_full(np,np,nlev),grad_p_full(np,np,2),vgrad_p_full(np,np,nlev) real (kind=r8) :: divdp_full(np,np,nlev),vdp_full(np,np,2) - real(kind=r8) :: Otens(np,np ,nlev,nets:nete), dt_hyper, sum_water(np,np,nlev) + real(kind=r8) :: Otens(np,np ,nlev,nets:nete), dt_hyper logical, parameter :: del4omega = .true. diff --git a/src/dynamics/se/dycore/prim_driver_mod.F90 b/src/dynamics/se/dycore/prim_driver_mod.F90 index 95d1215055..5ea869b53c 100644 --- a/src/dynamics/se/dycore/prim_driver_mod.F90 +++ b/src/dynamics/se/dycore/prim_driver_mod.F90 @@ -282,9 +282,9 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst call TimeLevel_Qdp( tl, qsplit, n0_qdp) - call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%n0,n0_qdp,'dAF', subcycle=.true.) + call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%n0,n0_qdp,'dAF') call ApplyCAMForcing(elem,fvm,tl%n0,n0_qdp,dt_remap,dt_phys,nets,nete,nsubstep) - call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD', subcycle=.true.) + call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') do r=1,rsplit if (r.ne.1) call TimeLevel_update(tl,"leapfrog") call prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,r) @@ -300,7 +300,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst ! always for tracers !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAD', subcycle=.true.) + call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAD') if (variable_nsplit.or.compute_diagnostics) then ! @@ -317,7 +317,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! time step is complete. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAR', subcycle=.true.) + call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAR') if (nsubstep==nsplit) then call compute_omega(hybrid,tl%np1,np1_qdp,elem,deriv,nets,nete,dt_remap,hvcoord) diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index 9bd47eb140..f7ee9c1ff8 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -3,7 +3,8 @@ module dycore_budget implicit none public :: print_budget -real(r8), parameter :: eps = 1.0E-9_r8 +real(r8), parameter :: eps = 1.0E-9_r8 +real(r8), parameter :: eps_mass = 1.0E-12_r8 real(r8), save :: previous_dEdt_adiabatic_dycore = 0.0_r8 real(r8), save :: previous_dEdt_dry_mass_adjust = 0.0_r8 @@ -12,33 +13,34 @@ module dycore_budget contains !========================================================================================= -subroutine print_budget() +subroutine print_budget(hstwr) use spmd_utils, only: masterproc use cam_abortutils, only: endrun use cam_logfile, only: iulog use shr_kind_mod, only: r8=>shr_kind_r8 - use budgets, only: budget_get_global, is_budget - use dimensions_mod, only: lcp_moist,qsize - use control_mod, only: ftype + use budgets, only: budget_get_global, is_budget, thermo_budget_histfile_num use cam_thermo, only: teidx, thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv + + ! arguments + logical, intent(in) :: hstwr(:) + ! Local variables - integer :: i character(len=*), parameter :: subname = 'check_energy:print_budgets' real(r8) :: ph_param,ph_EFIX,ph_DMEA,ph_phys_total real(r8) :: dy_param,dy_EFIX,dy_DMEA,dy_param_and_efix,dy_phys_total !jt real(r8) :: se_param,se_dmea,se_phys_total, dycore, err, param, pefix, & - real(r8) :: dycore, err, param, pefix, & - pdmea, phys_total, dyn_total, dyn_phys_total, & + real(r8) :: dycore, param, pefix, & + pdmea, phys_total, dyn_total, & rate_of_change_2D_dyn, rate_of_change_vertical_remapping, & diffusion_del4, diffusion_fric, diffusion_del4_tot, diffusion_sponge, & diffusion_total, twoDresidual, rate_of_change_physics, & rate_of_change_heating_term_put_back_in, rate_of_change_hvis_sponge, & - dADIA, ttt, fff, & + dADIA, & mass_change__2D_dyn,mass_change__vertical_remapping, & mass_change__heating_term_put_back_in,mass_change__hypervis_total, & - error, mass_change__physics, dbd, daf, dar, dad, qneg, val,phbf,ded + error, mass_change__physics, dbd, daf, dar, dad, val real(r8) :: E_dBF, E_phBF, diff @@ -46,7 +48,7 @@ subroutine print_budget() integer :: m_cnst !-------------------------------------------------------------------------------------- - if (masterproc) then + if (masterproc .and. hstwr(thermo_budget_histfile_num)) then call budget_get_global('phAP-phBP',teidx,ph_param) call budget_get_global('phBP-phBF',teidx,ph_EFIX) call budget_get_global('phAM-phAP',teidx,ph_DMEA) @@ -134,7 +136,7 @@ subroutine print_budget() dycore = -ph_EFIX-previous_dEdt_dry_mass_adjust write(iulog,*) "" write(iulog,*) "Dycore TE dissipation estimated from physics in pressure coordinate:" - write(iulog,*) "(note to avoid sampling error we need dE/dt from previous time-step)" + write(iulog,*) "(note: to avoid sampling error we need dE/dt from previous time-step)" write(iulog,*) "" write(iulog,*) "dE/dt adiabatic dycore estimated from physics (t=n-1) = " write(iulog,'(a58,F6.2,a6)') "-dE/dt energy fixer(t=n)-dE/dt dry-mass adjust(t=n-1) = ",dycore," W/M^2" @@ -205,7 +207,7 @@ subroutine print_budget() write(iulog,*) "" call budget_get_global('dBF',teidx,E_dBF) !state passed to physics call budget_get_global('phBF',teidx,E_phBF)!state beginning physics - if (abs(E_phBF)>eps) then +! if (abs(E_phBF)>eps) then diff = abs_diff(E_dBF,E_phBF) if (abs(diff)eps_mass) then + write(iulog,*) "dMASS/dt energy fixer (pBP-pBF) ",pEFIX," Pa" + write(iulog,*) "ERROR: Mass not conserved in energy fixer. ABORT" + call endrun('dycore_budget module: Mass not conserved in energy fixer. See atm.log') + endif + if (abs(pDMEA)>eps_mass) then + write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",pDMEA," Pa" + write(iulog,*) "ERROR: Mass not conserved in dry mass adjustment. ABORT" + call endrun('dycore_budget module: Mass not conserved in dry mass adjustment. See atm.log') + end if + if (abs(param-phys_total)>eps_mass) then + write(iulog,*) "Error: dMASS/dt parameterizations (pAP-pBP) .ne. dMASS/dt physics total (pAM-pBF)" + write(iulog,*) "dMASS/dt parameterizations (pAP-pBP) ",param," Pa" + write(iulog,*) "dMASS/dt physics total (pAM-pBF) ",phys_total," Pa" + call endrun('dycore_budget module: mass change not only due to parameterizations. See atm.log') + end if + write(iulog,*)"dMASS/dt parameterizations (pAP-pBP) ",param," Pa" - write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",pDMEA," Pa" write(iulog,*)"dMASS/dt physics total (pAM-pBF) ",phys_total," Pa" write(iulog,*)" " + ! + ! detailed mass budget in dynamical core + ! if (is_budget('dAD').and.is_budget('dBD').and.is_budget('dAR').and.is_budget('dCH')) then call budget_get_global('dAD-dBD',m_cnst,mass_change__2D_dyn) call budget_get_global('dAR-dAD',m_cnst,mass_change__vertical_remapping) diff = mass_change__2D_dyn+mass_change__vertical_remapping write(iulog,*)"dMASS/dt total adiabatic dynamics ",diff," Pa" - if (abs(diff)>1.E-12_r8) then + if (abs(diff)>eps_mass) then write(iulog,*) "Error: mass non-conservation in dynamical core" - + write(iulog,*) "(detailed budget below)" + write(iulog,*) " " write(iulog,*)"dMASS/dt 2D dynamics (dAD-dBD) ",mass_change__2D_dyn," Pa" if (is_budget('dAR').and.is_budget('dAD')) then call budget_get_global('dAR',m_cnst,dar) diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index e21b2f4370..bd3e562ade 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -15,7 +15,7 @@ module dyn_comp ini_grid_hdim_name use cam_grid_support, only: cam_grid_id, cam_grid_get_gcid, & - cam_grid_dimensions, cam_grid_get_dim_names, & + cam_grid_dimensions, & cam_grid_get_latvals, cam_grid_get_lonvals, & max_hcoordname_len use cam_map_utils, only: iMap @@ -120,13 +120,11 @@ subroutine dyn_readnl(NLFileName) use parallel_mod, only: initmpi use thread_mod, only: initomp, max_num_threads use thread_mod, only: horz_num_threads, vert_num_threads, tracer_num_threads - use physconst, only: rearth ! Dummy argument character(len=*), intent(in) :: NLFileName ! Local variables integer :: unitn, ierr,k - real(r8) :: uniform_res_hypervis_scaling,nu_fac ! SE Namelist variables integer :: se_fine_ne @@ -584,7 +582,7 @@ subroutine dyn_init(dyn_in, dyn_out) use prim_advance_mod, only: prim_advance_init use dyn_grid, only: elem, fvm use cam_pio_utils, only: clean_iodesc_list - use physconst, only: rair, cpair, pstd + use physconst, only: cpair, pstd use air_composition, only: thermodynamic_active_species_num, thermodynamic_active_species_idx use air_composition, only: thermodynamic_active_species_idx_dycore use air_composition, only: thermodynamic_active_species_liq_idx,thermodynamic_active_species_ice_idx @@ -595,40 +593,37 @@ subroutine dyn_init(dyn_in, dyn_out) use thread_mod, only: horz_num_threads use hybrid_mod, only: get_loop_ranges, config_thread_region - use dimensions_mod, only: nu_scale_top, nu_lev, nu_div_lev + use dimensions_mod, only: nu_scale_top use dimensions_mod, only: ksponge_end, kmvis_ref, kmcnd_ref,rho_ref,km_sponge_factor use dimensions_mod, only: cnst_name_gll, cnst_longname_gll use dimensions_mod, only: irecons_tracer_lev, irecons_tracer, kord_tr, kord_tr_cslam use prim_driver_mod, only: prim_init2 - use time_mod, only: time_at - use control_mod, only: runtype, molecular_diff, nu_top + use control_mod, only: molecular_diff, nu_top use test_fvm_mapping, only: test_mapping_addfld use phys_control, only: phys_getopts use cam_thermo, only: get_molecular_diff_coef_reference use control_mod, only: vert_remap_uvTq_alg, vert_remap_tracer_alg use std_atm_profile, only: std_atm_height use dyn_tests_utils, only: vc_dycore, vc_dry_pressure, string_vc, vc_str_lgth - use budgets, only: thermo_budget_history, budget_outfld, budget_info, & - thermo_budget_histfile_num, budget_add + use budgets, only: budget_add, thermo_budget_history ! Dummy arguments: type(dyn_import_t), intent(out) :: dyn_in type(dyn_export_t), intent(out) :: dyn_out ! Local variables - integer :: ithr, nets, nete, ie, k, kmol_end, mfound + integer :: nets, nete, ie, k, kmol_end, mfound real(r8), parameter :: Tinit = 300.0_r8 real(r8) :: press(1), ptop, tref,z(1) type(hybrid_t) :: hybrid - integer :: ixcldice, ixcldliq, ixrain, ixsnow, ixgraupel + integer :: ixcldice, ixcldliq integer :: m_cnst, m ! variables for initializing energy and axial angular momentum diagnostics integer, parameter :: num_stages = 12 - character (len = 3), dimension(num_stages) :: stage = (/"dED","dAF","dBD","dAD","dAR","dBF","dBH","dCH","dAH","dBS","dAS","p2d"/) - character (len = 1), dimension(num_stages) :: stage_avgflag = (/"A" ,"C" ,"C" ,"C" ,"C" ,"A" ,"C" ,"C" ,"C" ,"C" ,"C" ,"A"/) + character (len = 4), dimension(num_stages) :: stage = (/"dED","dAF","dBD","dAD","dAR","dBF","dBH","dCH","dAH","dBS","dAS","p2d"/) character (len = 70),dimension(num_stages) :: stage_txt = (/& " end of previous dynamics ",& !dED " from previous remapping or state passed to dynamics",& !dAF - state in beginning of nsplit loop @@ -644,13 +639,11 @@ subroutine dyn_init(dyn_in, dyn_out) " phys2dyn mapping errors (requires ftype-1) " & !p2d - for assessing phys2dyn mapping errors /) - integer :: istage, ivars - character (len=108) :: str1, str2, str3, str4 + integer :: istage character (len=vc_str_lgth) :: vc_str logical :: history_budget ! output tendencies and state variables for budgets - logical :: thermo_budget_hist ! output tendencies and state variables for budgets - integer :: budget_hfile_num, thermo_budget_hfile_num + integer :: budget_hfile_num character(len=*), parameter :: sub = 'dyn_init' @@ -906,47 +899,45 @@ subroutine dyn_init(dyn_in, dyn_out) call addfld ('TT_PDC', horiz_only, 'A', 'kg/m2','Total column test tracer lost in physics-dynamics coupling',gridname='GLL') end if - call phys_getopts(thermo_budget_hist_out=thermo_budget_hist) - if (thermo_budget_hist) then + if (thermo_budget_history) then ! Register stages for budgets do istage = 1, num_stages - call budget_add(TRIM(ADJUSTL(stage(istage))), 'dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), outfld=.true.) + call budget_add(TRIM(ADJUSTL(stage(istage))), 'dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), cslam=ntrac>0) end do ! ! Register dif/sum budgets. ! - call budget_add('BD_dyn_total','dBF','dED','dyn','dif',longname="dE/dt dyn total (dycore+phys tendency (dBF-dED)",outfld=.true.) + call budget_add('BD_dyn_total','dBF','dED','dyn','dif',longname="dE/dt dyn total (dycore+phys tendency (dBF-dED)",cslam=ntrac>0) - call budget_add('rate_2d_dyn','dAD','dBD','dyn','dif',longname="rate_of_change_2d_dyn (dAD-dBD)",outfld=.false.) + call budget_add('rate_2d_dyn','dAD','dBD','dyn','dif',longname="rate_of_change_2d_dyn (dAD-dBD)",cslam=ntrac>0.) - call budget_add('rate_vert_remap','dAR','dAD','dyn','dif',longname="rate_of_change_2d_dyn (dAR-dAD)",outfld=.false.) + call budget_add('rate_vert_remap','dAR','dAD','dyn','dif',longname="rate_of_change_2d_dyn (dAR-dAD)",cslam=ntrac>0.) - call budget_add('BD_dyn_adai','rate_2d_dyn','rate_vert_remap','dyn','sum',longname="dE/dt total adiabatic dynamics (adiab=rate2ddyn+vremap) ",outfld=.true.) + call budget_add('BD_dyn_adai','rate_2d_dyn','rate_vert_remap','dyn','sum',longname="dE/dt total adiabatic dynamics (adiab=rate2ddyn+vremap) ",cslam=ntrac>0) - call budget_add('BD_dyn_2D','dAD','dBD','dyn','dif',longname="dE/dt 2D dynamics (dAD-dBD)",outfld=.true.) + call budget_add('BD_dyn_2D','dAD','dBD','dyn','dif',longname="dE/dt 2D dynamics (dAD-dBD)",cslam=ntrac>0) - call budget_add('BD_dyn_remap','dAR','dAD','dyn','dif',longname="dE/dt vertical remapping (dAR-dAD)",outfld=.true.) + call budget_add('BD_dyn_remap','dAR','dAD','dyn','dif',longname="dE/dt vertical remapping (dAR-dAD)",cslam=ntrac>0) - call budget_add('BD_dyn_ptend','dBD','dAF','dyn','dif',longname="dE/dt physics tendency in dynamics (dBD-dAF)",outfld=.true.) + call budget_add('BD_dyn_ptend','dBD','dAF','dyn','dif',longname="dE/dt physics tendency in dynamics (dBD-dAF)",cslam=ntrac>0) - call budget_add('BD_dyn_hvis','dCH','dBH','dyn','dif',longname="dE/dt hypervis del4 (dCH-dBH)",outfld=.true.) + call budget_add('BD_dyn_hvis','dCH','dBH','dyn','dif',longname="dE/dt hypervis del4 (dCH-dBH)",cslam=ntrac>0) - call budget_add('BD_dyn_fric','dAH','dCH','dyn','dif',longname="dE/dt hypervis frictional heating del4 (dAH-dCH)",outfld=.true.) + call budget_add('BD_dyn_fric','dAH','dCH','dyn','dif',longname="dE/dt hypervis frictional heating del4 (dAH-dCH)",cslam=ntrac>0) - call budget_add('BD_dyn_difdel4tot','dAH','dBH','dyn','dif',longname="dE/dt hypervis del4 total (dAH-dBH)",outfld=.true.) + call budget_add('BD_dyn_difdel4tot','dAH','dBH','dyn','dif',longname="dE/dt hypervis del4 total (dAH-dBH)",cslam=ntrac>0) - call budget_add('BD_dyn_sponge','dAS','dBS','dyn','dif',longname="dE/dt hypervis sponge total (dAS-dBS)",outfld=.true.) + call budget_add('BD_dyn_sponge','dAS','dBS','dyn','dif',longname="dE/dt hypervis sponge total (dAS-dBS)",cslam=ntrac>0) - call budget_add('BD_dyn_difftot','BD_dyn_difdel4tot','BD_dyn_sponge','dyn','sum',longname="dE/dt explicit diffusion total (hvisdel4tot+hvisspngtot)",outfld=.true.) + call budget_add('BD_dyn_difftot','BD_dyn_difdel4tot','BD_dyn_sponge','dyn','sum',longname="dE/dt explicit diffusion total (hvisdel4tot+hvisspngtot)",cslam=ntrac>0) - call budget_add('BD_dyn_res','BD_dyn_2D','BD_dyn_difftot','dyn','dif',longname="dE/dt residual (2ddyn-expdifftot)",outfld=.true.) + call budget_add('BD_dyn_res','BD_dyn_2D','BD_dyn_difftot','dyn','dif',longname="dE/dt residual (2ddyn-expdifftot)",cslam=ntrac>0) - call budget_add('hrate','dAH','dCH','dyn','dif',longname="rate of change heating term put back in (dAH-dCH)",outfld=.false.) + call budget_add('hrate','dAH','dCH','dyn','dif',longname="rate of change heating term put back in (dAH-dCH)",cslam=ntrac>0) end if - call addfld ('dyn_area', horiz_only, 'I', 'steradian', 'dynamics grid area' , gridname='GLL') ! ! add dynamical core tracer tendency output ! @@ -978,7 +969,6 @@ end subroutine dyn_init subroutine dyn_run(dyn_state) use air_composition, only: thermodynamic_active_species_num, dry_air_species_num use air_composition, only: thermodynamic_active_species_idx_dycore - use prim_advance_mod, only: calc_tot_energy_dynamics use prim_driver_mod, only: prim_run_subcycle use dimensions_mod, only: cnst_name_gll use time_mod, only: tstep, nsplit, timelevel_qdp @@ -986,28 +976,23 @@ subroutine dyn_run(dyn_state) use control_mod, only: qsplit, rsplit, ftype_conserve use thread_mod, only: horz_num_threads use time_mod, only: tevolve -!jt use budgets, only: budget_write - use global_norms_mod, only: global_integral, wrap_repro_sum - use parallel_mod, only: global_shared_buf, global_shared_sum - use dycore_budget, only: print_budget type(dyn_export_t), intent(inout) :: dyn_state type(hybrid_t) :: hybrid integer :: tl_f integer :: n - integer :: nets, nete, ithr + integer :: nets, nete integer :: i, ie, j, k, m, nq, m_cnst integer :: n0_qdp, nsplit_local logical :: ldiag real(r8) :: ftmp(npsq,nlev,3) - real(r8) :: rec2dt, pdel real(r8) :: dtime + real(r8) :: rec2dt, pdel real(r8), allocatable, dimension(:,:,:) :: ps_before real(r8), allocatable, dimension(:,:,:) :: abs_ps_tend - real (kind=r8) :: omega_cn(2,nelemd) !min and max of vertical Courant number !---------------------------------------------------------------------------- @@ -1156,9 +1141,6 @@ subroutine dyn_run(dyn_state) ! output vars on CSLAM fvm grid call write_dyn_vars(dyn_state) -!jt if(budget_write(step_offset=nint(dtime))) then -!jt call budget_update(dyn_state%elem,dyn_state%fvm, nets, nete, TimeLevel%n0, n0_qdp, hybrid) -!jt end if end subroutine dyn_run !=============================================================================== @@ -1180,7 +1162,7 @@ subroutine read_inidat(dyn_in) use element_mod, only: timelevels use fvm_mapping, only: dyn2fvm_mass_vars - use control_mod, only: runtype,initial_global_ave_dry_ps + use control_mod, only: runtype use prim_driver_mod, only: prim_set_dry_mass use air_composition, only: thermodynamic_active_species_idx use cam_initfiles, only: scale_dry_air_mass @@ -1203,8 +1185,8 @@ subroutine read_inidat(dyn_in) logical, allocatable :: pmask(:) ! (npsq*nelemd) unique grid vals character(len=max_hcoordname_len):: grid_name - real(r8), allocatable :: latvals(:),latvals_phys(:) - real(r8), allocatable :: lonvals(:),lonvals_phys(:) + real(r8), allocatable :: latvals(:) + real(r8), allocatable :: lonvals(:) real(r8), pointer :: latvals_deg(:) real(r8), pointer :: lonvals_deg(:) @@ -1216,9 +1198,6 @@ subroutine read_inidat(dyn_in) integer :: kptr, m_cnst type(EdgeBuffer_t) :: edge - character(len=max_fieldname_len) :: varname - integer :: ierr - integer :: rndm_seed_sz integer, allocatable :: rndm_seed(:) integer :: dims(2) @@ -1229,10 +1208,6 @@ subroutine read_inidat(dyn_in) character(len=128) :: errmsg character(len=*), parameter :: sub='READ_INIDAT' - ! fvm vars - real(r8), allocatable :: inv_dp_darea_fvm(:,:,:) - real(r8) :: min_val, max_val - real(r8) :: dp_tmp, pstmp(np,np) ! Variables for analytic initial conditions @@ -2044,7 +2019,6 @@ subroutine check_file_layout(file, elem, dyn_cols, file_desc, dyn_ok) integer :: ncol_did, ncol_size integer :: ierr integer :: ie, i, j - integer :: grid_id integer :: indx real(r8) :: dbuf2(npsq, nelemd) logical :: found @@ -2343,4 +2317,5 @@ subroutine write_dyn_vars(dyn_out) end subroutine write_dyn_vars +!========================================================================================= end module dyn_comp diff --git a/src/dynamics/se/dyn_grid.F90 b/src/dynamics/se/dyn_grid.F90 index 77f3a27f2f..d92ca269ea 100644 --- a/src/dynamics/se/dyn_grid.F90 +++ b/src/dynamics/se/dyn_grid.F90 @@ -733,6 +733,7 @@ subroutine define_cam_grids() use cam_grid_support, only: horiz_coord_t, horiz_coord_create use cam_grid_support, only: cam_grid_register, cam_grid_attribute_register use dimensions_mod, only: nc + use shr_const_mod, only: PI => SHR_CONST_PI ! Local variables integer :: i, ii, j, k, ie, mapind @@ -745,18 +746,20 @@ subroutine define_cam_grids() real(r8), allocatable :: pelat_deg(:) ! pe-local latitudes (degrees) real(r8), allocatable :: pelon_deg(:) ! pe-local longitudes (degrees) real(r8), pointer :: pearea(:) => null() ! pe-local areas - real(r8) :: areaw(np,np) + real(r8), pointer :: pearea_wt(:) => null() ! pe-local areas integer(iMap) :: fdofP_local(npsq,nelemd) ! pe-local map for dynamics decomp integer(iMap), allocatable :: pemap(:) ! pe-local map for PIO decomp integer :: ncols_fvm, ngcols_fvm real(r8), allocatable :: fvm_coord(:) real(r8), pointer :: fvm_area(:) + real(r8), pointer :: fvm_areawt(:) integer(iMap), pointer :: fvm_map(:) integer :: ncols_physgrid, ngcols_physgrid real(r8), allocatable :: physgrid_coord(:) real(r8), pointer :: physgrid_area(:) + real(r8), pointer :: physgrid_areawt(:) integer(iMap), pointer :: physgrid_map(:) !---------------------------------------------------------------------------- @@ -777,16 +780,17 @@ subroutine define_cam_grids() allocate(pelat_deg(np*np*nelemd)) allocate(pelon_deg(np*np*nelemd)) allocate(pearea(np*np*nelemd)) + allocate(pearea_wt(np*np*nelemd)) allocate(pemap(np*np*nelemd)) pemap = 0_iMap ii = 1 do ie = 1, nelemd - areaw = 1.0_r8 / elem(ie)%rspheremp(:,:) - pearea(ii:ii+npsq-1) = reshape(areaw, (/ np*np /)) pemap(ii:ii+npsq-1) = fdofp_local(:,ie) do j = 1, np do i = 1, np + pearea(ii) = elem(ie)%mp(i,j)*elem(ie)%metdet(i,j) + pearea_wt(ii) = pearea(ii)/(4.0_r8*PI) pelat_deg(ii) = elem(ie)%spherep(i,j)%lat * rad2deg pelon_deg(ii) = elem(ie)%spherep(i,j)%lon * rad2deg ii = ii + 1 @@ -832,6 +836,8 @@ subroutine define_cam_grids() grid_map, block_indexed=.false., unstruct=.true.) call cam_grid_attribute_register('GLL', 'area_d', 'gll grid areas', & 'ncol_d', pearea, map=pemap) + call cam_grid_attribute_register('GLL', 'area_weight_gll', 'gll grid area weights', & + 'ncol_d', pearea_wt, map=pemap) call cam_grid_attribute_register('GLL', 'np', '', np) call cam_grid_attribute_register('GLL', 'ne', '', ne) @@ -848,6 +854,8 @@ subroutine define_cam_grids() grid_map, block_indexed=.false., unstruct=.true.) call cam_grid_attribute_register('INI', 'area', 'ini grid areas', & 'ncol', pearea, map=pemap) + call cam_grid_attribute_register('INI', 'area_weight_ini', 'ini grid area weights', & + 'ncol', pearea_wt, map=pemap) ini_grid_name = 'INI' else @@ -865,6 +873,7 @@ subroutine define_cam_grids() ! to that memory. It can be nullified since the attribute object has ! the reference. nullify(pearea) + nullify(pearea_wt) ! grid_map cannot be deallocated as the cam_filemap_t object just points ! to it. It can be nullified. @@ -881,6 +890,7 @@ subroutine define_cam_grids() allocate(fvm_coord(ncols_fvm)) allocate(fvm_map(ncols_fvm)) allocate(fvm_area(ncols_fvm)) + allocate(fvm_areawt(ncols_fvm)) do ie = 1, nelemd k = 1 @@ -890,6 +900,7 @@ subroutine define_cam_grids() fvm_coord(mapind) = fvm(ie)%center_cart(i,j)%lon*rad2deg fvm_map(mapind) = k + ((elem(ie)%GlobalId-1) * nc * nc) fvm_area(mapind) = fvm(ie)%area_sphere(i,j) + fvm_areawt(mapind) = fvm_area(mapind)/(4.0_r8*PI) k = k + 1 end do end do @@ -930,12 +941,15 @@ subroutine define_cam_grids() grid_map, block_indexed=.false., unstruct=.true.) call cam_grid_attribute_register('FVM', 'area_fvm', 'fvm grid areas', & 'ncol_fvm', fvm_area, map=fvm_map) + call cam_grid_attribute_register('FVM', 'area_weight_fvm', 'fvm grid area weights', & + 'ncol_fvm', fvm_areawt, map=fvm_map) call cam_grid_attribute_register('FVM', 'nc', '', nc) call cam_grid_attribute_register('FVM', 'ne', '', ne) deallocate(fvm_coord) deallocate(fvm_map) nullify(fvm_area) + nullify(fvm_areawt) nullify(grid_map) end if @@ -951,6 +965,7 @@ subroutine define_cam_grids() allocate(physgrid_coord(ncols_physgrid)) allocate(physgrid_map(ncols_physgrid)) allocate(physgrid_area(ncols_physgrid)) + allocate(physgrid_areawt(ncols_physgrid)) do ie = 1, nelemd k = 1 @@ -960,6 +975,7 @@ subroutine define_cam_grids() physgrid_coord(mapind) = fvm(ie)%center_cart_physgrid(i,j)%lon*rad2deg physgrid_map(mapind) = k + ((elem(ie)%GlobalId-1) * fv_nphys * fv_nphys) physgrid_area(mapind) = fvm(ie)%area_sphere_physgrid(i,j) + physgrid_areawt(mapind) = physgrid_area(mapind)/(4.0_r8*PI) k = k + 1 end do end do @@ -1000,12 +1016,15 @@ subroutine define_cam_grids() grid_map, block_indexed=.false., unstruct=.true.) call cam_grid_attribute_register('physgrid_d', 'area_physgrid', 'physics grid areas', & 'ncol', physgrid_area, map=physgrid_map) + call cam_grid_attribute_register('physgrid_d', 'area_weight_physgrid', 'physics grid area weight', & + 'ncol', physgrid_areawt, map=physgrid_map) call cam_grid_attribute_register('physgrid_d', 'fv_nphys', '', fv_nphys) call cam_grid_attribute_register('physgrid_d', 'ne', '', ne) deallocate(physgrid_coord) deallocate(physgrid_map) nullify(physgrid_area) + nullify(physgrid_areawt) nullify(grid_map) end if diff --git a/src/infrastructure/phys_grid.F90 b/src/infrastructure/phys_grid.F90 index 505fdb0c26..ea5b5ccc5e 100644 --- a/src/infrastructure/phys_grid.F90 +++ b/src/infrastructure/phys_grid.F90 @@ -190,6 +190,7 @@ subroutine phys_grid_init() use cam_grid_support, only: iMap, hclen => max_hcoordname_len use cam_grid_support, only: horiz_coord_t, horiz_coord_create use cam_grid_support, only: cam_grid_attribute_copy, cam_grid_attr_exists + use shr_const_mod, only: PI => SHR_CONST_PI ! Local variables integer :: index @@ -206,6 +207,7 @@ subroutine phys_grid_init() type(horiz_coord_t), pointer :: lat_coord type(horiz_coord_t), pointer :: lon_coord real(r8), pointer :: area_d(:) + real(r8), pointer :: areawt_d(:) real(r8) :: mem_hw_beg, mem_hw_end real(r8) :: mem_beg, mem_end logical :: unstructured @@ -221,6 +223,7 @@ subroutine phys_grid_init() nullify(lat_coord) nullify(lon_coord) nullify(area_d) + nullify(areawt_d) nullify(copy_attributes) if (calc_memory_increase) then @@ -416,6 +419,14 @@ subroutine phys_grid_init() call cam_grid_attribute_register('physgrid', 'area', & 'physics column areas', 'ncol', area_d, map=grid_map(3,:)) nullify(area_d) ! Belongs to attribute now + + allocate(areawt_d(size(grid_map, 2))) + do col_index = 1, columns_on_task + areawt_d(col_index) = phys_columns(col_index)%weight/(4.0_r8*PI) + end do + call cam_grid_attribute_register('physgrid', 'areawt', & + 'physics column area weight', 'ncol', areawt_d, map=grid_map(3,:)) + nullify(areawt_d) ! Belongs to attribute now else call endrun(subname//"No 'area' attribute from dycore") end if diff --git a/src/physics/cam/cam_diagnostics.F90 b/src/physics/cam/cam_diagnostics.F90 index e3e1675ff0..fd64dd60d0 100644 --- a/src/physics/cam/cam_diagnostics.F90 +++ b/src/physics/cam/cam_diagnostics.F90 @@ -13,6 +13,7 @@ module cam_diagnostics use physics_buffer, only: dyn_time_lvls, pbuf_get_field, pbuf_get_index, pbuf_old_tim_idx use cam_history, only: outfld, write_inithist, hist_fld_active, inithist_all +use cam_history_support, only: max_fieldname_len use constituents, only: pcnst, cnst_name, cnst_longname, cnst_cam_outfld use constituents, only: ptendnam, apcnst, bpcnst, cnst_get_ind use dycore, only: dycore_is @@ -46,8 +47,8 @@ module cam_diagnostics diag_physvar_ic, & nsurf -integer, public, parameter :: num_stages = 8 -character (len = 4), dimension(num_stages) :: stage = (/"phBF","phBP","phAP","phAM","dyBF","dyBP","dyAP","dyAM"/) +integer, public, parameter :: num_stages = 8 +character (len = max_fieldname_len), dimension(num_stages) :: stage = (/"phBF","phBP","phAP","phAM","dyBF","dyBP","dyAP","dyAM"/) character (len = 45),dimension(num_stages) :: stage_txt = (/& " before energy fixer ",& !phBF - physics energy " before parameterizations ",& !phBF - physics energy @@ -86,8 +87,6 @@ module cam_diagnostics ! temperature, water vapor, cloud ice and cloud ! liquid budgets. integer :: history_budget_histfile_num ! output history file number for budget fields -logical :: thermo_budget_hist ! output budget -integer :: thermo_budget_hfile_num ! output history file number for budget fields logical :: history_waccm ! outputs typically used for WACCM ! Physics buffer indices @@ -190,15 +189,12 @@ subroutine diag_init_dry(pbuf2d) use cam_history, only: addfld, add_default, horiz_only use cam_history, only: register_vector_field - use constituent_burden, only: constituent_burden_init - use physics_buffer, only: pbuf_set_field use tidal_diag, only: tidal_diag_init - use budgets, only: budget_add + use budgets, only: budget_add, thermo_budget_history type(physics_buffer_desc), pointer, intent(in) :: pbuf2d(:,:) - integer :: k, m, istage - integer :: ierr + integer :: istage ! outfld calls in diag_phys_writeout call addfld (cnst_name(1), (/ 'lev' /), 'A', 'kg/kg', cnst_longname(1)) call addfld ('NSTEP', horiz_only, 'A', 'timestep', 'Model timestep') @@ -398,31 +394,29 @@ subroutine diag_init_dry(pbuf2d) call addfld( 'CPAIRV', (/ 'lev' /), 'I', 'J/K/kg', 'Variable specific heat cap air' ) call addfld( 'RAIRV', (/ 'lev' /), 'I', 'J/K/kg', 'Variable dry air gas constant' ) - if (thermo_budget_hist) then + if (thermo_budget_history) then ! - ! energy diagnostics addflds for vars_stage combinations plus budget_adds for - ! just the stages as the vars portion is accounted for via an extra array - ! dimension in the state%te_budgets array. + ! energy diagnostics addflds for vars_stage combinations plus budget_adds ! do istage = 1, num_stages - call budget_add(TRIM(ADJUSTL(stage(istage))),'phy',longname=TRIM(ADJUSTL(stage_txt(istage))),outfld=.true.) + call budget_add(TRIM(ADJUSTL(stage(istage))),'phy',longname=TRIM(ADJUSTL(stage_txt(istage)))) end do ! Create budgets that are a sum/dif of 2 stages - call budget_add('BP_param_and_efix','phAP','phBF','phy','dif',longname='dE/dt CAM physics parameterizations + efix dycore E (phAP-phBF)',outfld=.true.) - call budget_add('BD_param_and_efix','dyAP','dyBF','phy','dif',longname='dE/dt CAM physics parameterizations + efix dycore E (dyAP-dyBF)',outfld=.true.) - call budget_add('BP_phy_params','phAP','phBP','phy','dif',longname='dE/dt CAM physics parameterizations (phAP-phBP)',outfld=.true.) - call budget_add('BD_phy_params','dyAP','dyBP','phy','dif',longname='dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)',outfld=.true.) - call budget_add('BP_pwork','phAM','phAP','phy','dif',longname='dE/dt dry mass adjustment (phAM-phAP)',outfld=.true.) - call budget_add('BD_pwork','dyAM','dyAP','phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)',outfld=.true.) - call budget_add('BP_efix','phBP','phBF','phy','dif',longname='dE/dt energy fixer (phBP-phBF)',outfld=.true.) - call budget_add('BD_efix','dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E (dyBP-dyBF)',outfld=.true.) - call budget_add('BP_phys_tot','phAM','phBF','phy','dif',longname='dE/dt physics total (phAM-phBF)',outfld=.true.) - call budget_add('BD_phys_tot','dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)',outfld=.true.) + call budget_add('BP_param_and_efix','phAP','phBF','phy','dif',longname='dE/dt CAM physics parameterizations + efix dycore E (phAP-phBF)') + call budget_add('BD_param_and_efix','dyAP','dyBF','phy','dif',longname='dE/dt CAM physics parameterizations + efix dycore E (dyAP-dyBF)') + call budget_add('BP_phy_params','phAP','phBP','phy','dif',longname='dE/dt CAM physics parameterizations (phAP-phBP)') + call budget_add('BD_phy_params','dyAP','dyBP','phy','dif',longname='dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)') + call budget_add('BP_pwork','phAM','phAP','phy','dif',longname='dE/dt dry mass adjustment (phAM-phAP)') + call budget_add('BD_pwork','dyAM','dyAP','phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)') + call budget_add('BP_efix','phBP','phBF','phy','dif',longname='dE/dt energy fixer (phBP-phBF)') + call budget_add('BD_efix','dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E (dyBP-dyBF)') + call budget_add('BP_phys_tot','phAM','phBF','phy','dif',longname='dE/dt physics total (phAM-phBF)') + call budget_add('BD_phys_tot','dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)') endif end subroutine diag_init_dry - + subroutine diag_init_moist(pbuf2d) ! Declare the history fields for which this module contains outfld calls. @@ -433,7 +427,7 @@ subroutine diag_init_moist(pbuf2d) type(physics_buffer_desc), pointer, intent(in) :: pbuf2d(:,:) - integer :: k, m + integer :: m integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water. integer :: ierr ! column burdens for all constituents except water vapor @@ -725,14 +719,11 @@ subroutine diag_init_moist(pbuf2d) end subroutine diag_init_moist subroutine diag_init(pbuf2d) - use cam_history, only: addfld ! Declare the history fields for which this module contains outfld calls. type(physics_buffer_desc), pointer, intent(in) :: pbuf2d(:,:) - integer :: thermo_budget_hfile_num ! output history file number for budget fields - ! ---------------------------- ! determine default variables ! ---------------------------- @@ -741,9 +732,7 @@ subroutine diag_init(pbuf2d) history_eddy_out = history_eddy , & history_budget_out = history_budget , & history_budget_histfile_num_out = history_budget_histfile_num, & - history_waccm_out = history_waccm, & - thermo_budget_hist_out = thermo_budget_hist, & - thermo_budget_hfile_num_out = thermo_budget_hfile_num) + history_waccm_out = history_waccm) call diag_init_dry(pbuf2d) if (moist_physics) then @@ -910,15 +899,11 @@ subroutine diag_phys_writeout_dry(state, pbuf, p_surf_t) ! Purpose: output dry physics diagnostics ! !----------------------------------------------------------------------- - use physconst, only: gravit, rga, rair, cpair, latvap, rearth, pi, cappa + use physconst, only: gravit, rga, rair, cappa use time_manager, only: get_nstep use interpolate_data, only: vertinterp - use constituent_burden, only: constituent_burden_comp - use co2_cycle, only: c_i, co2_transport - use tidal_diag, only: tidal_diag_write use air_composition, only: cpairv, rairv - !----------------------------------------------------------------------- ! ! Arguments @@ -930,15 +915,9 @@ subroutine diag_phys_writeout_dry(state, pbuf, p_surf_t) !---------------------------Local workspace----------------------------- ! real(r8) :: ftem(pcols,pver) ! temporary workspace - real(r8) :: ftem1(pcols,pver) ! another temporary workspace - real(r8) :: ftem2(pcols,pver) ! another temporary workspace real(r8) :: z3(pcols,pver) ! geo-potential height real(r8) :: p_surf(pcols) ! data interpolated to a pressure surface - real(r8) :: tem2(pcols,pver) ! temporary workspace real(r8) :: timestep(pcols) ! used for outfld call - real(r8) :: esl(pcols,pver) ! saturation vapor pressures - real(r8) :: esi(pcols,pver) ! - real(r8) :: dlon(pcols) ! width of grid cell (meters) real(r8), pointer :: psl(:) ! Sea Level Pressure @@ -1252,8 +1231,7 @@ subroutine diag_phys_writeout_moist(state, pbuf, p_surf_t) ! Purpose: record dynamics variables on physics grid ! !----------------------------------------------------------------------- - use physconst, only: gravit, rga, rair, cpair, latvap, rearth, pi, cappa, & - epsilo, rh2o + use physconst, only: gravit, rga, rair, cpair, latvap, rearth, cappa use interpolate_data, only: vertinterp use constituent_burden, only: constituent_burden_comp use co2_cycle, only: c_i, co2_transport @@ -1270,7 +1248,6 @@ subroutine diag_phys_writeout_moist(state, pbuf, p_surf_t) real(r8) :: ftem(pcols,pver) ! temporary workspace real(r8) :: ftem1(pcols,pver) ! another temporary workspace real(r8) :: ftem2(pcols,pver) ! another temporary workspace - real(r8) :: z3(pcols,pver) ! geo-potential height real(r8) :: p_surf(pcols) ! data interpolated to a pressure surface real(r8) :: p_surf_q1(pcols) ! data interpolated to a pressure surface real(r8) :: p_surf_q2(pcols) ! data interpolated to a pressure surface @@ -1587,7 +1564,6 @@ subroutine diag_conv(state, ztodt, pbuf) ! Output diagnostics associated with all convective processes. ! !----------------------------------------------------------------------- - use physconst, only: cpair use tidal_diag, only: get_tidal_coeffs ! Arguments: @@ -1949,7 +1925,6 @@ subroutine diag_physvar_ic (lchnk, pbuf, cam_out, cam_in) ! !---------------------------Local workspace----------------------------- ! - integer :: k ! indices integer :: itim_old ! indices real(r8), pointer, dimension(:,:) :: cwat_var diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 79e686fdc6..fc29dff9ab 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -1,3 +1,4 @@ + module check_energy !--------------------------------------------------------------------------------- @@ -51,7 +52,6 @@ module check_energy public :: calc_te_and_aam_budgets ! calculate and output total energy and axial angular momentum diagnostics - ! Private module data logical :: print_energy_errors = .false. @@ -191,10 +191,7 @@ subroutine check_energy_init() logical :: history_budget, history_waccm integer :: history_budget_histfile_num ! output history file number for budget fields - integer :: m ! budget array index into te_budgets - character(len=32):: budget_name ! budget names - character(len=3) :: budget_pkgtype ! budget type phy or dyn - character(len=128):: budget_longname ! long name of budgets + !----------------------------------------------------------------------- call phys_getopts( history_budget_out = history_budget, & @@ -474,6 +471,7 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & end if end subroutine check_energy_chng + subroutine check_energy_gmean(state, pbuf2d, dtime, nstep) use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_chunk @@ -787,15 +785,14 @@ end subroutine check_tracers_chng !####################################################################### subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) - use physconst, only: gravit,cpair,pi,rearth,omega + use physconst, only: gravit,rearth,omega use cam_thermo, only: get_hydrostatic_energy,thermo_budget_num_vars,thermo_budget_vars, & - wvidx,wlidx,wiidx,seidx,keidx,moidx,mridx,ttidx,teidx,poidx - use cam_history, only: hist_fld_active, outfld + wvidx,wlidx,wiidx,seidx,keidx,moidx,mridx,ttidx,teidx + use cam_history, only: outfld use dyn_tests_utils, only: vc_physics, vc_height use cam_abortutils, only: endrun - use budgets, only: budget_info_byname use cam_history_support, only: max_fieldname_len - use shr_assert_mod, only: shr_assert_in_domain + use budgets, only: thermo_budget_history !------------------------------Arguments-------------------------------- type(physics_state), intent(inout) :: state @@ -822,13 +819,12 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) integer :: ncol ! number of atmospheric columns integer :: i,k ! column, level indices integer :: vc_loc ! local vertical coordinate variable - integer :: s_ind,b_ind ! budget array index integer :: ixtt ! test tracer index character(len=max_fieldname_len) :: name_out(thermo_budget_num_vars) !----------------------------------------------------------------------- - + if (thermo_budget_history) then do i=1,thermo_budget_num_vars name_out(i)=trim(thermo_budget_vars(i))//'_'//trim(outfld_name_suffix) end do @@ -836,8 +832,6 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) lchnk = state%lchnk ncol = state%ncol - call budget_info_byname(trim(outfld_name_suffix),budget_ind=b_ind,state_ind=s_ind) - if (present(vc)) then vc_loc = vc else @@ -873,9 +867,6 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) po = po(1:ncol), ke = ke(1:ncol), wv = wv(1:ncol), liq = liq(1:ncol), & ice = ice(1:ncol)) - call shr_assert_in_domain(ke(:), is_nan=.false., & - varname="ke", msg='ke out of get_hydro has nan'//trim(outfld_name_suffix)) - call cnst_get_ind('TT_LW' , ixtt , abort=.false.) tt = 0._r8 @@ -900,7 +891,6 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) end if end if - call outfld(name_out(seidx) ,se+po , pcols ,lchnk ) call outfld(name_out(keidx) ,ke , pcols ,lchnk ) call outfld(name_out(wvidx) ,wv , pcols ,lchnk ) @@ -943,7 +933,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) call outfld(name_out(mridx) ,mr, pcols,lchnk ) call outfld(name_out(moidx) ,mo, pcols,lchnk ) - + end if end subroutine calc_te_and_aam_budgets diff --git a/src/physics/cam/phys_control.F90 b/src/physics/cam/phys_control.F90 index ea600a674d..25183962bf 100644 --- a/src/physics/cam/phys_control.F90 +++ b/src/physics/cam/phys_control.F90 @@ -57,13 +57,9 @@ module phys_control logical :: history_aero_optics = .false. ! output the aerosol logical :: history_eddy = .false. ! output the eddy variables logical :: history_budget = .false. ! output tendencies and state variables for CAM4 -logical :: thermo_budget_hist = .false. ! output thermo budget for CAM - ! temperature, water vapor, cloud ice and cloud - ! liquid budgets. logical :: convproc_do_aer = .false. ! switch for new convective scavenging treatment for modal aerosols integer :: history_budget_histfile_num = 1 ! output history file number for budget fields -integer :: thermo_budget_hfile_num = 2 ! output history file number for thermo budget fields logical :: history_waccm = .false. ! output variables of interest for WACCM runs logical :: history_waccmx = .false. ! output variables of interest for WACCM-X runs logical :: history_chemistry = .true. ! output default chemistry-related variables @@ -136,8 +132,7 @@ subroutine phys_ctl_readnl(nlfile) do_clubb_sgs, state_debug_checks, use_hetfrz_classnuc, use_gw_oro, use_gw_front, & use_gw_front_igw, use_gw_convect_dp, use_gw_convect_sh, cld_macmic_num_steps, & offline_driver, convproc_do_aer, cam_snapshot_before_num, cam_snapshot_after_num, & - cam_take_snapshot_before, cam_take_snapshot_after, cam_physics_mesh, & - thermo_budget_hist, thermo_budget_hfile_num + cam_take_snapshot_before, cam_take_snapshot_after, cam_physics_mesh !----------------------------------------------------------------------------- if (masterproc) then @@ -175,8 +170,6 @@ subroutine phys_ctl_readnl(nlfile) call mpi_bcast(history_aero_optics, 1, mpi_logical, masterprocid, mpicom, ierr) call mpi_bcast(history_budget, 1, mpi_logical, masterprocid, mpicom, ierr) call mpi_bcast(history_budget_histfile_num, 1, mpi_integer, masterprocid, mpicom, ierr) - call mpi_bcast(thermo_budget_hist, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(thermo_budget_hfile_num, 1, mpi_integer, masterprocid, mpicom, ierr) call mpi_bcast(history_waccm, 1, mpi_logical, masterprocid, mpicom, ierr) call mpi_bcast(history_waccmx, 1, mpi_logical, masterprocid, mpicom, ierr) call mpi_bcast(history_chemistry, 1, mpi_logical, masterprocid, mpicom, ierr) @@ -317,8 +310,7 @@ subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, mi cam_chempkg_out, prog_modal_aero_out, macrop_scheme_out, & do_clubb_sgs_out, use_spcam_out, state_debug_checks_out, cld_macmic_num_steps_out, & offline_driver_out, convproc_do_aer_out, cam_snapshot_before_num_out, cam_snapshot_after_num_out,& - cam_take_snapshot_before_out, cam_take_snapshot_after_out, physics_grid_out,& - thermo_budget_hist_out, thermo_budget_hfile_num_out) + cam_take_snapshot_before_out, cam_take_snapshot_after_out, physics_grid_out) !----------------------------------------------------------------------- ! Purpose: Return runtime settings ! deep_scheme_out : deep convection scheme @@ -345,8 +337,6 @@ subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, mi logical, intent(out), optional :: history_aero_optics_out logical, intent(out), optional :: history_budget_out integer, intent(out), optional :: history_budget_histfile_num_out - logical, intent(out), optional :: thermo_budget_hist_out - integer, intent(out), optional :: thermo_budget_hfile_num_out logical, intent(out), optional :: history_waccm_out logical, intent(out), optional :: history_waccmx_out logical, intent(out), optional :: history_chemistry_out @@ -382,12 +372,10 @@ subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, mi if ( present(history_aerosol_out ) ) history_aerosol_out = history_aerosol if ( present(history_aero_optics_out ) ) history_aero_optics_out = history_aero_optics if ( present(history_budget_out ) ) history_budget_out = history_budget - if ( present(thermo_budget_hist_out) ) thermo_budget_hist_out = thermo_budget_hist if ( present(history_amwg_out ) ) history_amwg_out = history_amwg if ( present(history_vdiag_out ) ) history_vdiag_out = history_vdiag if ( present(history_eddy_out ) ) history_eddy_out = history_eddy if ( present(history_budget_histfile_num_out ) ) history_budget_histfile_num_out = history_budget_histfile_num - if ( present(thermo_budget_hfile_num_out ) ) thermo_budget_hfile_num_out = thermo_budget_hfile_num if ( present(history_waccm_out ) ) history_waccm_out = history_waccm if ( present(history_waccmx_out ) ) history_waccmx_out = history_waccmx if ( present(history_chemistry_out ) ) history_chemistry_out = history_chemistry diff --git a/src/physics/cam/phys_grid.F90 b/src/physics/cam/phys_grid.F90 index 712421550d..ca1670e4c2 100644 --- a/src/physics/cam/phys_grid.F90 +++ b/src/physics/cam/phys_grid.F90 @@ -498,6 +498,9 @@ subroutine phys_grid_init( ) ! column surface area (from dynamics) real(r8), dimension(:), pointer :: area_d + ! column surface areawt (from dynamics) + real(r8), dimension(:), pointer :: areawt_d + ! column integration weight (from dynamics) real(r8), dimension(:), allocatable :: wght_d @@ -1147,7 +1150,6 @@ subroutine phys_grid_init( ) ! Note that if the dycore is using the same points as the physics grid, ! it will have already set up 'lat' and 'lon' axes for the physics grid ! However, these will be in the dynamics decomposition - if (unstructured) then lon_coord => horiz_coord_create('lon', 'ncol', num_global_phys_cols, & 'longitude', 'degrees_east', 1, size(lonvals), lonvals, & @@ -1188,13 +1190,13 @@ subroutine phys_grid_init( ) do i = 1, size(copy_attributes) call cam_grid_attribute_copy(copy_gridname, 'physgrid', copy_attributes(i)) end do - if ((.not. cam_grid_attr_exists('physgrid', 'area')) .and. unstructured) then ! Physgrid always needs an area attribute. If we did not inherit one ! from the dycore (i.e., physics and dynamics are on different grids), ! create that attribute here (unstructured grids only, physgrid is ! not supported for structured grids). allocate(area_d(size(grid_map, 2))) + allocate(areawt_d(size(grid_map, 2))) p = 0 do lcid = begchunk, endchunk ncols = lchunks(lcid)%ncols @@ -1203,16 +1205,21 @@ subroutine phys_grid_init( ) cid = lchunks(lcid)%cid do i = 1, chunks(cid)%ncols area_d(p + i) = lchunks(lcid)%area(i) + areawt_d(p + i) = lchunks(lcid)%wght(i) end do if (pcols > ncols) then ! Need to set these to detect unused columns area_d(p+ncols+1:p+pcols) = 0.0_r8 + areawt_d(p+ncols+1:p+pcols) = 0.0_r8 end if p = p + pcols end do call cam_grid_attribute_register('physgrid', 'area', & 'physics column areas', 'ncol', area_d, map=grid_map(3,:)) + call cam_grid_attribute_register('physgrid', 'areawt', & + 'physics column area wts', 'ncol', areawt_d, map=grid_map(3,:)) nullify(area_d) ! Belongs to attribute now + nullify(areawt_d) ! Belongs to attribute now end if ! Cleanup pointers (they belong to the grid now) nullify(grid_map) diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index dfec1738a7..03ed21f779 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -13,7 +13,7 @@ module physpkg use shr_kind_mod, only: r8 => shr_kind_r8 use spmd_utils, only: masterproc - use physconst, only: latvap, latice, rh2o + use physconst, only: latvap, latice use physics_types, only: physics_state, physics_tend, physics_state_set_grid, & physics_ptend, physics_tend_init, physics_update, & physics_type_alloc, physics_ptend_dealloc,& @@ -21,7 +21,7 @@ module physpkg use phys_grid, only: get_ncols_p use phys_gmean, only: gmean_mass use ppgrid, only: begchunk, endchunk, pcols, pver, pverp, psubcols - use constituents, only: pcnst, cnst_name, cnst_get_ind + use constituents, only: pcnst, cnst_get_ind use camsrfexch, only: cam_out_t, cam_in_t use cam_control_mod, only: ideal_phys, adiabatic @@ -111,8 +111,7 @@ subroutine phys_register use physics_buffer, only: pbuf_init_time, pbuf_cam_snapshot_register use physics_buffer, only: pbuf_add_field, dtype_r8, pbuf_register_subcol use shr_kind_mod, only: r8 => shr_kind_r8 - use spmd_utils, only: masterproc - use constituents, only: pcnst, cnst_add, cnst_chk_dim, cnst_name + use constituents, only: pcnst, cnst_add, cnst_chk_dim use cam_control_mod, only: moist_physics use chemistry, only: chem_register @@ -123,7 +122,7 @@ subroutine phys_register use macrop_driver, only: macrop_driver_register use clubb_intr, only: clubb_register_cam use conv_water, only: conv_water_register - use physconst, only: mwdry, cpair, mwh2o, cpwv + use physconst, only: mwh2o, cpwv use tracers, only: tracers_register use check_energy, only: check_energy_register use carma_intr, only: carma_register @@ -138,7 +137,6 @@ subroutine phys_register use flux_avg, only: flux_avg_register use iondrag, only: iondrag_register use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_reg - use string_utils, only: to_lower use prescribed_ozone, only: prescribed_ozone_register use prescribed_volcaero,only: prescribed_volcaero_register use prescribed_strataero,only: prescribed_strataero_register @@ -363,7 +361,7 @@ end subroutine phys_register subroutine phys_inidat( cam_out, pbuf2d ) use cam_abortutils, only: endrun - use physics_buffer, only: pbuf_get_index, pbuf_get_field, physics_buffer_desc, pbuf_set_field, dyn_time_lvls + use physics_buffer, only: pbuf_get_index, physics_buffer_desc, pbuf_set_field, dyn_time_lvls use cam_initfiles, only: initial_file_get_id, topo_file_get_id @@ -379,11 +377,10 @@ subroutine phys_inidat( cam_out, pbuf2d ) type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk) type(physics_buffer_desc), pointer :: pbuf2d(:,:) - integer :: lchnk, m, n, i, k, ncol + integer :: lchnk, m, n, ncol type(file_desc_t), pointer :: fh_ini, fh_topo character(len=8) :: fieldname real(r8), pointer :: tptr(:,:), tptr_2(:,:), tptr3d(:,:,:), tptr3d_2(:,:,:) - real(r8), pointer :: qpert(:,:) character(len=11) :: subname='phys_inidat' ! subroutine name integer :: tpert_idx, qpert_idx, pblh_idx @@ -710,9 +707,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) !----------------------------------------------------------------------- use physics_buffer, only: physics_buffer_desc, pbuf_initialize, pbuf_get_index - use physconst, only: rair, cpair, gravit, stebol, tmelt, & - latvap, latice, rh2o, rhoh2o, pstd, zvir, & - karman, rhodair + use physconst, only: rair, cpair, gravit, zvir, karman use cam_thermo, only: cam_thermo_init use ref_pres, only: pref_edge, pref_mid @@ -752,14 +747,13 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use pbl_utils, only: pbl_utils_init use vertical_diffusion, only: vertical_diffusion_init use phys_debug_util, only: phys_debug_init - use phys_debug, only: phys_debug_state_init use rad_constituents, only: rad_cnst_init use aer_rad_props, only: aer_rad_props_init use subcol, only: subcol_init use qbo, only: qbo_init use qneg_module, only: qneg_init use lunar_tides, only: lunar_tides_init - use iondrag, only: iondrag_init, do_waccm_ions + use iondrag, only: iondrag_init #if ( defined OFFLINE_DYN ) use metdata, only: metdata_phys_init #endif @@ -774,9 +768,10 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use cam_abortutils, only: endrun use nudging, only: Nudge_Model, nudging_init use cam_snapshot, only: cam_snapshot_init - use cam_history, only: addfld, register_vector_field, add_default, horiz_only + use cam_history, only: addfld, register_vector_field, add_default use phys_control, only: phys_getopts use phys_grid_ctem, only: phys_grid_ctem_init + use budgets, only: budget_init ! Input/output arguments type(physics_state), pointer :: phys_state(:) @@ -794,18 +789,13 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! temperature, water vapor, cloud ! ice, cloud liquid, U, V integer :: history_budget_histfile_num ! output history file number for budget fields - character*32 :: budget_name ! parameterization name for fluxes - character*128 :: budget_longname ! parameterization name for fluxes - !----------------------------------------------------------------------- call physics_type_alloc(phys_state, phys_tend, begchunk, endchunk, pcols) do lchnk = begchunk, endchunk call physics_state_set_grid(lchnk, phys_state(lchnk)) -!jt call check_energy_budget_state_init(phys_state(lchnk)) end do -!jt call check_energy_budgets_init() !------------------------------------------------------------------------------------------- ! Initialize any variables in cam_thermo which are not temporally and/or spatially constant @@ -981,6 +971,9 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! Initialize the snapshot capability call cam_snapshot_init(cam_in, cam_out, pbuf2d, begchunk) + ! Initialize the budget capability + call budget_init() + ! addfld calls for U, V tendency budget variables that are output in ! tphysac, tphysbc call addfld ( 'UTEND_DCONV', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by deep convection') @@ -1064,10 +1057,8 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) ! First part of atmospheric physics package before updating of surface models ! !----------------------------------------------------------------------- - use budgets, only: budget_write use time_manager, only: get_nstep use cam_diagnostics,only: diag_allocate, diag_physvar_ic -!jt use check_energy, only: check_energy_gmean, check_energy_phys_budget_update, check_energy_phys_cnt_update use check_energy, only: check_energy_gmean use phys_control, only: phys_getopts use spcam_drivers, only: tphysbc_spcam @@ -1098,7 +1089,6 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) !---------------------------Local workspace----------------------------- ! integer :: c ! indices - integer :: ncol ! number of columns integer :: nstep ! current timestep number logical :: use_spcam type(physics_buffer_desc), pointer :: phys_buffer_chunk(:) @@ -1122,17 +1112,6 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) call t_startf ('chk_en_gmean') call check_energy_gmean(phys_state, pbuf2d, ztodt, nstep) call t_stopf ('chk_en_gmean') -!!$ call t_startf ('chk_en_p_budget_update') -!!$ if(budget_write()) then -!!$ call check_energy_phys_budget_update(phys_state, ztodt, nstep) -!!$ else -!!$ call check_energy_phys_cnt_update(phys_state) -!!$ end if -!!$ call t_stopf ('chk_en_p_budget_update') - - call t_stopf ('physpkg_st1') - - call t_startf ('physpkg_st1') call pbuf_allocate(pbuf2d, 'physpkg') call diag_allocate() @@ -1217,7 +1196,6 @@ subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, & use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_deallocate, pbuf_update_tim_idx use mo_lightning, only: lightning_no_prod use cam_diagnostics, only: diag_deallocate, diag_surf - use physconst, only: stebol, latvap use carma_intr, only: carma_accumulate_stats use spmd_utils, only: mpicom use iop_forcing, only: scam_use_iop_srf @@ -1433,20 +1411,16 @@ subroutine tphysac (ztodt, cam_in, & ! type(physics_ptend) :: ptend ! indivdual parameterization tendencies - integer :: nstep ! current timestep number - real(r8) :: zero(pcols) ! array of zeros + integer :: nstep ! current timestep number + real(r8) :: zero(pcols) ! array of zeros - integer :: lchnk ! chunk identifier - integer :: ncol ! number of atmospheric columns - integer i,k,m ! Longitude, level indices - integer :: yr, mon, day, tod ! components of a date - integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water. + integer :: lchnk ! chunk identifier + integer :: ncol ! number of atmospheric columns + integer :: i,k ! Longitude, level indices integer :: ixq - logical :: labort ! abort flag + logical :: labort ! abort flag - real(r8) tvm(pcols,pver) ! virtual temperature - real(r8) prect(pcols) ! total precipitation real(r8) surfric(pcols) ! surface friction velocity real(r8) obklen(pcols) ! Obukhov length real(r8) :: fh2o(pcols) ! h2o flux to balance source from methane chemistry @@ -2015,11 +1989,11 @@ subroutine tphysbc (ztodt, state, & use physics_types, only: physics_state, physics_tend, physics_ptend, & physics_update, physics_ptend_init, physics_ptend_sum, & physics_state_check, physics_ptend_scale, & - phys_te_idx, dyn_te_idx + dyn_te_idx use cam_diagnostics, only: diag_conv_tend_ini, diag_phys_writeout, diag_conv, diag_export, diag_state_b4_phys_write use cam_diagnostics, only: diag_clip_tend_writeout use cam_history, only: outfld - use physconst, only: cpair, latvap + use physconst, only: latvap use constituents, only: pcnst, qmin, cnst_get_ind use air_composition, only: thermodynamic_active_species_liq_num,thermodynamic_active_species_liq_idx use air_composition, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_ice_idx @@ -2161,8 +2135,6 @@ subroutine tphysbc (ztodt, state, & type(check_tracers_data):: tracerint ! energy integrals and cummulative boundary fluxes real(r8) :: zero_tracers(pcols,pcnst) - logical :: lq(pcnst) - !----------------------------------------------------------------------- call t_startf('bc_init') @@ -2889,7 +2861,6 @@ subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) ! datasets. ! !----------------------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 use chemistry, only: chem_timestep_init use chem_surfvals, only: chem_surfvals_set use physics_types, only: physics_state diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index 8155ea45f8..795de5035d 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -147,7 +147,6 @@ subroutine phys_register use subcol_utils, only: is_subcol_on, subcol_get_scheme use dyn_comp, only: dyn_register use offline_driver, only: offline_driver_reg - use budgets, only: budget_add !---------------------------Local variables----------------------------- ! @@ -177,28 +176,6 @@ subroutine phys_register ! Register the subcol scheme call subcol_register() -!!$ ! Register stages for budgets. -!!$ call budget_add('phAP','phy',longname='vertically integrated phys energy after physics',outfld=.true.) -!!$ call budget_add('dyAP','phy',longname='vertically integrated dyn energy after physics',outfld=.true.) -!!$ call budget_add('phBP','phy',longname='vertically integrated phys energy before physics',outfld=.true.) -!!$ call budget_add('dyBP','phy',longname='vertically integrated dyn energy before physics',outfld=.true.) -!!$ call budget_add('phBF','phy',longname='vertically integrated phys energy before fixer',outfld=.true.) -!!$ call budget_add('dyBF','phy',longname='vertically integrated dyn energy before fixer',outfld=.true.) -!!$ call budget_add('phAM','phy',longname='vertically integrated phys energy after dry mass adj',outfld=.true.) -!!$ call budget_add('dyAM','phy',longname='vertically integrated dyn energy after dry mass adj',outfld=.true.) -!!$ -!!$ ! Register budgets. -!!$ call budget_add('BP_param_and_efix','phAP','phBF','phy','dif',longname='dE/dt CAM physics parameterizations + efix dycore E (phAP-phBF)',outfld=.true.) -!!$ call budget_add('BP_phy_params','phAP','phBP','phy','dif',longname='dE/dt CAM physics parameterizations (phAP-phBP)',outfld=.true.) -!!$ call budget_add('BD_phy_params','dyAP','dyBP','phy','dif',longname='dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)',outfld=.true.) -!!$ call budget_add('BP_pwork','phAM','phAP','phy','dif',longname='dE/dt dry mass adjustment (phAM-phAP)',outfld=.true.) -!!$ call budget_add('BD_pwork','dyAM','dyAP','phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)',outfld=.true.) -!!$ call budget_add('BP_efix','phBP','phBF','phy','dif',longname='dE/dt energy fixer (phBP-phBF)',outfld=.true.) -!!$ call budget_add('BD_efix','dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E (dyBP-dyBF)',outfld=.true.) -!!$ call budget_add('BP_phys_tot','phAM','phBF','phy','dif',longname='dE/dt physics total (phAM-phBF)',outfld=.true.) -!!$ call budget_add('BD_phys_tot','dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)',outfld=.true.) -!!$ call budget_add('BD_param_and_efix','dyAP','dyBF','phy','dif',longname='dE/dt parameterizations + efix dycore E (dyAP-dyBF)',outfld=.true.) - ! Register water vapor. ! ***** N.B. ***** This must be the first call to cnst_add so that ! water vapor is constituent 1. @@ -776,8 +753,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use nudging, only: Nudge_Model, nudging_init use cam_snapshot, only: cam_snapshot_init use cam_history, only: addfld, register_vector_field, add_default - use budgets, only: budget_num, budget_info, budget_outfld, budget_init - use check_energy, only: check_energy_budgets_init, check_energy_budget_state_init + use budgets, only: budget_init ! Input/output arguments type(physics_state), pointer :: phys_state(:) @@ -795,8 +771,6 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! temperature, water vapor, cloud ! ice, cloud liquid, U, V integer :: history_budget_histfile_num ! output history file number for budget fields - character*32 :: budget_name ! parameterization name for fluxes - character*128 :: budget_longname ! parameterization name for fluxes !----------------------------------------------------------------------- @@ -804,9 +778,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) do lchnk = begchunk, endchunk call physics_state_set_grid(lchnk, phys_state(lchnk)) - call check_energy_budget_state_init(phys_state(lchnk)) end do - call check_energy_budgets_init() !------------------------------------------------------------------------------------------- ! Initialize any variables in cam_thermo which are not temporally and/or spatially constant @@ -964,6 +936,9 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! Initialize the snapshot capability call cam_snapshot_init(cam_in, cam_out, pbuf2d, begchunk) + ! Initialize the budget capability + call budget_init() + ! addfld calls for U, V tendency budget variables that are output in ! tphysac, tphysbc call addfld ( 'UTEND_DCONV', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by deep convection') @@ -1047,10 +1022,9 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) ! First part of atmospheric physics package before updating of surface models ! !----------------------------------------------------------------------- - use budgets, only: budget_write use time_manager, only: get_nstep use cam_diagnostics,only: diag_allocate, diag_physvar_ic - use check_energy, only: check_energy_gmean, check_energy_phys_budget_update, check_energy_phys_cnt_update + use check_energy, only: check_energy_gmean use spmd_utils, only: mpicom use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_allocate #if (defined BFB_CAM_SCAM_IOP ) @@ -1101,13 +1075,6 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) call t_startf ('chk_en_gmean') call check_energy_gmean(phys_state, pbuf2d, ztodt, nstep) call t_stopf ('chk_en_gmean') - call t_startf ('chk_en_p_budget_update') - if(budget_write()) then - call check_energy_phys_budget_update(phys_state, ztodt, nstep) - else - call check_energy_phys_cnt_update(phys_state) - end if - call t_stopf ('chk_en_p_budget_update') call pbuf_allocate(pbuf2d, 'physpkg') call diag_allocate() diff --git a/src/utils/cam_grid_support.F90 b/src/utils/cam_grid_support.F90 index 7e61a44cb3..d3f8b0a12c 100644 --- a/src/utils/cam_grid_support.F90 +++ b/src/utils/cam_grid_support.F90 @@ -315,7 +315,7 @@ end subroutine print_attr_spec ! Functions for dealing with patch masks public :: cam_grid_compute_patch ! Functions for dealing with grid areas - public :: cam_grid_get_area + public :: cam_grid_get_areawt interface cam_grid_attribute_register module procedure add_cam_grid_attribute_0d_int @@ -1618,54 +1618,54 @@ function cam_grid_get_lonvals(id) result(lonvals) end if end function cam_grid_get_lonvals - function cam_grid_get_area(id) result(areavals) + function cam_grid_get_areawt(id) result(wtvals) ! Dummy argument integer, intent(in) :: id - real(r8), pointer :: areavals(:) + real(r8), pointer :: wtvals(:) ! Local variables - character(len=max_chars) :: areaname + character(len=max_chars) :: wtname integer :: gridind - type(cam_grid_attribute_1d_r8_t), pointer :: attrptr_r8 class(cam_grid_attribute_t), pointer :: attrptr character(len=120) :: errormsg - nullify(attrptr_r8) nullify(attrptr) gridind = get_cam_grid_index(id) if (gridind > 0) then select case(cam_grids(gridind)%name) case('GLL') - areaname='area_d' + wtname='area_weight_gll' case('INI') - areaname='area' + wtname='area_weight_ini' + case('physgrid') + wtname='areawt' case('FVM') - areaname='area_fvm' + wtname='area_weight_fvm' + case('mpas_cell') + wtname='area_weight_mpas' case default - call endrun('cam_grid_get_area: Invalid gridname:'//trim(cam_grids(gridind)%name)) + call endrun('cam_grid_get_areawt: Invalid gridname:'//trim(cam_grids(gridind)%name)) end select - call find_cam_grid_attr(gridind, trim(areaname), attrptr) + call find_cam_grid_attr(gridind, trim(wtname), attrptr) if (.not.associated(attrptr)) then write(errormsg, '(4a)') & - 'cam_grid_get_area: error retrieving area ', trim(areaname), & + 'cam_grid_get_areawt: error retrieving weight attribute ', trim(wtname), & ' for cam grid ', cam_grids(gridind)%name call endrun(errormsg) else call attrptr%print_attr() select type(attrptr) type is (cam_grid_attribute_1d_r8_t) - !jt attrptr_r8 => attrptr - areavals => attrptr%values + wtvals => attrptr%values class default - call endrun('cam_grid_get_area: area attribute is not a real datatype') -!jt areavals => null() + call endrun('cam_grid_get_areawt: wt attribute is not a real datatype') end select end if end if - end function cam_grid_get_area + end function cam_grid_get_areawt ! Find the longitude and latitude of a range of map entries ! beg and end are the range of the first source index. blk is a block or chunk index @@ -2075,7 +2075,7 @@ subroutine add_cam_grid_attribute_1d_r8(gridname, name, long_name, & character(len=120) :: errormsg integer :: gridind integer :: dimsize - + if (masterproc) write(iulog,*)'adding cam_grid_attribute gridname,name,dimname=',gridname,name,dimname gridind = get_cam_grid_index(trim(gridname)) if (gridind > 0) then call find_cam_grid_attr(gridind, trim(name), attptr) @@ -2176,7 +2176,6 @@ subroutine write_cam_grid_attr_0d_int(attr, File) type(file_desc_t), intent(inout) :: File ! PIO file Handle ! Local variables - character(len=120) :: errormsg integer :: attrtype integer(imap) :: attrlen integer :: ierr @@ -2223,7 +2222,6 @@ subroutine write_cam_grid_attr_0d_char(attr, File) type(file_desc_t), intent(inout) :: File ! PIO file Handle ! Local variables - character(len=120) :: errormsg integer :: attrtype integer(imap) :: attrlen integer :: ierr @@ -2386,7 +2384,6 @@ end subroutine cam_grid_attribute_copy !--------------------------------------------------------------------------- subroutine cam_grid_write_attr(File, grid_id, header_info) use pio, only: file_desc_t, PIO_BCAST_ERROR, pio_seterrorhandling - use pio, only: pio_inq_dimid ! Dummy arguments type(file_desc_t), intent(inout) :: File ! PIO file Handle @@ -2465,14 +2462,13 @@ subroutine cam_grid_write_attr(File, grid_id, header_info) end subroutine cam_grid_write_attr subroutine write_cam_grid_val_0d_int(attr, File) - use pio, only: file_desc_t, pio_inq_varid, pio_put_var + use pio, only: file_desc_t, pio_put_var ! Dummy arguments class(cam_grid_attribute_0d_int_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File ! Local variables - character(len=120) :: errormsg integer :: ierr ! We only write this var if it is a variable @@ -2499,7 +2495,7 @@ end subroutine write_cam_grid_val_0d_char subroutine write_cam_grid_val_1d_int(attr, File) use pio, only: file_desc_t, pio_put_var, pio_int, & - pio_inq_varid, pio_write_darray, io_desc_t, pio_freedecomp + pio_write_darray, io_desc_t, pio_freedecomp use cam_pio_utils, only: cam_pio_newdecomp ! Dummy arguments @@ -2507,7 +2503,6 @@ subroutine write_cam_grid_val_1d_int(attr, File) type(file_desc_t), intent(inout) :: File ! Local variables - character(len=120) :: errormsg integer :: ierr type(io_desc_t), pointer :: iodesc @@ -2537,7 +2532,7 @@ end subroutine write_cam_grid_val_1d_int subroutine write_cam_grid_val_1d_r8(attr, File) use pio, only: file_desc_t, pio_put_var, pio_double, & - pio_inq_varid, pio_write_darray, io_desc_t, pio_freedecomp + pio_write_darray, io_desc_t, pio_freedecomp use cam_pio_utils, only: cam_pio_newdecomp ! Dummy arguments @@ -2545,7 +2540,6 @@ subroutine write_cam_grid_val_1d_r8(attr, File) type(file_desc_t), intent(inout) :: File ! Local variables - character(len=120) :: errormsg integer :: ierr type(io_desc_t), pointer :: iodesc @@ -3050,7 +3044,7 @@ subroutine cam_grid_find_dimids(this, File, dimids) integer, intent(out) :: dimids(:) ! Local vaariables - integer :: dsize, ierr + integer :: ierr integer :: err_handling character(len=max_hcoordname_len) :: dimname1, dimname2 @@ -3931,8 +3925,6 @@ subroutine cam_grid_patch_get_decomp(this, field_lens, file_lens, dtype, & end subroutine cam_grid_patch_get_decomp subroutine cam_grid_patch_compact(this, collected_output) - use spmd_utils, only: mpi_sum, mpi_integer, mpicom - use shr_mpi_mod, only: shr_mpi_chkerr ! Dummy arguments class(cam_grid_patch_t) :: this diff --git a/src/utils/cam_thermo.F90 b/src/utils/cam_thermo.F90 index 8623b6fce7..8d053725c4 100644 --- a/src/utils/cam_thermo.F90 +++ b/src/utils/cam_thermo.F90 @@ -7,7 +7,6 @@ module cam_thermo use air_composition, only: thermodynamic_active_species_idx use air_composition, only: thermodynamic_active_species_idx_dycore use air_composition, only: thermodynamic_active_species_cp - use air_composition, only: thermodynamic_active_species_cv use air_composition, only: thermodynamic_active_species_R use air_composition, only: thermodynamic_active_species_mwi use air_composition, only: thermodynamic_active_species_kv @@ -209,7 +208,6 @@ module cam_thermo subroutine cam_thermo_init() use shr_infnan_mod, only: assignment(=), shr_infnan_qnan use ppgrid, only: pcols, pver, pverp, begchunk, endchunk - use physconst, only: cpair, rair, mwdry integer :: ierr character(len=*), parameter :: subname = "cam_thermo_init" @@ -719,7 +717,6 @@ subroutine get_pmid_from_dpdry_1hd(tracer, mixing_ratio, active_species_idx, dp_ real(r8) :: dp_local(SIZE(tracer, 1), SIZE(tracer, 2)) ! local pressure level thickness real(r8) :: pint_local(SIZE(tracer, 1), SIZE(tracer, 2) + 1)! local interface pressure - integer :: kdx call get_dp(tracer, mixing_ratio, active_species_idx, dp_dry, dp_local) From f24b0f2665a6bcc13ee368128f7b28118eb1f791 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 24 Feb 2023 16:01:57 -0700 Subject: [PATCH 065/140] infrastructure for more accurate energy computation for MPAS; futher improvements to log file output for SE --- src/dynamics/se/dp_coupling.F90 | 4 +- src/dynamics/se/dycore_budget.F90 | 129 +++++++++++++++++++----------- src/physics/cam/check_energy.F90 | 12 +-- src/physics/cam/physpkg.F90 | 2 +- src/physics/cam_dev/physpkg.F90 | 2 +- src/utils/air_composition.F90 | 48 ++++++----- src/utils/cam_thermo.F90 | 7 +- 7 files changed, 128 insertions(+), 76 deletions(-) diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index 45231b17e6..66f8e697fd 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -551,7 +551,7 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) use hycoef, only: hyai, ps0 use shr_vmath_mod, only: shr_vmath_log use qneg_module, only: qneg3 - + use dyn_tests_utils, only: vc_dry_pressure ! arguments type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend @@ -665,7 +665,7 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) ! update cp_dycore in modeule air_composition. ! (note: at this point q is dry) ! - call cam_thermo_water_update(phys_state(lchnk)%q(1:ncol,:,:), lchnk, ncol) + call cam_thermo_water_update(phys_state(lchnk)%q(1:ncol,:,:), lchnk, ncol, vc_dry_pressure) do k = 1, nlev do i = 1, ncol phys_state(lchnk)%exner(i,k) = (phys_state(lchnk)%pint(i,pver+1) & diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index dc8c209abb..44316b6e22 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -9,7 +9,6 @@ module dycore_budget real(r8), save :: previous_dEdt_adiabatic_dycore = 0.0_r8 real(r8), save :: previous_dEdt_dry_mass_adjust = 0.0_r8 real(r8), save :: previous_dEdt_phys_dyn_coupl_err = 0.0_r8 - !========================================================================================= contains !========================================================================================= @@ -25,6 +24,8 @@ subroutine print_budget() use control_mod, only: ftype use cam_thermo, only: teidx, seidx, keidx, poidx use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv + use time_manager, only: get_step_size + use budgets, only: thermo_budget_averaging_option, thermo_budget_averaging_n ! Local variables integer :: i character(len=*), parameter :: subname = 'check_energy:print_budgets' @@ -35,7 +36,7 @@ subroutine print_budget() real(r8), dimension(4) :: se_phys_total !jt real(r8) :: se_phys_total,se_dmea,se_phys_total, dycore, err, param, pefix, & - real(r8) :: dycore, err, param, pefix, & + real(r8) :: dycore, err, param, pefix, E_dyAP,& pdmea, phys_total, dyn_total, dyn_phys_total, & rate_of_change_2D_dyn, rate_of_change_vertical_remapping, & diffusion_del4, diffusion_fric, diffusion_del4_tot, diffusion_sponge, & @@ -47,7 +48,7 @@ subroutine print_budget() error, mass_change__physics, dbd, daf, dar, dad, qneg, val,phbf,ded real(r8) :: E_dBF(4), E_phBF, diff, tmp - real(r8) :: E_dyBF(4) + real(r8) :: E_dyBF(4), dtime integer :: m_cnst character(LEN=*), parameter :: fmt = "(a40,a15,a1,F6.2,a1,F6.2,a1,E10.2,a5)" character(LEN=*), parameter :: fmt2 = "(a40,F6.2,a3)" @@ -56,6 +57,8 @@ subroutine print_budget() !-------------------------------------------------------------------------------------- if (masterproc) then + dtime = REAL(get_step_size()) + idx(1) = teidx !total energy index idx(2) = seidx !enthaly index idx(3) = keidx !kinetic energy index @@ -90,6 +93,8 @@ subroutine print_budget() call budget_get_global('dBF' ,idx(i),E_dBF(i)) !state passed to physics end do + call budget_get_global('dyAP',teidx,E_dyAP) + call budget_get_global('dBF-dED',teidx,dyn_total) call budget_get_global('dAD-dBD',teidx,rate_of_change_2D_dyn) call budget_get_global('dAR-dAD',teidx,rate_of_change_vertical_remapping) @@ -201,6 +206,9 @@ subroutine print_budget() write(iulog,*) " " end do write(iulog,*)" " + ! + ! these diagnostics only make sense time-step to time-step + ! write(iulog,*)" " write(iulog,*)"Some energy budget observations:" write(iulog,*)"--------------------------------" @@ -213,24 +221,45 @@ subroutine print_budget() write(iulog,*) " " write(iulog,*) "(equation 23 in Lauritzen and Williamson (2019))" write(iulog,*) " " + tmp = previous_dEdt_phys_dyn_coupl_err+previous_dEdt_adiabatic_dycore+previous_dEdt_dry_mass_adjust diff = abs_diff(-dy_EFIX(1),tmp,pf) - write(iulog,*) "Check if that is the case:", pf, diff - write(iulog,*) " " - - - if (abs(diff)>eps) then + if (ntrac==0) then + write(iulog,*) "Check if that is the case:", pf, diff + write(iulog,*) " " + if (abs(diff)>eps) then + write(iulog,*) "dE/dt energy fixer(t=n) = ",dy_EFIX(1) + write(iulog,*) "dE/dt dry mass adjustment (t=n-1) = ",previous_dEdt_dry_mass_adjust + write(iulog,*) "dE/dt adiabatic dycore (t=n-1) = ",previous_dEdt_adiabatic_dycore + write(iulog,*) "dE/dt physics-dynamics coupling errors (t=n-1) = ",previous_dEdt_phys_dyn_coupl_err + ! call endrun(subname//"Error in energy fixer budget") + end if + else + previous_dEdt_phys_dyn_coupl_err = dy_EFIX(1)+previous_dEdt_dry_mass_adjust+previous_dEdt_adiabatic_dycore write(iulog,*) "dE/dt energy fixer(t=n) = ",dy_EFIX(1) write(iulog,*) "dE/dt dry mass adjustment (t=n-1) = ",previous_dEdt_dry_mass_adjust write(iulog,*) "dE/dt adiabatic dycore (t=n-1) = ",previous_dEdt_adiabatic_dycore write(iulog,*) "dE/dt physics-dynamics coupling errors (t=n-1) = ",previous_dEdt_phys_dyn_coupl_err -! call endrun(subname//"Error in energy fixer budget") + write(iulog,*) " " + write(iulog,*) "Note: when running CSLAM the physics-dynamics coupling error is diagnosed" + write(iulog,*) " (using equation above) rather than explicitly computed" + write(iulog,*) " " + write(iulog,*) " " + write(iulog,*) "Physics-dynamics coupling errors include: " + write(iulog,*) " " + write(iulog,*) " -dE/dt adiabatic dycore is computed on GLL grid;" + write(iulog,*) " error in mapping to physics grid" + write(iulog,*) " -dE/dt physics tendencies mapped to GLL grid" + write(iulog,*) " (tracer tendencies mapped non-conservatively!)" + write(iulog,*) " -dE/dt dynamics state mapped to GLL grid" end if write(iulog,*) "" - dycore = -dy_EFIX(1)-previous_dEdt_phys_dyn_coupl_err-previous_dEdt_dry_mass_adjust - write(iulog,*) "Hence the dycore E dissipation estimated from energy fixer " - write(iulog,*) "based on previous time-step values is ",dycore," W/M^2" - write(iulog,*) " " + if (ntrac==0) then + dycore = -dy_EFIX(1)-previous_dEdt_phys_dyn_coupl_err-previous_dEdt_dry_mass_adjust + write(iulog,*) "Hence the dycore E dissipation estimated from energy fixer " + write(iulog,*) "based on previous time-step values is ",dycore," W/M^2" + write(iulog,*) " " + end if write(iulog,*) " " write(iulog,*) "-------------------------------------------------------------------" write(iulog,*) " Consistency check 1: state passed to physics same as end dynamics?" @@ -271,23 +300,33 @@ subroutine print_budget() write(iulog,*) " " end do end if + write(iulog,*)" " write(iulog,*)"-------------------------------------------------------------------------" write(iulog,*)" Consistency check 2: total energy increment in dynamics same as physics?" write(iulog,*)"-------------------------------------------------------------------------" write(iulog,*)" " - write(iulog,'(a46,F6.2,a6)')"dE/dt physics tendency in dynamics (dBD-dAF) ",se_phys_total(1)," W/M^2" - write(iulog,'(a46,F6.2,a6)')"dE/dt physics tendency in physics (dyAM-dyBF) ",dy_phys_total(1)," W/M^2" - write(iulog,*)" " - previous_dEdt_phys_dyn_coupl_err = se_phys_total(1)-dy_phys_total(1) - diff = abs_diff(dy_phys_total(1),se_phys_total(1),pf=pf) - write(iulog,*)"dE/dt physics-dynamics coupling errors ",diff," W/M^2 " - write(iulog,*) pf - if (abs(diff)>eps) then - ! - ! if errors print details - ! - if (ntrac==0) then + if (ntrac>0) then + write(iulog,'(a46,F6.2,a6)')"dE/dt physics tendency in dynamics (dBD-dAF) ",se_phys_total(1)," W/M^2" + write(iulog,'(a46,F6.2,a6)')"dE/dt physics tendency in physics (dyAM-dyBF) ",dy_phys_total(1)," W/M^2" + write(iulog,*)" " + write(iulog,*) " When runnig with a physics grid this consistency check does not make sense" + write(iulog,*) " since it is computed on the GLL grid whereas we enforce energy conservation" + write(iulog,*) " on the physics grid. To assess the errors of running dynamics on GLL" + write(iulog,*) " grid, tracers on CSLAM grid and physics on physics grid we use the energy" + write(iulog,*) " fixer check from above:" + write(iulog,*) " " + write(iulog,*) " dE/dt physics-dynamics coupling errors (t=n-1) =",previous_dEdt_phys_dyn_coupl_err + write(iulog,*) "" + else + previous_dEdt_phys_dyn_coupl_err = se_phys_total(1)-dy_phys_total(1) + diff = abs_diff(dy_phys_total(1),se_phys_total(1),pf=pf) + write(iulog,*)"dE/dt physics-dynamics coupling errors ",diff," W/M^2 " + write(iulog,*) pf + if (abs(diff)>eps) then + ! + ! if errors print details + ! if (ftype==1) then write(iulog,*) "" write(iulog,*) "You are using ftype==1 so physics-dynamics coupling errors should be round-off!" @@ -301,22 +340,22 @@ subroutine print_budget() write(iulog,*) "Break-down below:" write(iulog,*) "" end if - else - write(iulog,*)" " - write(iulog,*)"Since you are using a separate physics grid, the physics tendencies" - write(iulog,*)"in the dynamical core will not match due to the tendencies being" - write(iulog,*)"interpolated from the physics to the dynamics grid:" - write(iulog,*)" " +! else +! write(iulog,*)" " +! write(iulog,*)"Since you are using a separate physics grid, the physics tendencies" +! write(iulog,*)"in the dynamical core will not match due to the tendencies being" +! write(iulog,*)"interpolated from the physics to the dynamics grid:" +! write(iulog,*)" " + do i=1,4 + write(iulog,*) str(i),":" + write(iulog,*) "======" + diff = abs_diff(dy_phys_total(i),se_phys_total(i),pf=pf) + write(iulog,*) "dE/dt physics-dynamics coupling errors (diff) ",diff + write(iulog,*) "dE/dt physics tendency in dynamics (dBD-dAF) ",se_phys_total(i) + write(iulog,*) "dE/dt physics tendency in physics (pAM-pBF) ",dy_phys_total(i) + write(iulog,*) " " + end do end if - do i=1,4 - write(iulog,*) str(i),":" - write(iulog,*) "======" - diff = abs_diff(dy_phys_total(i),se_phys_total(i),pf=pf) - write(iulog,*) "dE/dt physics-dynamics coupling errors (diff) ",diff - write(iulog,*) "dE/dt physics tendency in dynamics (dBD-dAF) ",se_phys_total(i) - write(iulog,*) "dE/dt physics tendency in physics (pAM-pBF) ",dy_phys_total(i) - write(iulog,*) " " - end do end if write(iulog,*)" " write(iulog,*)"------------------------------------------------------------" @@ -411,10 +450,9 @@ subroutine print_budget() write(iulog,*) "and beginning of physics (phBF) the same?" write(iulog,*) "" call budget_get_global('dBF' ,teidx,E_dBF) !state passed to physics - call budget_get_global('dyBF' ,teidx,E_dyBF) !state passed to physics call budget_get_global('phBF',teidx,E_phBF)!state beginning physics ! if (abs(E_phBF)>eps) then - diff = abs_diff(E_dBF,E_phBF) + diff = abs_diff(E_dBF(1),E_phBF) if (abs(diff) 0) then ! @@ -651,26 +649,29 @@ subroutine dry_air_composition_update(mmr, lchnk, ncol, to_dry_factor) end subroutine dry_air_composition_update !=========================================================================== - !----------------------------------------------------------------------- - ! dry_air_composition_update: Update the physics "constants" that vary xxx change description - !------------------------------------------------------------------------- + !--------------------------------------------------------------------------- + ! water_composition_update: Update generalized cp or cv depending on dycore + !--------------------------------------------------------------------------- !=========================================================================== - subroutine water_composition_update(mmr, lchnk, ncol, to_dry_factor) + subroutine water_composition_update(mmr, lchnk, ncol, vcoord, to_dry_factor) use cam_abortutils, only: endrun - + use dyn_tests_utils, only: vc_height, vc_moist_pressure, vc_dry_pressure real(r8), intent(in) :: mmr(:,:,:) ! constituents array integer, intent(in) :: lchnk ! Chunk number integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: vcoord real(r8), optional, intent(in) :: to_dry_factor(:,:) - real(r8), dimension(ncol,SIZE(mmr, 2),thermodynamic_active_species_num-dry_air_species_num) :: dry_mmr - integer, dimension(thermodynamic_active_species_num-dry_air_species_num) :: idx_water character(len=*), parameter :: subname = 'water_composition_update' - integer :: i, num_water, idx_cam - call get_cp(mmr(:ncol,:,:),.false.,cpair_dycore(:ncol,:,lchnk), factor=to_dry_factor, & - active_species_idx_dycore=thermodynamic_active_species_idx,cpdry=cpairv(:ncol,:,lchnk)) + if (vcoord==vc_dry_pressure) then + call get_cp(mmr(:ncol,:,:),.false.,cp_or_cv_dycore(:ncol,:,lchnk), factor=to_dry_factor, & + active_species_idx_dycore=thermodynamic_active_species_idx,cpdry=cpairv(:ncol,:,lchnk)) + else if (vcoord==vc_height) then + call get_R(mmr(:ncol,:,:), active_species_idx=thermodynamic_active_species_idx, & + cp_or_cv_dycore(:ncol,:,lchnk), fact=to_dry_factor, rdry=rairv(:ncol,:,lchnk)) + end if end subroutine water_composition_update !=========================================================================== @@ -1004,7 +1005,8 @@ end subroutine get_R_dry_2hd ! !*************************************************************************** ! - subroutine get_R_1hd(tracer, active_species_idx, R, fact) + subroutine get_R_1hd(tracer, active_species_idx, R, fact, Rdry) +! subroutine get_cp_1hd(tracer, cp, factor, active_species_idx_dycore, cpdry) use cam_abortutils, only: endrun use string_utils, only: int2str @@ -1017,6 +1019,7 @@ subroutine get_R_1hd(tracer, active_species_idx, R, fact) real(r8), intent(out) :: R(:, :) ! fact: optional factor for converting tracer to dry mixing ratio real(r8), optional, intent(in) :: fact(:, :) + real(r8), optional, intent(in) :: Rdry(:, :) ! Local variables integer :: qdx, itrac @@ -1035,12 +1038,19 @@ subroutine get_R_1hd(tracer, active_species_idx, R, fact) call endrun(subname//"SIZE mismatch in dimension 2 "// & int2str(SIZE(fact, 2))//' /= '//int2str(SIZE(factor, 2))) end if - call get_R_dry(tracer, active_species_idx, R, fact=fact) factor = fact(:,:) else - call get_R_dry(tracer, active_species_idx, R) factor = 1.0_r8 end if + + if (dry_air_species_num == 0) then + R = rair + else if (present(Rdry)) then + R = Rdry + else + call get_R_dry(tracer, active_species_idx, R, fact=factor) + end if + idx_local = active_species_idx sum_species = 1.0_r8 ! all dry air species sum to 1 do qdx = dry_air_species_num + 1, thermodynamic_active_species_num diff --git a/src/utils/cam_thermo.F90 b/src/utils/cam_thermo.F90 index 5f821e0a21..24faa0f451 100644 --- a/src/utils/cam_thermo.F90 +++ b/src/utils/cam_thermo.F90 @@ -278,7 +278,7 @@ subroutine cam_thermo_dry_air_update(mmr, T, lchnk, ncol, to_dry_factor) active_species_idx_dycore=thermodynamic_active_species_idx) end subroutine cam_thermo_dry_air_update - subroutine cam_thermo_water_update(mmr, lchnk, ncol, to_dry_factor) + subroutine cam_thermo_water_update(mmr, lchnk, ncol, vcoord, to_dry_factor) use air_composition, only: water_composition_update !----------------------------------------------------------------------- ! Update the physics "constants" that vary @@ -289,9 +289,12 @@ subroutine cam_thermo_water_update(mmr, lchnk, ncol, to_dry_factor) real(r8), intent(in) :: mmr(:,:,:) ! constituents array integer, intent(in) :: lchnk ! Chunk number integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: vcoord real(r8), optional, intent(in) :: to_dry_factor(:,:) ! - call water_composition_update(mmr, lchnk, ncol, to_dry_factor=to_dry_factor) + logical :: lcp + + call water_composition_update(mmr, lchnk, ncol, vcoord, to_dry_factor=to_dry_factor) end subroutine cam_thermo_water_update !=========================================================================== From 44b73a5ebc2ea34a2482ea92da3fdaeef5097961 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Sat, 25 Feb 2023 13:17:30 -0700 Subject: [PATCH 066/140] MPAS thermo --- src/dynamics/mpas/dp_coupling.F90 | 128 ++++++++++++++++-------------- src/physics/cam/check_energy.F90 | 10 +-- src/utils/air_composition.F90 | 19 +++-- 3 files changed, 85 insertions(+), 72 deletions(-) diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index 4c300e527c..f7070959a8 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -336,12 +336,12 @@ subroutine derived_phys(phys_state, phys_tend, pbuf2d) use check_energy, only: check_energy_timestep_init use shr_vmath_mod, only: shr_vmath_log use phys_control, only: waccmx_is - use cam_thermo, only: cam_thermo_dry_air_update + use cam_thermo, only: cam_thermo_dry_air_update, cam_thermo_water_update use air_composition, only: rairv, dry_air_species_num use qneg_module, only: qneg3 use shr_const_mod, only: shr_const_rwv use constituents, only: qmin - + use dyn_tests_utils, only: vcoord=>vc_height ! Arguments type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) type(physics_tend ), intent(inout) :: phys_tend(begchunk:endchunk) @@ -432,15 +432,7 @@ subroutine derived_phys(phys_state, phys_tend, pbuf2d) phys_state(lchnk)%exner(:ncol,k) = (pref / phys_state(lchnk)%pmid(:ncol,k))**cappa end do - ! Tracers from MPAS are in dry mixing ratio units. CAM's physics package expects constituents - ! which have been declared to be type 'wet' when they are registered to be represented by mixing - ! ratios based on moist air mass (dry air + water vapor). Do appropriate conversion here. - factor(:ncol,:) = 1._r8/factor(:ncol,:) - do m = 1,pcnst - if (cnst_type(m) == 'wet') then - phys_state(lchnk)%q(:ncol,:,m) = factor(:ncol,:)*phys_state(lchnk)%q(:ncol,:,m) - end if - end do + if (dry_air_species_num>0) then @@ -459,6 +451,20 @@ subroutine derived_phys(phys_state, phys_tend, pbuf2d) else zvirv(:,:) = zvir endif + ! + ! update cp_dycore in modeule air_composition. + ! (note: at this point q is dry) + ! + call cam_thermo_water_update(phys_state(lchnk)%q(1:ncol,:,:), lchnk, ncol, vcoord) + ! Tracers from MPAS are in dry mixing ratio units. CAM's physics package expects constituents + ! which have been declared to be type 'wet' when they are registered to be represented by mixing + ! ratios based on moist air mass (dry air + water vapor). Do appropriate conversion here. + factor(:ncol,:) = 1._r8/factor(:ncol,:) + do m = 1,pcnst + if (cnst_type(m) == 'wet') then + phys_state(lchnk)%q(:ncol,:,m) = factor(:ncol,:)*phys_state(lchnk)%q(:ncol,:,m) + end if + end do ! Compute geopotential height above surface - based on full pressure ! Note that phys_state%zi(:,plev+1) = 0 whereas zint in MPAS is surface height @@ -498,7 +504,7 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn use cam_mpas_subdriver, only : cam_mpas_cell_to_edge_winds, cam_mpas_update_halo use mpas_constants, only : Rv_over_Rd => rvord use time_manager, only : get_step_size - + use air_composition, only: get_R ! Arguments integer, intent(in) :: nCellsSolve integer, intent(in) :: nCells @@ -539,10 +545,13 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn real(r8), pointer :: uy(:,:) real(r8) :: theta_m_new(pver,nCellsSolve) !modified potential temperature after various physics updates real(r8) :: rtheta_param(pver,nCellsSolve)!tendency from temperature change only (for diagnostics) - real(r8) :: qk (thermodynamic_active_species_num,pver,nCellsSolve) !water species before physics (diagnostics) + real(r8) :: Rold(nCellsSolve,pver) + real(r8) :: Rnew(nCellsSolve,pver) + real(r8) :: qk (thermodynamic_active_species_num,pver,nCellsSolve) !water species before physics (diagnostics) + real(r8) :: qktmp (nCellsSolve,pver,thermodynamic_active_species_num) + integer :: idx_thermo (thermodynamic_active_species_num) real(r8) :: qwv(pver,nCellsSolve) !water vapor before physics real(r8) :: facnew, facold - real(r8), allocatable :: tracers_old(:,:,:) integer :: iCell,k @@ -607,9 +616,35 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn uy => dyn_in % uy ! ! Compute q not updated by physics - ! - qwv = tracers(index_qv,:,1:nCellsSolve)-dtime*q_tend(index_qv_phys,:,1:nCellsSolve) +!xxx clean-up this code + do m=1,thermodynamic_active_species_num + do iCell = 1, nCellsSolve + do k = 1, pver + idx_thermo(m) = m + idx_dycore = thermodynamic_active_species_idx_dycore(m) + qktmp(iCell,k,m) = tracers(idx_dycore,k,iCell) + end do + end do + end do + call get_R(qktmp,idx_thermo,Rnew) + Rnew = Rnew*cv/Rgas + + + do m=1,thermodynamic_active_species_num + do iCell = 1, nCellsSolve + do k = 1, pver + idx_thermo(m) = m + idx_dycore = thermodynamic_active_species_idx_dycore(m) + qktmp(iCell,k,m) = tracers(idx_dycore,k,iCell)-& + dtime*q_tend(m,k,iCell) + end do + end do + end do + call get_R(qktmp,idx_thermo,Rold) + Rold=Rold*cv/Rgas + + qwv = tracers(index_qv,:,1:nCellsSolve)-dtime*q_tend(index_qv_phys,:,1:nCellsSolve)!xxx not needed do iCell = 1, nCellsSolve do k = 1, pver rhodk = zz(k,iCell) * rho_zz(k,iCell) @@ -617,8 +652,7 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn thetak = theta_m(k,iCell)/facold exnerk = (rgas*rhodk*theta_m(k,iCell)/p0)**(rgas/cv) - tknew = exnerk*thetak+(cp/cv)*dtime*t_tend(k,icell) - + tknew = exnerk*thetak+(cp/Rold(iCell,k))*dtime*t_tend(k,icell) thetaknew = (tknew**(cv/cp))*((rgas*rhodk*facold)/p0)**(-rgas/cp) ! @@ -631,6 +665,7 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn ! include water change in theta_m ! facnew = 1.0_r8 + Rv_over_Rd *tracers(index_qv,k,iCell) + tknew = exnerk*thetak+(cp/Rnew(iCell,k))*dtime*t_tend(k,icell) thetaknew = (tknew**(cv/cp))*((rgas*rhodk*facnew)/p0)**(-rgas/cp) rtheta_tend(k,iCell) = (thetaknew*facnew-thetak*facold)/dtime rtheta_tend(k,iCell) = rtheta_tend(k,iCell) * rho_zz(k,iCell) @@ -718,11 +753,7 @@ subroutine hydrostatic_pressure(nCells, nVertLevels, qsize, index_qv, zz, zgrid, integer :: iCell, k, idx real(r8), dimension(nVertLevels) :: dz ! Geometric layer thickness in column real(r8), dimension(nVertLevels) :: dp,dpdry ! Pressure thickness -#ifdef phl_cam_development - real(r8), dimension(nVertLevels+1) :: pint ! hydrostatic pressure at interface -#else real(r8), dimension(nVertLevels+1,nCells) :: pint ! hydrostatic pressure at interface -#endif real(r8) :: pi, t, sum_water real(r8) :: pk,rhok,rhodryk,theta,thetavk,kap1,kap2,tvk,tk ! @@ -730,42 +761,6 @@ subroutine hydrostatic_pressure(nCells, nVertLevels, qsize, index_qv, zz, zgrid, ! midpoints and interfaces. The pressure averaged to layer midpoints should be consistent with ! the ideal gas law using the rho_zz and theta values prognosed by MPAS at layer midpoints. ! -#ifdef phl_cam_development - kap1 = p0**(-rgas/cp) ! pre-compute constants - kap2 = cp/cv ! pre-compute constants - do iCell = 1, nCells - - dz(:) = zgrid(2:nVertLevels+1,iCell) - zgrid(1:nVertLevels,iCell) - - k = nVertLevels - rhok = (1.0_r8+q(index_qv,k,iCell))*zz(k,iCell) * rho_zz(k,iCell) !full CAM physics density - thetavk = theta_m(k,iCell)/ (1.0_r8 + q(index_qv,k,iCell)) !convert modified theta to virtual theta - pk = (rhok*rgas*thetavk*kap1)**kap2 !mid-level top pressure - ! - ! model top pressure consistently diagnosed using the assumption that the mid level - ! is at height z(nVertLevels-1)+0.5*dz - ! - pintdry(nVertLevels+1,iCell) = pk-0.5_r8*dz(nVertLevels)*rhok*gravity !hydrostatic - pint (nVertLevels+1) = pintdry(nVertLevels+1,iCell) - do k = nVertLevels, 1, -1 - ! - ! compute hydrostatic dry interface pressure so that (pintdry(k+1)-pintdry(k))/g is pseudo density - ! - rhodryk = zz(k,iCell) * rho_zz(k,iCell) - rhok = (1.0_r8+q(index_qv,k,iCell))*rhodryk - pintdry(k,iCell) = pintdry(k+1,iCell) + gravity * rhodryk * dz(k) - pint (k) = pint (k+1) + gravity * rhok * dz(k) - end do - - do k = nVertLevels, 1, -1 - !hydrostatic mid-level pressure - MPAS full pressure is (rhok*rgas*thetavk*kap1)**kap2 - pmid (k,iCell) = 0.5_r8*(pint(k+1)+pint(k)) - !hydrostatic dry mid-level dry pressure - - !MPAS non-hydrostatic dry pressure is pmiddry(k,iCell) = (rhodryk*rgas*theta*kap1)**kap2 - pmiddry(k,iCell) = 0.5_r8*(pintdry(k+1,iCell)+pintdry(k,iCell)) - end do - end do -#else do iCell = 1, nCells dz(:) = zgrid(2:nVertLevels+1,iCell) - zgrid(1:nVertLevels,iCell) do k = nVertLevels, 1, -1 @@ -815,8 +810,6 @@ subroutine hydrostatic_pressure(nCells, nVertLevels, qsize, index_qv, zz, zgrid, pmiddry(k,iCell) = dpdry(k)*rgas*tk /(gravit*dz(k)) end do end do -#endif - end subroutine hydrostatic_pressure subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, theta_m, q, ux,uy,outfld_name_suffix,te_budgets,budgets_cnt,budgets_subcycle_cnt) @@ -826,6 +819,7 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t use mpas_constants, only: Rv_over_Rd => rvord use air_composition, only: thermodynamic_active_species_ice_idx_dycore,thermodynamic_active_species_liq_idx_dycore use air_composition, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_liq_num + use air_composition, only: dry_air_species_num, thermodynamic_active_species_R use budgets, only: budget_array_max,budget_info_byname use cam_thermo, only: wvidx,wlidx,wiidx,seidx,poidx,keidx,moidx,mridx,ttidx,teidx,thermo_budget_num_vars use dyn_tests_utils, only: vcoord=>vc_height @@ -859,6 +853,7 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t real(r8), dimension(nCells) :: liq !total column integrated liquid real(r8), dimension(nCells) :: ice !total column integrated ice + real(r8) :: sum_species character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5,name_out6 @@ -888,7 +883,18 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t temperature(iCell,k) = exner*theta pdeldry(iCell,k) = gravit*rhod*dz - cp_or_cv(iCell,k) = cv + ! + ! internal energy coefficient for MPAS + ! (equation 92 in Eldred et al. 2023; https://rmets.onlinelibrary.wiley.com/doi/epdf/10.1002/qj.4353) + ! + cp_or_cv(iCell,k) = rair + sum_species = 1.0_r8 + do idx=dry_air_species_num + 1,thermodynamic_active_species_num + idx_tmp = thermodynamic_active_species_idx_dycore(idx) + cp_or_cv(iCell,k) = cp_or_cv(iCell,k)+thermodynamic_active_species_R(idx)*q(idx_tmp,k,iCell) + sum_species = sum_species+q(idx_tmp,k,iCell) + end do + cp_or_cv(iCell,k) = cv*cp_or_cv(iCell,k)/(sum_species*rair) u(iCell,k) = ux(k,iCell) v(iCell,k) = uy(k,iCell) phis(iCell) = zgrid(1,iCell)*gravit diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 713bf0b469..6331c5dacd 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -289,10 +289,8 @@ subroutine check_energy_timestep_init(state, tend, pbuf, col_type) ! ! MPAS specific hydrostatic energy computation (internal energy) ! - ! compute cv if vertical coordinate is height: cv = cp - R - ! if (state%psetcols == pcols) then - cp_or_cv(:ncol,:) = cpairv(:ncol,:,lchnk)-rairv(:ncol,:,lchnk) + cp_or_cv(:ncol,:) = cp_or_cv_dycore(:ncol,:,lchnk) else cp_or_cv(:ncol,:) = cpair-rair endif @@ -579,7 +577,7 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & ! ! Note: cp_or_cv set above for pressure coordinate if (state%psetcols == pcols) then - cp_or_cv(:ncol,:) = cpairv(:ncol,:,lchnk)-rairv(:ncol,:,lchnk) + cp_or_cv(:ncol,:) = cp_or_cv_dycore(:ncol,:,lchnk) else cp_or_cv(:ncol,:) = cpair-rair endif @@ -1155,7 +1153,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) ! ! compute cv if vertical coordinate is height: cv = cp - R ! - cp_or_cv(:,:) = cpairv(:,:,lchnk)-rairv(:,:,lchnk)!cv + cp_or_cv(:ncol,:) = cp_or_cv_dycore(:ncol,:,lchnk) else if (vc_loc == vc_dry_pressure) then cp_or_cv(:ncol,:) = cp_or_cv_dycore(:ncol,:,lchnk) else @@ -1168,7 +1166,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) if (vc_loc == vc_height) then scaling(:ncol,:) = cpairv(:ncol,:,lchnk)/cp_or_cv(:ncol,:) !cp/cv scaling for temperature increment under constant volume else if (vc_loc == vc_dry_pressure) then - scaling(:ncol,:) = cpairv(:ncol,:,lchnk)/cp_or_cv_dycore(:ncol,:,lchnk) + scaling(:ncol,:) = cpairv(:ncol,:,lchnk)/cp_or_cv(:ncol,:) else scaling(:ncol,:) = 1.0_r8 !internal energy / enthalpy same as CAM physics end if diff --git a/src/utils/air_composition.F90 b/src/utils/air_composition.F90 index eb81c97f74..c82fdfffab 100644 --- a/src/utils/air_composition.F90 +++ b/src/utils/air_composition.F90 @@ -657,6 +657,7 @@ end subroutine dry_air_composition_update subroutine water_composition_update(mmr, lchnk, ncol, vcoord, to_dry_factor) use cam_abortutils, only: endrun use dyn_tests_utils, only: vc_height, vc_moist_pressure, vc_dry_pressure + use physconst, only: r_universal, cpair, rair, cpwv, rh2o, cpliq, cpice, mwdry!xxx real(r8), intent(in) :: mmr(:,:,:) ! constituents array integer, intent(in) :: lchnk ! Chunk number integer, intent(in) :: ncol ! number of columns @@ -666,11 +667,19 @@ subroutine water_composition_update(mmr, lchnk, ncol, vcoord, to_dry_factor) character(len=*), parameter :: subname = 'water_composition_update' if (vcoord==vc_dry_pressure) then - call get_cp(mmr(:ncol,:,:),.false.,cp_or_cv_dycore(:ncol,:,lchnk), factor=to_dry_factor, & + call get_cp(mmr(:ncol,:,:),.false.,cp_or_cv_dycore(:ncol,:,lchnk), factor=to_dry_factor, & active_species_idx_dycore=thermodynamic_active_species_idx,cpdry=cpairv(:ncol,:,lchnk)) else if (vcoord==vc_height) then - call get_R(mmr(:ncol,:,:), active_species_idx=thermodynamic_active_species_idx, & - cp_or_cv_dycore(:ncol,:,lchnk), fact=to_dry_factor, rdry=rairv(:ncol,:,lchnk)) + call get_R(mmr(:ncol,:,:), thermodynamic_active_species_idx, & + cp_or_cv_dycore(:ncol,:,lchnk), fact=to_dry_factor, Rdry=rairv(:ncol,:,lchnk)) + ! + ! internal energy coefficient for MPAS + ! (equation 92 in Eldred et al. 2023; https://rmets.onlinelibrary.wiley.com/doi/epdf/10.1002/qj.4353) + ! + cp_or_cv_dycore(:ncol,:,lchnk)=cp_or_cv_dycore(:ncol,:,lchnk)*& + (cpairv(:ncol,:,lchnk)-rairv(:ncol,:,lchnk)) /rairv(:ncol,:,lchnk) +! cp_or_cv_dycore(:ncol,:,lchnk)=rair*& +! (cpairv(:ncol,:,lchnk)-rairv(:ncol,:,lchnk))/rairv(:ncol,:,lchnk) end if end subroutine water_composition_update @@ -1006,9 +1015,9 @@ end subroutine get_R_dry_2hd !*************************************************************************** ! subroutine get_R_1hd(tracer, active_species_idx, R, fact, Rdry) -! subroutine get_cp_1hd(tracer, cp, factor, active_species_idx_dycore, cpdry) use cam_abortutils, only: endrun use string_utils, only: int2str + use physconst, only: rair ! Dummy arguments ! tracer: !tracer array @@ -1105,7 +1114,7 @@ end subroutine get_R_2hd !************************************************************************************************************************* ! subroutine get_mbarv_1hd(tracer, active_species_idx, mbarv_in, fact) - use physconst, only: mwdry, rair, cpair + use physconst, only: mwdry real(r8), intent(in) :: tracer(:,:,:) !tracer array integer, intent(in) :: active_species_idx(:) !index of active species in tracer real(r8), intent(out) :: mbarv_in(:,:) !molecular weight of dry air From 25d2b447e4d6427911d6a6b609fdf61e2debd40d Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Wed, 1 Mar 2023 12:59:51 -0700 Subject: [PATCH 067/140] regression test bug fixes for budget and dycores --- bld/namelist_files/namelist_definition.xml | 13 ---- src/control/budgets.F90 | 79 ++++++---------------- src/control/cam_history.F90 | 15 ++-- src/dynamics/eul/dycore_budget.F90 | 55 +++++++++++++++ src/dynamics/fv/dp_coupling.F90 | 2 +- src/dynamics/fv/dycore_budget.F90 | 55 +++++++++++++++ src/dynamics/fv/metdata.F90 | 21 +++++- src/dynamics/fv3/dycore_budget.F90 | 55 +++++++++++++++ src/dynamics/mpas/dycore_budget.F90 | 4 +- src/dynamics/se/dycore_budget.F90 | 13 ++-- src/physics/cam/physpkg.F90 | 13 ++-- src/physics/simple/physpkg.F90 | 22 ++++-- 12 files changed, 243 insertions(+), 104 deletions(-) create mode 100644 src/dynamics/eul/dycore_budget.F90 create mode 100644 src/dynamics/fv/dycore_budget.F90 create mode 100644 src/dynamics/fv3/dycore_budget.F90 diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index c0e35eb5b0..9e246ba4e9 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -5058,25 +5058,12 @@ Default: 4 m/s - -Frequency that thermo budgets will be calculated and output: Valid values: 'NONE', 'NSTEP', 'NDAY', 'NMONTH', -'NYEAR', 'ENDOFRUN'. -Default: 'NONE' - - History tape number thermo budget output is written to. Default: 1 - -History tape number thermo budget output is written to. -Default: 1 - - Produce output for the AMWG diagnostic package. diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index 6120e08087..fd762baaa1 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -41,10 +41,8 @@ module budgets character(len=64), public, protected :: budget_stg1name(budget_array_max) character(len=64), public, protected :: budget_stg2name(budget_array_max) -integer, public :: thermo_budget_averaging_n = 1 integer, public :: thermo_budget_histfile_num = 1 logical, public :: thermo_budget_history = .false. -character(len=8), public :: thermo_budget_averaging_option = 'NONE' integer, private :: stepsize ! ! Constants for each budget @@ -252,7 +250,7 @@ subroutine budget_get_global (name, me_idx, global) character(len=128) :: errmsg integer :: b_ind ! hentry index integer :: f(ptapes),ff ! hentry index - integer :: idx,pidx,midx ! substring index for sum dif char + integer :: idx,pidx,midx,uidx ! substring index for sum dif char integer :: m ! budget index logical :: found ! true if global integral found @@ -261,22 +259,32 @@ subroutine budget_get_global (name, me_idx, global) str1='' write(str1,*) TRIM(ADJUSTL(name)) - ! check for stagename short format (stg1//op/stg2) where stg1 is name without thermo string appended + midx=index(str1, '-') pidx=index(str1, '+') idx=midx+pidx + + ! check for difference budget using stagename short format (stg1//op/stg2) where stg1 is name without thermo string appended if (idx /= 0 .and. (midx==0 .or. pidx==0)) then write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//trim(adjustl(str1(1:idx)))// & - TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//TRIM(ADJUSTL(str1(idx+1:))) + TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//TRIM(ADJUSTL(str1(idx+1:))) end if - b_ind=budget_ind_byname(trim(adjustl(str1))) - if (idx>0 .and. budget_optype(b_ind) == 'stg') call endrun(sub//'FATAL not a difference budget but name contains + or - character') + uidx=index(str1, '_') + if (uidx == 0) then + !This is a stage name need to append the type of thermo variable using input index + write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//trim(adjustl(str1(1:))) + end if + b_ind=budget_ind_byname(trim(adjustl(str1))) + + if (b_ind < 0) call endrun(sub//'FATAL field name '//name//' not found'//' looked for '//trim(adjustl(str1))) + write(str1,*) TRIM(ADJUSTL(budget_name(b_ind))) ! Find budget name in list and return global value call get_field_properties(trim(adjustl(str1)), found, tape_out=tape, ff_out=ff, f_out=f) + if (found.and.f(thermo_budget_histfile_num)>0) then call tape(thermo_budget_histfile_num)%hlist(f(thermo_budget_histfile_num))%get_global(global) if (.not. thermo_budget_vars_massv(me_idx)) global=global/stepsize @@ -329,11 +337,8 @@ subroutine budget_put_global (name, me_idx, global) end subroutine budget_put_global !============================================================================== function budget_ind_byname (name) - - ! Get the index of a budget. Optional abort argument allows returning - ! control to caller when budget name is not found. Default behavior is - ! to call endrun when name is not found. - + ! + ! Get the index of a budget. Ret -1 for not found !-----------------------------Arguments--------------------------------- character(len=*), intent(in) :: name ! budget name @@ -350,13 +355,9 @@ function budget_ind_byname (name) return end if end do - if (budget_ind_byname == -1) then - write(iulog,*)'ind_byname failed, name=',trim(name),'budget_name=' - call endrun() - end if + end function budget_ind_byname !============================================================================== - end function budget_ind_byname function is_budget(name) @@ -404,8 +405,7 @@ subroutine budget_readnl(nlfile) character(len=8) :: period logical :: thermo_budgeting - namelist /thermo_budget_nl/ thermo_budget_averaging_option, thermo_budget_averaging_n, & - thermo_budget_history, thermo_budget_histfile_num + namelist /thermo_budget_nl/ thermo_budget_history, thermo_budget_histfile_num !----------------------------------------------------------------------- if (masterproc) then @@ -421,52 +421,17 @@ subroutine budget_readnl(nlfile) end if ! Broadcast namelist variables - call mpi_bcast(thermo_budget_averaging_option, len(thermo_budget_averaging_option), mpi_character, masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_averaging_option") call mpi_bcast(thermo_budget_history , 1 , mpi_logical , masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_history") call mpi_bcast(thermo_budget_histfile_num , 1 , mpi_integer , masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_histfile_num") - call mpi_bcast(thermo_budget_averaging_n , 1 , mpi_integer , masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_averaging_n") - - if (trim(shr_string_toUpper(thermo_budget_averaging_option)) == 'NONE') then - thermo_budgeting=.false. - else - thermo_budgeting=.true. - end if ! Write out thermo_budget options if (masterproc) then - if (trim(thermo_budget_averaging_option) == 'NSTEP' ) then - period='step' - else if (trim(thermo_budget_averaging_option) == 'NHOUR' ) then - period='hour' - else if (trim(thermo_budget_averaging_option) == 'NDAY' ) then - period='day' - else if (trim(thermo_budget_averaging_option) == 'NMONTH' ) then - period='month' - else if (trim(thermo_budget_averaging_option) == 'NYEAR' ) then - period='year' - else - period='' + if (thermo_budget_history) then + write(iulog,*)'Thermo budgets will be written to the log file and diagnostics saved to history file:',& + thermo_budget_histfile_num end if - - if (trim(thermo_budget_averaging_option) == 'ENDOFRUN' ) then - write(iulog,*)'Thermo thermo_budgets will be written at the end of the run' - else - if (thermo_budget_averaging_n == 1) then - write(iulog,*)'Thermo thermo_budgets will be written every ',period - else - write(iulog,*)'Thermo thermo_budgets will be written every ',thermo_budget_averaging_n,' ',trim(period)//'s' - end if - end if - - if(thermo_budget_history.and..not.thermo_budgeting) then - write(iulog,*)subname//": FATAL: thermo_budget_averaging_option =",thermo_budget_averaging_option - call endrun(subname//": FATAL: thermo_budget averaging option must not be set to NONE when requesting thermo_budget history output") - end if - end if end subroutine budget_readnl diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index f5b02d5838..adb4d0038a 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -4159,15 +4159,20 @@ subroutine h_override (t) type(master_entry), pointer :: listentry - avgflg = avgflag_pertape(t) - listentry=>masterlinkedlist do while(associated(listentry)) - call AvgflagToString(avgflg, listentry%time_op(t)) - listentry%avgflag(t) = avgflag_pertape(t) - listentry=>listentry%next_entry + ! Budgets require flag to be N, dont override + +!jt if (listentry%avgflag(t) == 'N' .and. listentry%actflag(t) ) then +!jt call endrun('FATAL:h_override: tape averaging override for "N" averaged fields is not supported') +!jt else + if (listentry%avgflag(t) /= 'N' ) then + call AvgflagToString(avgflg, listentry%time_op(t)) + listentry%avgflag(t) = avgflag_pertape(t) + end if + listentry=>listentry%next_entry end do end subroutine h_override diff --git a/src/dynamics/eul/dycore_budget.F90 b/src/dynamics/eul/dycore_budget.F90 new file mode 100644 index 0000000000..23ea684799 --- /dev/null +++ b/src/dynamics/eul/dycore_budget.F90 @@ -0,0 +1,55 @@ +module dycore_budget +use shr_kind_mod, only: r8=>shr_kind_r8 +implicit none + +public :: print_budget +real(r8), parameter :: eps = 1.0E-9_r8 +real(r8), parameter :: eps_mass = 1.0E-12_r8 + +!========================================================================================= +contains +!========================================================================================= + +subroutine print_budget(hstwr) + + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use shr_kind_mod, only: r8=>shr_kind_r8 + use budgets, only: budget_get_global, is_budget, thermo_budget_histfile_num, thermo_budget_history + use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv, & + teidx, seidx, keidx, poidx + use cam_thermo, only: teidx, seidx, keidx, poidx + use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv + + ! arguments + logical, intent(in) :: hstwr(:) + + ! Local variables + character(len=*), parameter :: subname = 'check_energy:print_budgets' + + !-------------------------------------------------------------------------------------- + + if (masterproc .and. thermo_budget_history .and. hstwr(thermo_budget_histfile_num)) then + call endrun(subname//' is not implemented for the EUL dycore') + end if +end subroutine print_budget +!========================================================================================= +function abs_diff(a,b,pf) + real(r8), intent(in) :: a,b + character(LEN=5), optional, intent(out):: pf + real(r8) :: abs_diff + if (abs(b)>eps) then + abs_diff = abs((b-a)/b) + else + abs_diff = abs(b-a) + end if + If (present(pf)) then + if (abs_diff>eps) then + pf = ' FAIL' + else + pf = ' PASS' + end if + end if +end function abs_diff +end module dycore_budget diff --git a/src/dynamics/fv/dp_coupling.F90 b/src/dynamics/fv/dp_coupling.F90 index 443bf6a2a9..0b2aa31d55 100644 --- a/src/dynamics/fv/dp_coupling.F90 +++ b/src/dynamics/fv/dp_coupling.F90 @@ -581,7 +581,7 @@ subroutine d_p_coupling(grid, phys_state, phys_tend, pbuf2d, dyn_out) ! Call cam_thermo_update to compute cpairv, rairv, mbarv, and cappav as constituent dependent variables ! and compute molecular viscosity(kmvis) and conductivity(kmcnd) !----------------------------------------------------------------------------- - call cam_thermo_update(phys_state(lchnk)%q, phys_state(lchnk)%t, lchnk, ncol) + call cam_thermo_dry_air_update(phys_state(lchnk)%q, phys_state(lchnk)%t, lchnk, ncol) endif !------------------------------------------------------------------------ diff --git a/src/dynamics/fv/dycore_budget.F90 b/src/dynamics/fv/dycore_budget.F90 new file mode 100644 index 0000000000..3414bf519b --- /dev/null +++ b/src/dynamics/fv/dycore_budget.F90 @@ -0,0 +1,55 @@ +module dycore_budget +use shr_kind_mod, only: r8=>shr_kind_r8 +implicit none + +public :: print_budget +real(r8), parameter :: eps = 1.0E-9_r8 +real(r8), parameter :: eps_mass = 1.0E-12_r8 + +!========================================================================================= +contains +!========================================================================================= + +subroutine print_budget(hstwr) + + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use shr_kind_mod, only: r8=>shr_kind_r8 + use budgets, only: budget_get_global, is_budget, thermo_budget_histfile_num, thermo_budget_history + use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv, & + teidx, seidx, keidx, poidx + use cam_thermo, only: teidx, seidx, keidx, poidx + use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv + + ! arguments + logical, intent(in) :: hstwr(:) + + ! Local variables + character(len=*), parameter :: subname = 'check_energy:print_budgets' + + !-------------------------------------------------------------------------------------- + + if (masterproc .and. thermo_budget_history .and. hstwr(thermo_budget_histfile_num)) then + call endrun(subname//' is not implemented for the FV dycore') + end if +end subroutine print_budget +!========================================================================================= +function abs_diff(a,b,pf) + real(r8), intent(in) :: a,b + character(LEN=5), optional, intent(out):: pf + real(r8) :: abs_diff + if (abs(b)>eps) then + abs_diff = abs((b-a)/b) + else + abs_diff = abs(b-a) + end if + If (present(pf)) then + if (abs_diff>eps) then + pf = ' FAIL' + else + pf = ' PASS' + end if + end if +end function abs_diff +end module dycore_budget diff --git a/src/dynamics/fv/metdata.F90 b/src/dynamics/fv/metdata.F90 index 5f49143562..316ebcd54d 100644 --- a/src/dynamics/fv/metdata.F90 +++ b/src/dynamics/fv/metdata.F90 @@ -902,6 +902,8 @@ subroutine get_dyn_flds( state, tend, dt ) use ppgrid, only: pcols, pver, begchunk, endchunk use phys_grid, only: get_ncols_p use cam_history, only: outfld + use air_composition,only: thermodynamic_active_species_liq_num, thermodynamic_active_species_ice_num + use air_composition,only: thermodynamic_active_species_liq_idx,thermodynamic_active_species_ice_idx implicit none @@ -912,7 +914,10 @@ subroutine get_dyn_flds( state, tend, dt ) integer :: lats(pcols) ! array of latitude indices integer :: lons(pcols) ! array of longitude indices integer :: c, ncol, i,j,k - real(r8):: qini(pcols,pver) ! initial specific humidity + integer :: m_cnst,m + real(r8):: qini(pcols,pver) ! initial specific humidity + real(r8):: totliqini(pcols,pver) ! initial total liquid + real(r8):: toticeini(pcols,pver) ! initial total ice real(r8) :: tmp(pcols,pver) @@ -926,7 +931,17 @@ subroutine get_dyn_flds( state, tend, dt ) state(c)%t(i,k) = (1._r8-met_rlx(k))*state(c)%t(i,k) + met_rlx(k)*met_t(i,k,c) end if - qini(i,k) = state(c)%q(i,k,1) + qini (:ncol,:pver) = state(c)%q(:ncol,:pver, 1) + totliqini = 0.0_r8 + do m_cnst=1,thermodynamic_active_species_liq_num + m = thermodynamic_active_species_liq_idx(m_cnst) + totliqini(:ncol,:pver) = totliqini(:ncol,:pver)+state(c)%q(:ncol,:pver,m) + end do + toticeini = 0.0_r8 + do m_cnst=1,thermodynamic_active_species_ice_num + m = thermodynamic_active_species_ice_idx(m_cnst) + toticeini(:ncol,:pver) = toticeini(:ncol,:pver)+state(c)%q(:ncol,:pver,m) + end do ! at this point tracer mixing ratios have already been ! converted from dry to moist @@ -940,7 +955,7 @@ subroutine get_dyn_flds( state, tend, dt ) ! now adjust mass of each layer now that water vapor has changed if (( .not. online_test ) .and. (alpha .ne. D1_0 )) then - call physics_dme_adjust(state(c), tend(c), qini, dt) + call physics_dme_adjust(state(c), tend(c), qini, totliqini, toticeini, dt) endif end do diff --git a/src/dynamics/fv3/dycore_budget.F90 b/src/dynamics/fv3/dycore_budget.F90 new file mode 100644 index 0000000000..636f4ca7b3 --- /dev/null +++ b/src/dynamics/fv3/dycore_budget.F90 @@ -0,0 +1,55 @@ +module dycore_budget +use shr_kind_mod, only: r8=>shr_kind_r8 +implicit none + +public :: print_budget +real(r8), parameter :: eps = 1.0E-9_r8 +real(r8), parameter :: eps_mass = 1.0E-12_r8 + +!========================================================================================= +contains +!========================================================================================= + +subroutine print_budget(hstwr) + + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use shr_kind_mod, only: r8=>shr_kind_r8 + use budgets, only: budget_get_global, is_budget, thermo_budget_histfile_num, thermo_budget_history + use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv, & + teidx, seidx, keidx, poidx + use cam_thermo, only: teidx, seidx, keidx, poidx + use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv + + ! arguments + logical, intent(in) :: hstwr(:) + + ! Local variables + character(len=*), parameter :: subname = 'check_energy:print_budgets' + + !-------------------------------------------------------------------------------------- + + if (masterproc .and. thermo_budget_history .and. hstwr(thermo_budget_histfile_num)) then + call endrun(subname//' is not implemented for the FV3 dycore') + end if +end subroutine print_budget +!========================================================================================= +function abs_diff(a,b,pf) + real(r8), intent(in) :: a,b + character(LEN=5), optional, intent(out):: pf + real(r8) :: abs_diff + if (abs(b)>eps) then + abs_diff = abs((b-a)/b) + else + abs_diff = abs(b-a) + end if + If (present(pf)) then + if (abs_diff>eps) then + pf = ' FAIL' + else + pf = ' PASS' + end if + end if +end function abs_diff +end module dycore_budget diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index 68c16631a1..c1b3bce48d 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -11,7 +11,7 @@ module dycore_budget subroutine print_budget(hstwr) - use budgets, only: budget_get_global, thermo_budget_histfile_num + use budgets, only: budget_get_global, thermo_budget_histfile_num, thermo_budget_history use spmd_utils, only: masterproc use cam_logfile, only: iulog use cam_abortutils, only: endrun @@ -36,7 +36,7 @@ subroutine print_budget(hstwr) character(LEN=5) :: pf! pass or fail identifier !-------------------------------------------------------------------------------------- - if (masterproc .and. hstwr(thermo_budget_histfile_num)) then + if (masterproc .and. thermo_budget_history .and. hstwr(thermo_budget_histfile_num)) then call budget_get_global('phAP-phBP',teidx,ph_param) call budget_get_global('phBP-phBF',teidx,ph_EFIX) call budget_get_global('phAM-phAP',teidx,ph_dmea) diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index e9bf55c169..528ec19b51 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -19,15 +19,16 @@ subroutine print_budget(hstwr) use cam_abortutils, only: endrun use cam_logfile, only: iulog use shr_kind_mod, only: r8=>shr_kind_r8 - use budgets, only: budget_get_global, is_budget, thermo_budget_histfile_num + use budgets, only: budget_get_global, is_budget, thermo_budget_histfile_num, thermo_budget_history use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv, & teidx, seidx, keidx, poidx use dimensions_mod, only: ntrac use control_mod, only: ftype use cam_thermo, only: teidx, seidx, keidx, poidx use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv - use time_manager, only: get_step_size - use budgets, only: thermo_budget_averaging_option, thermo_budget_averaging_n + + ! arguments + logical, intent(in) :: hstwr(:) ! Local variables character(len=*), parameter :: subname = 'check_energy:print_budgets' @@ -56,9 +57,7 @@ subroutine print_budget(hstwr) character(LEN=5) :: pf! pass or fail identifier !-------------------------------------------------------------------------------------- - if (masterproc) then - dtime = REAL(get_step_size()) - + if (masterproc .and. thermo_budget_history .and. hstwr(thermo_budget_histfile_num)) then idx(1) = teidx !total energy index idx(2) = seidx !enthaly index idx(3) = keidx !kinetic energy index @@ -93,8 +92,6 @@ subroutine print_budget(hstwr) call budget_get_global('dBF' ,idx(i),E_dBF(i)) !state passed to physics end do - call budget_get_global('dyAP',teidx,E_dyAP) - call budget_get_global('dBF-dED',teidx,dyn_total) call budget_get_global('dAD-dBD',teidx,rate_of_change_2D_dyn) call budget_get_global('dAR-dAD',teidx,rate_of_change_vertical_remapping) diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index cd2192a38d..43c7f4915a 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -1384,7 +1384,7 @@ subroutine tphysac (ztodt, cam_in, & use perf_mod use flux_avg, only: flux_avg_run use unicon_cam, only: unicon_cam_org_diags - use cam_history, only: hist_fld_active, outfld + use cam_history, only: outfld use qneg_module, only: qneg4 use co2_cycle, only: co2_cycle_set_ptend use nudging, only: Nudge_Model,Nudge_ON,nudging_timestep_tend @@ -1392,6 +1392,7 @@ subroutine tphysac (ztodt, cam_in, & use cam_snapshot_common,only: cam_snapshot_ptend_outfld use lunar_tides, only: lunar_tides_tend use cam_thermo, only: cam_thermo_water_update + use budgets, only: thermo_budget_history ! ! Arguments ! @@ -1875,11 +1876,7 @@ subroutine tphysac (ztodt, cam_in, & ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. ! So, save off tracers - if (.not.moist_mixing_ratio_dycore.and.& - (hist_fld_active('SE_phAM').or.hist_fld_active('KE_phAM').or.hist_fld_active('WV_phAM').or.& - hist_fld_active('SE_dyAM').or.hist_fld_active('KE_dyAM').or.hist_fld_active('WV_dyAM').or.& - hist_fld_active('WL_phAM').or.hist_fld_active('WI_phAM').or.hist_fld_active('MR_phAM').or.& - hist_fld_active('MO_phAM'))) then + if (.not.moist_mixing_ratio_dycore .and. thermo_budget_history) then tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver) tmp_ps(:ncol) = state%ps(:ncol) @@ -1887,8 +1884,8 @@ subroutine tphysac (ztodt, cam_in, & call set_dry_to_wet(state) call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) ! update cp/cv for energy computation based in updated water variables - call cam_thermo_water_update(state%q(:ncol,:,:), lchnk, ncol, & - to_dry_factor=state%pdel(:ncol,:)/state%pdeldry(:ncol,:), vc_dycore) + call cam_thermo_water_update(state%q(:ncol,:,:), lchnk, ncol, vc_dycore, & + to_dry_factor=state%pdel(:ncol,:)/state%pdeldry(:ncol,:)) call calc_te_and_aam_budgets(state, 'phAM') call calc_te_and_aam_budgets(state, 'dyAM', vc=vc_dycore) ! Restore pre-"physics_dme_adjust" tracers diff --git a/src/physics/simple/physpkg.F90 b/src/physics/simple/physpkg.F90 index 353c245318..e81ec2f1a7 100644 --- a/src/physics/simple/physpkg.F90 +++ b/src/physics/simple/physpkg.F90 @@ -47,6 +47,8 @@ module physpkg integer :: qini_idx = 0 integer :: cldliqini_idx = 0 integer :: cldiceini_idx = 0 + integer :: totliqini_idx = 0 + integer :: toticeini_idx = 0 logical :: state_debug_checks ! Debug physics_state. @@ -471,6 +473,7 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) use dycore, only: dycore_is use check_energy, only: calc_te_and_aam_budgets use cam_history, only: hist_fld_active + use budgets, only: thermo_budget_history ! Arguments ! @@ -492,6 +495,8 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) real(r8), pointer :: qini(:,:) real(r8), pointer :: cldliqini(:,:) real(r8), pointer :: cldiceini(:,:) + real(r8), pointer :: totliqini(:,:) + real(r8), pointer :: toticeini(:,:) integer :: ixcldliq integer :: ixcldice integer :: k @@ -518,11 +523,17 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) if (moist_physics) then call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + call pbuf_get_field(pbuf, totliqini_idx, totliqini) + call pbuf_get_field(pbuf, toticeini_idx, toticeini) else allocate(cldliqini(pcols, pver)) cldliqini = 0.0_r8 allocate(cldiceini(pcols, pver)) cldiceini = 0.0_r8 + allocate(totliqini(pcols, pver)) + totliqini = 0.0_r8 + allocate(toticeini(pcols, pver)) + toticeini = 0.0_r8 end if !========================= @@ -564,10 +575,7 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. ! So, save off tracers - if (.not.moist_mixing_ratio_dycore.and.& - (hist_fld_active('SE_phAM').or.hist_fld_active('KE_phAM').or.hist_fld_active('WV_phAM').or.& - hist_fld_active('WL_phAM').or.hist_fld_active('WI_phAM').or.hist_fld_active('MR_phAM').or.& - hist_fld_active('MO_phAM'))) then + if (.not.moist_mixing_ratio_dycore.and. thermo_budget_history) then tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver) tmp_ps(:ncol) = state%ps(:ncol) @@ -577,7 +585,7 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) ! call set_dry_to_wet(state) - call physics_dme_adjust(state, tend, qini, ztodt) + call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) call calc_te_and_aam_budgets(state, 'phAM') call calc_te_and_aam_budgets(state, 'dyAM',vc=vc_dycore) @@ -588,7 +596,7 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) end if if (moist_mixing_ratio_dycore) then - call physics_dme_adjust(state, tend, qini, ztodt) + call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) call calc_te_and_aam_budgets(state, 'phAM') call calc_te_and_aam_budgets(state, 'dyAM',vc=vc_dycore) end if @@ -609,7 +617,7 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) end do call diag_phys_tend_writeout (state, pbuf, tend, ztodt, & - tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini) + qini, cldliqini, cldiceini) call diag_surf(cam_in, cam_out, state, pbuf) From 0b06ea26332ec9af4034f3c7c989d1794fa21352 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Wed, 1 Mar 2023 20:26:47 -0700 Subject: [PATCH 068/140] more regression fixes, this time for izumi --- src/dynamics/se/dyn_comp.F90 | 4 ++-- src/physics/cam/physpkg.F90 | 3 +-- src/physics/cam_dev/physpkg.F90 | 6 +----- src/physics/simple/physpkg.F90 | 3 +-- 4 files changed, 5 insertions(+), 11 deletions(-) diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index bd3e562ade..dda561ac11 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -911,9 +911,9 @@ subroutine dyn_init(dyn_in, dyn_out) ! call budget_add('BD_dyn_total','dBF','dED','dyn','dif',longname="dE/dt dyn total (dycore+phys tendency (dBF-dED)",cslam=ntrac>0) - call budget_add('rate_2d_dyn','dAD','dBD','dyn','dif',longname="rate_of_change_2d_dyn (dAD-dBD)",cslam=ntrac>0.) + call budget_add('rate_2d_dyn','dAD','dBD','dyn','dif',longname="rate_of_change_2d_dyn (dAD-dBD)",cslam=ntrac>0) - call budget_add('rate_vert_remap','dAR','dAD','dyn','dif',longname="rate_of_change_2d_dyn (dAR-dAD)",cslam=ntrac>0.) + call budget_add('rate_vert_remap','dAR','dAD','dyn','dif',longname="rate_of_change_2d_dyn (dAR-dAD)",cslam=ntrac>0) call budget_add('BD_dyn_adai','rate_2d_dyn','rate_vert_remap','dyn','sum',longname="dE/dt total adiabatic dynamics (adiab=rate2ddyn+vremap) ",cslam=ntrac>0) diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 43c7f4915a..6d700f480d 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -1392,7 +1392,6 @@ subroutine tphysac (ztodt, cam_in, & use cam_snapshot_common,only: cam_snapshot_ptend_outfld use lunar_tides, only: lunar_tides_tend use cam_thermo, only: cam_thermo_water_update - use budgets, only: thermo_budget_history ! ! Arguments ! @@ -1876,7 +1875,7 @@ subroutine tphysac (ztodt, cam_in, & ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. ! So, save off tracers - if (.not.moist_mixing_ratio_dycore .and. thermo_budget_history) then + if (.not.moist_mixing_ratio_dycore) then tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver) tmp_ps(:ncol) = state%ps(:ncol) diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index 2db81468a8..9cf003852c 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -2316,11 +2316,7 @@ subroutine tphysac (ztodt, cam_in, & ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. ! So, save off tracers - if (.not.moist_mixing_ratio_dycore.and.& - (hist_fld_active('SE_phAM').or.hist_fld_active('KE_phAM').or.hist_fld_active('WV_phAM').or.& - hist_fld_active('SE_dyAM').or.hist_fld_active('KE_dyAM').or.hist_fld_active('WV_dyAM').or.& - hist_fld_active('WL_phAM').or.hist_fld_active('WI_phAM').or.hist_fld_active('MR_phAM').or.& - hist_fld_active('MO_phAM'))) then + if (.not.moist_mixing_ratio_dycore) then tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver) tmp_ps(:ncol) = state%ps(:ncol) diff --git a/src/physics/simple/physpkg.F90 b/src/physics/simple/physpkg.F90 index e81ec2f1a7..c870be5fe7 100644 --- a/src/physics/simple/physpkg.F90 +++ b/src/physics/simple/physpkg.F90 @@ -473,7 +473,6 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) use dycore, only: dycore_is use check_energy, only: calc_te_and_aam_budgets use cam_history, only: hist_fld_active - use budgets, only: thermo_budget_history ! Arguments ! @@ -575,7 +574,7 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. ! So, save off tracers - if (.not.moist_mixing_ratio_dycore.and. thermo_budget_history) then + if (.not.moist_mixing_ratio_dycore) then tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver) tmp_ps(:ncol) = state%ps(:ncol) From 0f7a3cedb8dfbafbf3b3337fc4e5e5270f7ab537 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Tue, 7 Mar 2023 14:39:11 -0700 Subject: [PATCH 069/140] PR cleanup, ChangeLog wording --- bld/namelist_files/namelist_definition.xml | 14 +- doc/ChangeLog | 236 +++++++++++++++++++++ src/control/budgets.F90 | 21 +- src/control/cam_history.F90 | 75 +------ src/dynamics/mpas/dyn_grid.F90 | 2 - 5 files changed, 252 insertions(+), 96 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 9e246ba4e9..8a70076d37 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -1733,15 +1733,15 @@ Default: none + group="cam_history_nl" valid_values="A,B,I,X,M,N,L,S" > Sets the averaging flag for all variables on a particular history file series. Valid values are: A ==> Average B ==> GMT 00:00:00 average - C ==> average over nsteps not nacs I ==> Instantaneous M ==> Minimum + N ==> average over nsteps not nacs X ==> Maximum L ==> Local-time S ==> Standard deviation @@ -1831,9 +1831,9 @@ are: A ==> Average B ==> GMT 00:00:00 average - C ==> average over nsteps I ==> Instantaneous M ==> Minimum + N ==> average over nsteps X ==> Maximum L ==> Local-time S ==> Standard deviation @@ -2118,14 +2118,6 @@ this to a number greater than 1 allows for temporal interpolation in the post pr Default: 1 - -Frequency that budget files will be output: none, step, hourly, daily, monthly, -yearly, or endofrun. Valid values: 'NONE', 'STEP', 'HOURLY', 'DAILY', 'MONTHLY', -'YEARLY', 'ENDOFRUN'. -Default: 'NONE' - - Frequency that initial files will be output: 6-hourly, daily, monthly, diff --git a/doc/ChangeLog b/doc/ChangeLog index 2abcfa5d3b..b62ea9840e 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,241 @@ =============================================================== +Tag name: cam6_3_XXX +Originator(s): pel, jet +Date: 6 March 2023 +One-line Summary: Science and infrastructure updates for inline energy/mass budgets +Github PR URL: https://github.com/ESCOMP/CAM/pull/ + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Add inline energy/mass budgets support. (#519) + Science changes are included that help close the mass and energy budgets + of physics and the SE/MPAS dycores (#521) as well as adding all water + constituents to atmospheric mass (pressure) (#520) + + As of this commit energy/mass budgets have been roughed in for physics and the SE and MPAS dycores. + Similar to amwg_diagnostic functionality, energy/mass budget diagnostic fields will be added to a + history file via the thermo_budget_histfile_num namelist parameter. Globally averaged energy budget + summaries are also calculated and written to the atm log file every time the budget history tape is + written to. The period over which energy and mass budgets are averaged is the same as the averaging + period of the history budget file. Thus history budgets can be output/averaged at timestep, hour, + or month resolutions using the nhtfrq variable specific to the budget history file identified by + thermo_budget_histfile_num. The new namelist logical variable thermo_buget_history is used to + turn budgeting on (.true.) or off (.false.) The default is .false. (no budgeting) because of + the global gathers needed to create the budgets. + + An energy or mass budget is defined by a mathematical operation (sum/difference) of + two energy/mass snapshots. For instance one can talk of the energy lost/gained by + the physics parameterizations by comparing snapshots taken before and after running the physics. + + An energy budget is created, written to the atm log file and budget history tape in four steps + 1) calling e_m_snapshot to define multiple energy/mass snapshots and add them to the history buffer + 2) calling e_m_budget to define a budget as the difference/sum of two snapshots. + 3) calling calc_tot_energy_xxx for each named snapshot + 4) setting namelist variables thermo_budget_history, thermo_budget_histfile_num, nhtfrq + + Energy and mass snapshots are defined and added to the history buffer via the e_m_snapshot + subroutine. The e_m_snapshot routine creates a set of vertically integrated energy and mass + history output fields based on the name parameter prepended with the types of energy and mass + that are carried in cam and defined in cam_thermo.F90 For example calling e_m_snapshot with a + name of 'dAP', perhaps standing for an energy snapshot after physics is called, will create + a set of fields that contain kinetic (KE_dAP), sensible (SE_dAP), potential (PO_dAP) and + total (TE_dap) energies as well as atmospheric vapor (wv_dAP), liquid (wl_dAP) and + ice (wi_dAP) masses. A call to calc_total_energy for the each named snapshot (here placed after + after the physics parameterization) will calculate and outfld the 9 or so specific energy and + mass snapshots. + + The e_m_budget routine defines a named budget composed of the difference or sum of two + snapshots. As with e_m_shapshot the budget name is prepended with the same energies identifiers + as e_m_snapshot. There is no need to call calc_tot_energy_mass for filling these budgets as they + are calculated from the existing snapshots. All energy/mass snapshots and budgets are saved to + the history buffer and written to the budget history file. A calc_total_energy_mass routine + exists for both physics and dynamics to allow budgets tailored to thermodynamic needs and + data structures of those packages. + +Describe any changes made to build system: + +Describe any changes made to the namelist: + New budgeting namelist variables have been added. Interface follows existing functionality + to outfld standard diagnostics for budgeting and diagnosis. + + thermo_budget_histfile_num: integer identifing which history file will contain + additional budgeting diagnostic fields + thermo_budget_history: logical that turns history budgeting on and off. + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: Global gathers are done each time a thermo budgeting field is written + to the history file. The budgeting diagnostics are not meant to be enabled during a production run. + +Code reviewed by: + +List all files eliminated: N/A + +List all files added and what they do: + A src/cam/control/budget.F90 + provides support for energy/mass budgeting using cam_history infrastructure. + +List all existing files that have been modified, and describe the changes: + + M Externals.cfg + - update to include ctsm tag supporting MPAS defaults + + M namelist_defaults_cam.xml + - new mpas initial data default for mpasa120 aquaplanet. + - update cam_dev defaults to add Graupel constituent. + + M namelist_definition.xml + - new averaging flag option for budget variables 'N' allows normalization by nsteps. + - nstep normalization is required to properly budget subcycled fields. + - new namelist parameters for budgeting + + M cam_comp.F90 + - add call to print budgets. The print_budget function needs to be defined for all dycores. + + M cam_history.F90 + - new functionality for history buffered fields + - new area weighted global averaging functionality for history fields. + - create new composed hbuf field which is created from a sum/difference operation on + two existing fields. + - restart information added for budgeting. + + M cam_history_buffers.F90 + - new subroutine for nstep field averaging + + M cam_history_support.F90 + - added support for new global average functionality + + M runtime_opts.F90 + - added budget namelist read + + M atm_comp_nuopc.F90 + - bug fix, support for E/W formatted initial data longitudes spanning -180:180 + + M eul/dp_coupling.F90 + - update calling parameters + + M eul/dycore_budget.F90 + - Dummy routine for printing EUL budget - not fully supported yet. + + M fv/dp_coupling.F90 + - update calling parameters + + M fv/dycore_budget.F90 + - Dummy routine for printing FV budget - not fully supported yet. + + M fv/metdata.F90 + - thermodynamic activespecies variables + + M fv3/dp_coupling.F90 + - update calling parameters + + M fv3/dycore_budget.F90 + - Dummy routine for printing FV3 budget - not fully supported yet. + + M mpas/dp_coupling.F90 + - science updates + - all water constitutents added to pressure + - mods to further reduce bias in energy budget + + M mpas/dycore_budget.F90 + - Routine for printing MPAS budget + + M mpas/dyn_comp.F90 + - Add core budgets for mpas energy and mass - stages + + M mpas/dyn_grid.F90 + - register area weights for mpas grids + + M se/dp_coupling.F90 + - science updates + - all water constitutents added to pressure + - mods to further reduce bias in energy budget + + M se/global_norms_mod.F90 + - new interface for calculating both elem and fvm global integrals (fvm added) + + M se/dycore/prim_advance_mod.F90 + - science updates to close energy budget + - refactor energy calc routine. + - new hydrostatic energy routine with potential energy now split out from SE + + M se/dycore_budget.F90 + - Routine for printing SE energy/mass budgets + + M se/dyn_comp.F90 + - Add core budget variables for se energy and mass - stages + + M se/dyn_grid.F90 + - register area weights for se grids + - call budget_add for all SE energy/mass budget fields. + + M infrastructure/phys_grid.F90 + - register area weights for physic grid + - call budget_add for all SE energy/mass budget fields. + + M cam_diagnostics.F90 + - register physics energy/mass budgets using budget_add calls + - physics energy/mass variables (physics budget stages) + + M check_energy.F90 + - update calls to get hydrostatic energy (include new potential energy input param) + - update calc energy/mass routine for potential energy calculation. + + M constituents.F90 + - clean up unused variables (NAG) + + M geopotential.F90 + - remove unused routines/variables (NAG) + - add computation of generalized virtual temp to geopotential_t + + M phys_control.F90 + - code cleanup + + M cam/phys_grid.F90 + - register area weights for global integrals + + M physics_types.F90 + - science updates for energy/mass budgets + + M cam/physpkg.F90 + - science updates for energy/mass budgets + - science updates for energy/mass budgets + + M cam_dev/physpkg.F90 + - science updates for energy/mass budgets + + M simple/physpkg.F90 + - science updates for energy/mass budgets (update dme_adjust) + + M utils/air_composition.F90 + - refactor/cleanup/rename + + M utils/grid_support.F90 + - support for global area weighting for budgets + + M utils/cam_thermo.F90 + - energy and mass budget variables and descriptions. + + + +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: + +Summarize any changes to answers: larger than roundoff + +=============================================================== +=============================================================== + Tag name: cam6_3_093 Originator(s): fvitt, Duseong Jo (cdswk@ucar.edu) Date: 7 Feb 2023 diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index fd762baaa1..6d633b4182 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -1,15 +1,15 @@ module budgets -! Metadata manager for the budgets. - -use shr_kind_mod, only: r8 => shr_kind_r8 -use spmd_utils, only: masterproc -use cam_abortutils, only: endrun -use cam_logfile, only: iulog -use cam_thermo, only: thermo_budget_vars, thermo_budget_vars_descriptor, & - thermo_budget_vars_unit, thermo_budget_vars_massv, thermo_budget_num_vars -use cam_history, only: addfld, add_default, horiz_only +! Adds support for energy and mass budgets using cam_history api. + +use cam_abortutils, only: endrun +use cam_history, only: addfld, add_default, horiz_only use cam_history_support, only: max_fieldname_len,ptapes +use cam_logfile, only: iulog +use cam_thermo, only: thermo_budget_vars, thermo_budget_vars_descriptor, & + thermo_budget_vars_unit, thermo_budget_vars_massv, thermo_budget_num_vars +use shr_kind_mod, only: r8 => shr_kind_r8 +use spmd_utils, only: masterproc implicit none private @@ -34,6 +34,7 @@ module budgets ! Public data integer, parameter, public :: budget_array_max = 500 ! number of budget diffs + integer, public :: budget_num = 0 ! character(len=64), public, protected :: budget_name(budget_array_max) ! budget names character(len=128),public, protected :: budget_longname(budget_array_max) ! long name of budgets @@ -389,9 +390,7 @@ end function is_budget ! Read namelist variables. subroutine budget_readnl(nlfile) use namelist_utils, only: find_group_name - use spmd_utils, only: masterproc, mpicom, masterprocid use spmd_utils, only: mpi_character, mpi_logical, mpi_integer - use cam_logfile, only: iulog use shr_string_mod, only: shr_string_toUpper ! Dummy argument: filepath for file containing namelist input diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index adb4d0038a..43941af84c 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -170,8 +170,6 @@ module cam_history character(len=16) :: host ! host name character(len=8) :: inithist = 'YEARLY' ! If set to '6-HOURLY, 'DAILY', 'MONTHLY' or ! 'YEARLY' then write IC file - character(len=8) :: budgethist = 'ENDOFRUN' ! If set to 'STEP, HOURLY, 'DAILY', 'MONTHLY' or - ! 'YEARLY', 'ENDOFRUN' then write budget file logical :: inithist_all = .false. ! Flag to indicate set of fields to be ! included on IC file ! .false. include only required fields @@ -384,9 +382,9 @@ subroutine intht (model_doi_url_in) integer :: i,k,c,ib,ie,jb,je,count ! index integer :: fdecomp ! field decomp type(dim_index_2d) :: dimind ! 2-D dimension index - real(r8), pointer :: areawt(:) ! pointer to areawt values for attribute + real(r8), pointer :: areawt(:) ! pointer to areawt values for attribute type(master_entry), pointer :: listentry - character(len=32) :: fldname ! temp variable used to produce a left justified field name + character(len=32) :: fldname ! temp variable used to produce a left justified field name ! in the formatted logfile output ! @@ -478,7 +476,6 @@ subroutine intht (model_doi_url_in) enddim2 = tape(t)%hlist(f)%field%enddim2 begdim3 = tape(t)%hlist(f)%field%begdim3 enddim3 = tape(t)%hlist(f)%field%enddim3 -!jt if (masterproc) write(iulog,*)'allocating hbuf for field num',f,' name:',trim(tape(t)%hlist(f)%field%name) allocate(tape(t)%hlist(f)%hbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) tape(t)%hlist(f)%hbuf = 0._r8 if (tape(t)%hlist(f)%avgflag .eq. 'S') then ! allocate the variance buffer for standard dev @@ -487,19 +484,14 @@ subroutine intht (model_doi_url_in) endif if (tape(t)%hlist(f)%avgflag .eq. 'N') then ! set up areawt weight buffer fdecomp = tape(t)%hlist(f)%field%decomp_type -!jt if (masterproc) write(iulog,*)'in avgflag = N field',f,' name:',trim(tape(t)%hlist(f)%field%name),'decomp=',fdecomp if (any(allgrids_wt(:)%decomp_type == fdecomp)) then wtidx=MAXLOC(allgrids_wt(:)%decomp_type, MASK = allgrids_wt(:)%decomp_type .EQ. fdecomp) -!jt if (masterproc) write(iulog,*)'found decomp in allgrids_wt at index', wtidx tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf -!jt if (masterproc) write(iulog,*)'pointing allgrids_wt wbuf to hlist wbuf index',wtidx(1) else ! area weights not found for this grid, then create them wtidx=MINLOC(allgrids_wt(:)%decomp_type) allgrids_wt(wtidx)%decomp_type=fdecomp areawt => cam_grid_get_areawt(fdecomp) -!jt write(iulog,*)'shape areawt:',shape(areawt),' size areawt:',size(areawt),'shape wbuf:',shape(allgrids_wt(wtidx(1))%wbuf), & -!jt ' size wbuf:',size(allgrids_wt(wtidx(1))%wbuf) allocate(allgrids_wt(wtidx(1))%wbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) allgrids_wt(wtidx(1))%wbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)=0._r8 count=0 @@ -509,7 +501,6 @@ subroutine intht (model_doi_url_in) ie=dimind%end1 jb=dimind%beg2 je=dimind%end2 -!jt if (masterproc) write(iulog,*)'dimind ib:ie jb:je c=(',ib,':',ie,',',jb,':',je,',',c,')' do k=jb,je do i=ib,ie count=count+1 @@ -518,7 +509,6 @@ subroutine intht (model_doi_url_in) end do end do tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf -!jt if (masterproc) write(iulog,*)'didnt find decomp in allgrids_wt allocating at index', wtidx(1),'areawt(1:40)=',areawt(1:40) endif endif if(tape(t)%hlist(f)%field%flag_xyfill .or. (avgflag_pertape(t) .eq. 'L')) then @@ -625,7 +615,7 @@ subroutine history_readnl(nlfile) fwrtpr1, fwrtpr2, fwrtpr3, fwrtpr4, fwrtpr5, & fwrtpr6, fwrtpr7, fwrtpr8, fwrtpr9, fwrtpr10, & interpolate_nlat, interpolate_nlon, & - interpolate_gridtype, interpolate_type, interpolate_output, budgethist + interpolate_gridtype, interpolate_type, interpolate_output ! Set namelist defaults (these should match initial values if given) fincl(:,:) = ' ' @@ -639,7 +629,6 @@ subroutine history_readnl(nlfile) nhtfrq(2:) = -24 mfilt = 30 inithist = 'YEARLY' - budgethist = 'NONE' inithist_all = .false. empty_htapes = .false. lcltod_start(:) = 0 @@ -769,16 +758,6 @@ subroutine history_readnl(nlfile) inithist = 'NONE' end if ! - ! If generate a thermo budget history file as an auxillary tape: - ! - ctemp = shr_string_toUpper(budgethist) - budgethist = trim(ctemp) - if ( (budgethist /= 'HOURLY') .and. (budgethist /= 'DAILY') .and. & - (budgethist /= 'MONTHLY') .and. (budgethist /= 'YEARLY') .and. & - (budgethist /= 'STEP') .and. (budgethist /= 'ENDOFRUN')) then - budgethist = 'NONE' - end if - ! ! History file write times ! Convert write freq. of hist files from hours to timesteps if necessary. ! @@ -851,27 +830,6 @@ subroutine history_readnl(nlfile) end if end if - ! Write out budgethist info - if (masterproc) then - if (budgethist == 'HOURLY' ) then - write(iulog,*)'Budget history files will be written hourly.' - else if (budgethist == 'STEP' ) then - write(iulog,*)'Budget history files will be written every time step.' - else if (budgethist == 'DAILY' ) then - write(iulog,*)'Budget history files will be written daily.' - else if (budgethist == 'MONTHLY' ) then - write(iulog,*)'Budget history files will be written monthly.' - else if (budgethist == 'YEARLY' ) then - write(iulog,*)'Budget history files will be written yearly.' - else if (budgethist == 'CAMIOP' ) then - write(iulog,*)'Budget history files will be written for IOP.' - else if (budgethist == 'ENDOFRUN' ) then - write(iulog,*)'Budget history files will be written at end of run.' - else - write(iulog,*)'Budget history files will not be created' - end if - end if - ! Print out column-output information do t = 1, size(fincllonlat, 2) if (ANY(len_trim(fincllonlat(:,t)) > 0)) then @@ -888,7 +846,6 @@ subroutine history_readnl(nlfile) call mpi_bcast(nhtfrq, ptapes, mpi_integer, masterprocid, mpicom, ierr) call mpi_bcast(mfilt, ptapes, mpi_integer, masterprocid, mpicom, ierr) call mpi_bcast(inithist,len(inithist), mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(budgethist,len(budgethist), mpi_character, masterprocid, mpicom, ierr) call mpi_bcast(inithist_all,1, mpi_logical, masterprocid, mpicom, ierr) call mpi_bcast(lcltod_start, ptapes, mpi_integer, masterprocid, mpicom, ierr) call mpi_bcast(lcltod_stop, ptapes, mpi_integer, masterprocid, mpicom, ierr) @@ -1040,7 +997,6 @@ subroutine define_composed_field_ids(t) do f = 1, nflds(t) if (composed_field(trim(tape(t)%hlist(f)%field%name), & field1, field2)) then -!jt write(iulog,*)'tape:',t,'nflds:',nflds(t),'name:',trim(tape(t)%hlist(f)%field%name),'f1:',trim(field1),'f2:',trim(field2) if (len_trim(field1) > 0 .and. len_trim(field2) > 0) then ! set field1/field2 names for htape from the masterfield list tape(t)%hlist(f)%op_field1=trim(field1) @@ -1057,12 +1013,6 @@ subroutine define_composed_field_ids(t) if (tape(t)%hlist(f)%field%op_field2_id == -1) & call endrun(trim(subname)//': No op_field2 match for '//trim(tape(t)%hlist(f)%field%name)) -!jt write(iulog,'(a,i0,a)')'TAPE:',t,' composed fields' -!jt write(iulog,'(a,a,a)')' field',trim(tape(t)%hlist(f)%field%name),' composed of ',trim(tape(t)%hlist(f)%op_field1),' ',trim(tape(t)%hlist(f)%op_field1) -!jt ff=tape(t)%hlist(f)%field%op_field1_id -!jt write(iulog,'(a,a,a,i0)')' name=',trim(tape(t)%hlist(ff)%field%name),' field1_id:',ff -!jt ff=tape(t)%hlist(f)%field%op_field2_id -!jt write(iulog,'(a,a,a,i0)')' name=',trim(tape(t)%hlist(ff)%field%name),' field2_id:',ff else call endrun(trim(subname)//': Component fields not found for composed field') end if @@ -2211,16 +2161,12 @@ subroutine read_restart_history (File) if (any(allgrids_wt(:)%decomp_type == tape(t)%hlist(f)%field%decomp_type)) then wtidx=MAXLOC(allgrids_wt(:)%decomp_type, MASK = allgrids_wt(:)%decomp_type .EQ. fdecomp) - !jt if (masterproc) write(iulog,*)'found decomp in allgrids_wt at index', wtidx tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf - !jt if (masterproc) write(iulog,*)'pointing allgrids_wt wbuf to hlist wbuf' else ! area weights not found for this grid, then create them wtidx=MINLOC(allgrids_wt(:)%decomp_type) allgrids_wt(wtidx)%decomp_type=fdecomp areawt => cam_grid_get_areawt(fdecomp) - !jt write(iulog,*)'shape areawt:',shape(areawt),' size areawt:',size(areawt),'shape wbuf:',shape(allgrids_wt(wtidx(1))%wbuf), & - !jt ' size wbuf:',size(allgrids_wt(wtidx(1))%wbuf) allocate(allgrids_wt(wtidx(1))%wbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) cnt=0 do c=begdim3,enddim3 @@ -2237,7 +2183,6 @@ subroutine read_restart_history (File) end do end do tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf - !jt if (masterproc) write(iulog,*)'didnt find decomp in allgrids_wt allocating at index', wtidx(1),'areawt(1:40)=',areawt(1:40) endif endif end do @@ -2270,7 +2215,6 @@ subroutine read_restart_history (File) do f = 1, nflds(t) fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) -!jt if(masterproc) write(iulog, *) 'Reading history variable ',fname_tmp ierr = pio_inq_varid(tape(t)%File, fname_tmp, vdesc) call cam_pio_var_info(tape(t)%File, vdesc, ndims, dimids, dimlens) @@ -4164,10 +4108,6 @@ subroutine h_override (t) listentry=>masterlinkedlist do while(associated(listentry)) ! Budgets require flag to be N, dont override - -!jt if (listentry%avgflag(t) == 'N' .and. listentry%actflag(t) ) then -!jt call endrun('FATAL:h_override: tape averaging override for "N" averaged fields is not supported') -!jt else if (listentry%avgflag(t) /= 'N' ) then call AvgflagToString(avgflg, listentry%time_op(t)) listentry%avgflag(t) = avgflag_pertape(t) @@ -4956,7 +4896,6 @@ subroutine h_normalize (f, t) end if currstep=get_nstep() if (avgflag == 'N' .and. currstep > 0) then -!jt if (masterproc) write(iulog,*)'normalizing ',tape(t)%hlist(f)%field%name,' currstep',currstep,'beg_nstep=',tape(t)%hlist(f)%beg_nstep if( currstep > tape(t)%hlist(f)%beg_nstep) then nsteps=currstep-tape(t)%hlist(f)%beg_nstep do k=jb,je @@ -5124,7 +5063,6 @@ subroutine h_field_op (f, t) ! integer, intent(in) :: f ! field index integer, intent(in) :: t ! tape index -!jt character(len=*), intent(in) :: op ! field operation currently only sum/diff ! ! Local workspace ! @@ -5144,7 +5082,6 @@ subroutine h_field_op (f, t) enddim3 = tape(t)%hlist(f)%field%enddim3 dimind = tape(t)%hlist(f)%field%get_dims(begdim3) -!jt write(iulog,*)'diff fields',trim(tape(t)%hlist(f)%field%name),trim(tape(t)%hlist(f1)%field%name),' ids',f1,',',f2,' op=',trim(op),'sum f1=',sum(tape(t)%hlist(f1)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,begdim3)),sum(tape(t)%hlist(f2)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,begdim3)),sum(tape(t)%hlist(f1)%wbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,begdim3)) do c = begdim3, enddim3 dimind = tape(t)%hlist(f)%field%get_dims(c) @@ -5644,12 +5581,9 @@ subroutine wshist (rgnht_in) !$OMP PARALLEL DO PRIVATE (F) do f=1,nflds(t) ! First compose field if needed -!jt if(masterproc) write(iulog,*)'checking if field ',trim(tape(t)%hlist(f)%field%name),' is composed',tape(t)%hlist(f)%field%is_composed() if (tape(t)%hlist(f)%field%is_composed()) then -!jt if (masterproc) write(iulog,*)'field ',trim(tape(t)%hlist(f)%field%name),' is composed',tape(t)%hlist(f)%field%is_composed() call h_field_op (f, t) end if -!jt if (masterproc) write(iulog,*)'restart flag is',restart, 'false to normalize field' if(.not. restart) then ! Normalized averaged fields if (tape(t)%hlist(f)%avgflag /= 'I') then @@ -6060,10 +5994,8 @@ logical function composed_field(fname, fname1, fname2) ! Local variables type(master_entry), pointer :: listentry -!jt write(iulog,*)'checking masterlinked list for field name=',trim(fname) listentry => get_entry_by_name(masterlinkedlist, fname) if (associated(listentry)) then -!jt write(iulog,*)'composed field name f1 f2=',trim(listentry%field%name),trim(listentry%op_field1),trim(listentry%op_field2) if ( (len_trim(listentry%op_field1) > 0) .or. & (len_trim(listentry%op_field2) > 0)) then composed_field = .true. @@ -6074,7 +6006,6 @@ logical function composed_field(fname, fname1, fname2) fname2 = listentry%op_field2 end if else -!jt write(iulog,*)'lens op field1/2=',len_trim(listentry%op_field1),'/',len_trim(listentry%op_field2) composed_field = .false. end if else diff --git a/src/dynamics/mpas/dyn_grid.F90 b/src/dynamics/mpas/dyn_grid.F90 index 3fbed4890f..b9685d306a 100644 --- a/src/dynamics/mpas/dyn_grid.F90 +++ b/src/dynamics/mpas/dyn_grid.F90 @@ -588,8 +588,6 @@ subroutine define_cam_grids() allocate(areaWeight(nCellsSolve), stat=ierr) if( ierr /= 0 ) call endrun(subname//':failed to allocate area_weight :'//int2str(__LINE__)) -!jt allocate(dyn_cols(nCellsSolve), stat=ierr) -!jt if( ierr /= 0 ) call endrun(subname//':failed to allocate dyn_columns :'//int2str(__LINE__)) call get_dyn_grid_info(hdim1_d, hdim2_d, num_levels, index_model_top_layer, index_surface_layer, unstructured, dyn_cols) From a54262a1ad8bbdab6bd9fc996c16c6ebde2d5ce5 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Wed, 8 Mar 2023 22:05:16 -0700 Subject: [PATCH 070/140] PR cleanup --- doc/ChangeLog | 117 +-- src/control/budgets.F90 | 865 ++++++++++---------- src/control/cam_history.F90 | 6 +- src/control/cam_history_buffers.F90 | 53 -- src/dynamics/mpas/dp_coupling.F90 | 10 +- src/dynamics/mpas/dyn_comp.F90 | 16 +- src/dynamics/se/dp_coupling.F90 | 4 +- src/dynamics/se/dycore/prim_advance_mod.F90 | 18 +- src/dynamics/se/dycore/prim_driver_mod.F90 | 10 +- src/dynamics/se/dyn_comp.F90 | 32 +- src/dynamics/se/stepon.F90 | 4 +- src/physics/cam/cam_diagnostics.F90 | 26 +- src/physics/cam/check_energy.F90 | 8 +- src/physics/cam/physpkg.F90 | 24 +- 14 files changed, 578 insertions(+), 615 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index b62ea9840e..c3699aa282 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -2,62 +2,75 @@ Tag name: cam6_3_XXX Originator(s): pel, jet -Date: 6 March 2023 +Date: 8 March 2023 One-line Summary: Science and infrastructure updates for inline energy/mass budgets Github PR URL: https://github.com/ESCOMP/CAM/pull/ Purpose of changes (include the issue number and title text for each relevant GitHub issue): - Add inline energy/mass budgets support. (#519) - Science changes are included that help close the mass and energy budgets - of physics and the SE/MPAS dycores (#521) as well as adding all water + Add inline energy/mass budgets support. (#519) Science changes are + included that help close the mass and energy budgets of physics + and the SE/MPAS dycores (#521) as well as adding all water constituents to atmospheric mass (pressure) (#520) - As of this commit energy/mass budgets have been roughed in for physics and the SE and MPAS dycores. - Similar to amwg_diagnostic functionality, energy/mass budget diagnostic fields will be added to a - history file via the thermo_budget_histfile_num namelist parameter. Globally averaged energy budget - summaries are also calculated and written to the atm log file every time the budget history tape is - written to. The period over which energy and mass budgets are averaged is the same as the averaging - period of the history budget file. Thus history budgets can be output/averaged at timestep, hour, - or month resolutions using the nhtfrq variable specific to the budget history file identified by - thermo_budget_histfile_num. The new namelist logical variable thermo_buget_history is used to - turn budgeting on (.true.) or off (.false.) The default is .false. (no budgeting) because of - the global gathers needed to create the budgets. - - An energy or mass budget is defined by a mathematical operation (sum/difference) of - two energy/mass snapshots. For instance one can talk of the energy lost/gained by - the physics parameterizations by comparing snapshots taken before and after running the physics. - - An energy budget is created, written to the atm log file and budget history tape in four steps - 1) calling e_m_snapshot to define multiple energy/mass snapshots and add them to the history buffer - 2) calling e_m_budget to define a budget as the difference/sum of two snapshots. - 3) calling calc_tot_energy_xxx for each named snapshot + As of this commit energy/mass budgets have been roughed in for + physics and the SE and MPAS dycores. Similar to amwg_diagnostic + functionality, energy/mass budget diagnostic fields will be added + to a history file via the thermo_budget_histfile_num namelist + parameter. Globally averaged energy budget summaries are also + calculated and written to the atm log file every time the budget + history tape is written to. The period over which energy and mass + budgets are averaged is the same as the averaging period of the + history budget file. Thus history budgets can be output/averaged + at timestep, hour, or month resolutions using the nhtfrq variable + specific to the budget history file identified by + thermo_budget_histfile_num. The new namelist logical variable + thermo_buget_history is used to turn budgeting on (.true.) or off + (.false.) The default is .false. (no budgeting) because of the + global gathers needed to create the budgets. + + An energy or mass budget is defined by a mathematical operation + (sum/difference) of two energy/mass snapshots. For instance one + can talk of the energy lost/gained by the physics + parameterizations by comparing snapshots taken before and after + running the physics. + + An energy budget is created, logged and written to the budget history tape in four steps + 1) call e_m_snapshot to define multiple energy/mass snapshots + 2) call e_m_budget to define a budget as the difference/sum of two snapshots. + 3) call tot_energy_phys (or tot_energy_dyn) for each named snapshot 4) setting namelist variables thermo_budget_history, thermo_budget_histfile_num, nhtfrq - Energy and mass snapshots are defined and added to the history buffer via the e_m_snapshot - subroutine. The e_m_snapshot routine creates a set of vertically integrated energy and mass - history output fields based on the name parameter prepended with the types of energy and mass - that are carried in cam and defined in cam_thermo.F90 For example calling e_m_snapshot with a - name of 'dAP', perhaps standing for an energy snapshot after physics is called, will create - a set of fields that contain kinetic (KE_dAP), sensible (SE_dAP), potential (PO_dAP) and - total (TE_dap) energies as well as atmospheric vapor (wv_dAP), liquid (wl_dAP) and - ice (wi_dAP) masses. A call to calc_total_energy for the each named snapshot (here placed after - after the physics parameterization) will calculate and outfld the 9 or so specific energy and - mass snapshots. - - The e_m_budget routine defines a named budget composed of the difference or sum of two - snapshots. As with e_m_shapshot the budget name is prepended with the same energies identifiers - as e_m_snapshot. There is no need to call calc_tot_energy_mass for filling these budgets as they - are calculated from the existing snapshots. All energy/mass snapshots and budgets are saved to - the history buffer and written to the budget history file. A calc_total_energy_mass routine - exists for both physics and dynamics to allow budgets tailored to thermodynamic needs and - data structures of those packages. + Energy and mass snapshots are defined and added to the history + buffer via the e_m_snapshot subroutine. The e_m_snapshot routine + creates a set of vertically integrated energy and mass history + output fields based on the snapshot name parameter prepended with + the types of energy and mass that are carried in cam and defined + in cam_thermo.F90 For example calling e_m_snapshot with a name of + 'dAP', perhaps standing for an energy snapshot after physics is + called, will create a set of fields that contain kinetic (KE_dAP), + sensible (SE_dAP), potential (PO_dAP) and total (TE_dap) energies + as well as atmospheric vapor (wv_dAP), liquid (wl_dAP) and ice + (wi_dAP) masses. A call to calc_total_energy for the each named + snapshot (here placed after after the physics parameterization) + will calculate and outfld the 9 or so specific energy and mass + snapshots. + + The e_m_budget routine defines a named budget composed of the + difference or sum of two snapshots. As with e_m_shapshot the + budget name is prepended with the same energies identifiers as + e_m_snapshot. All energy/mass snapshots as well as the budgets are + saved to the history buffer and written to the budget history + file. tot_energy_phys and tot_energy_dyn routines exists for both + physics and dynamics to allow snapshots tailored to thermodynamic + needs and data structures of those packages. Describe any changes made to build system: Describe any changes made to the namelist: - New budgeting namelist variables have been added. Interface follows existing functionality - to outfld standard diagnostics for budgeting and diagnosis. + New budgeting namelist variables have been added. Interface + follows existing functionality to outfld standard diagnostics for + budgeting and diagnosis. thermo_budget_histfile_num: integer identifing which history file will contain additional budgeting diagnostic fields @@ -65,8 +78,10 @@ Describe any changes made to the namelist: List any changes to the defaults for the boundary datasets: N/A -Describe any substantial timing or memory changes: Global gathers are done each time a thermo budgeting field is written - to the history file. The budgeting diagnostics are not meant to be enabled during a production run. +Describe any substantial timing or memory changes: + Global gathers are done each time a thermo budgeting field is + written to the history file. The budgeting diagnostics are not + meant to be enabled during a production run. Code reviewed by: @@ -217,23 +232,19 @@ List all existing files that have been modified, and describe the changes: M utils/cam_thermo.F90 - energy and mass budget variables and descriptions. - - 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: +cheyenne/intel/aux_cam: Expecting namelist and baseline failures -izumi/nag/aux_cam: +izumi/nag/aux_cam: Expecting namelist and baseline failures +izumi/gnu/aux_cam: Expecting namelist and baseline failures -izumi/gnu/aux_cam: - -Summarize any changes to answers: larger than roundoff +Summarize any changes to answers: climate changing -=============================================================== =============================================================== Tag name: cam6_3_093 diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index 6d633b4182..04ff081186 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -1,437 +1,444 @@ module budgets + !---------------------------------------------------------------------------- + ! + ! Adds support for energy and mass snapshots and budgets using cam_history api. + ! + ! Public functions/subroutines: + ! + ! budget_init + ! e_m_snapshot + ! e_m_budget + ! budget_ind_byname + ! budget_get_global + ! budget_put_global + ! budget_readnl + ! is_budget + !----------------------------------------------------------------------- -! Adds support for energy and mass budgets using cam_history api. - -use cam_abortutils, only: endrun -use cam_history, only: addfld, add_default, horiz_only -use cam_history_support, only: max_fieldname_len,ptapes -use cam_logfile, only: iulog -use cam_thermo, only: thermo_budget_vars, thermo_budget_vars_descriptor, & - thermo_budget_vars_unit, thermo_budget_vars_massv, thermo_budget_num_vars -use shr_kind_mod, only: r8 => shr_kind_r8 -use spmd_utils, only: masterproc - -implicit none -private -save - -interface budget_add - module procedure budget_stage_add - module procedure budget_diff_add -end interface budget_add - -! Public interfaces -public :: & - budget_init, &! initialize budget variables - budget_add, &! add a budget to the list of budgets - budget_ind_byname, &! return budget index given name - budget_get_global, &! return budget global - budget_put_global, &! put budget global - budget_readnl, &! budget_readnl: read cam thermo namelist - is_budget ! return logical if budget_defined - - -! Public data - -integer, parameter, public :: budget_array_max = 500 ! number of budget diffs - -integer, public :: budget_num = 0 ! -character(len=64), public, protected :: budget_name(budget_array_max) ! budget names -character(len=128),public, protected :: budget_longname(budget_array_max) ! long name of budgets -character(len=128),public, protected :: budget_stagename(budget_array_max) ! long name of budgets -character(len=64), public, protected :: budget_stg1name(budget_array_max) -character(len=64), public, protected :: budget_stg2name(budget_array_max) - -integer, public :: thermo_budget_histfile_num = 1 -logical, public :: thermo_budget_history = .false. -integer, private :: stepsize -! -! Constants for each budget - -character*3, public :: budget_optype(budget_array_max)! stage or difference or sum -character*3, public :: budget_pkgtype(budget_array_max)! phy or dyn - -!============================================================================================== + use cam_abortutils, only: endrun + use cam_history, only: addfld, add_default, horiz_only + use cam_history_support, only: max_fieldname_len,ptapes + use cam_logfile, only: iulog + use cam_thermo, only: thermo_budget_vars, thermo_budget_vars_descriptor, & + thermo_budget_vars_unit, thermo_budget_vars_massv, thermo_budget_num_vars + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmd_utils, only: masterproc, masterprocid, mpicom + + implicit none + private + save + + ! Public interfaces + public :: & + budget_init, &! initialize budget variables + e_m_snapshot, &! define a snapshot and add to history buffer + e_m_budget, &! define a budget and add to history buffer + budget_ind_byname, &! return budget index given name + budget_get_global, &! return budget global + budget_put_global, &! put budget global + budget_readnl, &! budget_readnl: read cam thermo namelist + is_budget ! return logical if budget_defined + + + ! Public data + + integer, parameter, public :: budget_array_max = 500 ! number of budget diffs + + integer, public :: budget_num = 0 ! + character(len=64), public, protected :: budget_name(budget_array_max) ! budget names + character(len=128),public, protected :: budget_longname(budget_array_max) ! long name of budgets + character(len=128),public, protected :: budget_stagename(budget_array_max) ! long name of budgets + character(len=64), public, protected :: budget_stg1name(budget_array_max) + character(len=64), public, protected :: budget_stg2name(budget_array_max) + + integer, public :: thermo_budget_histfile_num = 1 + logical, public :: thermo_budget_history = .false. + integer, private :: stepsize + ! + ! Constants for each budget + + character*3, public :: budget_optype(budget_array_max)! stage or difference or sum + character*3, public :: budget_pkgtype(budget_array_max)! phy or dyn + + !============================================================================================== CONTAINS -!============================================================================================== - -subroutine budget_stage_add (name, pkgtype, longname, cslam) - use dycore, only: dycore_is - - character(len=*), intent(in) :: & - name ! budget name used as variable name in history file output (8 char max) - character(len=*), intent(in) :: & - pkgtype ! budget type either phy or dyn - character(len=*), intent(in), optional :: & - longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) - logical, intent(in), optional :: & - cslam ! true => CSLAM used to transport mass tracers - - character (len=128) :: errmsg - character (len=max_fieldname_len) :: str1 - character (len=128) :: str2, str3 - logical :: thermo_budget_hist - logical :: cslamtr ! using cslam transport for mass tracers - integer :: ivars - character(len=*), parameter :: sub='budget_stage_add' - !----------------------------------------------------------------------- + !============================================================================================== + + subroutine e_m_snapshot (name, pkgtype, longname, cslam) + use dycore, only: dycore_is + + character(len=*), intent(in) :: & + name ! budget name used as variable name in history file output (8 char max) + character(len=*), intent(in) :: & + pkgtype ! budget type either phy or dyn + character(len=*), intent(in), optional :: & + longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) + logical, intent(in), optional :: & + cslam ! true => CSLAM used to transport mass tracers + + character (len=128) :: errmsg + character (len=max_fieldname_len) :: str1 + character (len=128) :: str2, str3 + logical :: thermo_budget_hist + logical :: cslamtr ! using cslam transport for mass tracers + integer :: ivars + character(len=*), parameter :: sub='e_m_snapshot' + !----------------------------------------------------------------------- + + if (thermo_budget_history) then + if (present(cslam)) then + cslamtr=cslam + else + cslamtr = .false. + end if + do ivars=1, thermo_budget_num_vars + + write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(name)) + write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & + TRIM(ADJUSTL(longname)) + write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) + + budget_num = budget_num+1 + ! set budget name and constants + budget_name(budget_num) = trim(str1) + if (present(longname)) then + budget_longname(budget_num) = trim(str2) + else + budget_longname(budget_num) = trim(str1) + end if + + budget_optype(budget_num)='stg' + budget_pkgtype(budget_num)=pkgtype + budget_stagename(budget_num)= trim(name) + + if (pkgtype=='phy') then + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='physgrid') + else + if (dycore_is('SE')) then + if (cslamtr .and. thermo_budget_vars_massv(ivars)) then + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='FVM') + else + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='GLL') + end if + else if (dycore_is('MPAS')) then + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='mpas_cell') + else + call endrun(sub//'budget_add is only supported for MPAS and SE dycores') + call endrun(errmsg) + end if + end if + call add_default(TRIM(ADJUSTL(str1)), thermo_budget_histfile_num, 'N') + end do + end if + end subroutine e_m_snapshot - if (thermo_budget_history) then - if (present(cslam)) then - cslamtr=cslam - else - cslamtr = .false. - end if - do ivars=1, thermo_budget_num_vars - - write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(name)) - write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & - TRIM(ADJUSTL(longname)) - write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) - - budget_num = budget_num+1 - ! set budget name and constants - budget_name(budget_num) = trim(str1) - if (present(longname)) then - budget_longname(budget_num) = trim(str2) - else - budget_longname(budget_num) = trim(str1) - end if - - budget_optype(budget_num)='stg' - budget_pkgtype(budget_num)=pkgtype - budget_stagename(budget_num)= trim(name) - - if (pkgtype=='phy') then - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='physgrid') - else - if (dycore_is('SE')) then - if (cslamtr .and. thermo_budget_vars_massv(ivars)) then - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='FVM') - else - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='GLL') - end if - else if (dycore_is('MPAS')) then - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='mpas_cell') - else - call endrun(sub//'budget_add is only supported for MPAS and SE dycores') - call endrun(errmsg) - end if - end if - call add_default(TRIM(ADJUSTL(str1)), thermo_budget_histfile_num, 'N') - end do -end if - end subroutine budget_stage_add - !!$!============================================================================== -subroutine budget_diff_add (name, stg1name, stg2name, pkgtype, optype, longname, cslam) - use dycore, only: dycore_is - - - ! Register a budget. - - character(len=*), intent(in) :: & - name,stg1name,stg2name ! budget name used as variable name in history file output (8 char max) - - character(len=*), intent(in) :: & - pkgtype ! budget type either phy or dyn - - character(len=*), intent(in) :: & - optype ! dif (difference) or sum or stg (stage) - - character(len=*), intent(in), optional :: & - longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) - - logical, intent(in), optional :: & - cslam ! true => use cslam to transport mass variables - - character(len=*), parameter :: sub='budget_diff_add' - character(len=128) :: errmsg - character(len=1) :: opchar - character (len=256) :: str1, str2, str3, strstg1, strstg2 - integer :: ivars - logical :: cslamtr ! using cslam transport for mass tracers - !----------------------------------------------------------------------- - - if (thermo_budget_history) then - if (present(cslam)) then - cslamtr=cslam - else - cslamtr = .false. - end if - -! register history budget variables - do ivars=1, thermo_budget_num_vars - - write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(name)) - write(strstg1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stg1name)) - write(strstg2,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stg2name)) - write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & - TRIM(ADJUSTL(longname)) - write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) - - - budget_num = budget_num + 1 - budget_pkgtype(budget_num)=pkgtype - - ! set budget name and constants - budget_name(budget_num) = trim(str1) - if (present(longname)) then - budget_longname(budget_num) = trim(str2) - else - budget_longname(budget_num) = trim(str1) - end if - if (optype=='dif') opchar='-' - if (optype=='sum') opchar='+' - if (optype=='stg') then - write(errmsg,*) sub//': FATAL: bad value optype should be sum of dif:', optype - call endrun(errmsg) - end if - budget_stg1name(budget_num) = trim(adjustl(strstg1)) - budget_stg2name(budget_num) = trim(adjustl(strstg2)) - budget_stagename(budget_num)= trim(adjustl(strstg1))//trim(opchar)//trim(adjustl(strstg2)) - budget_optype(budget_num)=optype - - - - if (pkgtype=='phy') then - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & - gridname='physgrid',op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) - else - if (dycore_is('SE')) then - if (cslamtr .and. thermo_budget_vars_massv(ivars)) then - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & - gridname='FVM',op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) - else - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & - gridname='GLL',op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) - end if - else if (dycore_is('MPAS')) then - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & - gridname='mpas_cell',op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) - else - call endrun(sub//'budget_add is only supported for MPAS and SE dycores') - call endrun(errmsg) - end if - end if - call add_default(TRIM(ADJUSTL(str1)), thermo_budget_histfile_num, 'N') - end do -end if - end subroutine budget_diff_add - -!============================================================================================== - -subroutine budget_init() - use time_manager, only: get_step_size - - stepsize=get_step_size() - -end subroutine budget_init -!============================================================================== - -subroutine budget_get_global (name, me_idx, global) - - use cam_history, only: get_field_properties - use cam_history_support, only: active_entry - use cam_thermo, only: thermo_budget_vars_massv - - ! Get the global integral of a budget. Optional abort argument allows returning - ! control to caller when budget name is not found. Default behavior is - ! to call endrun when name is not found. - - !-----------------------------Arguments--------------------------------- - character(len=*), intent(in) :: name ! budget name - integer, intent(in) :: me_idx ! mass energy variable index - real(r8), intent(out) :: global ! global budget index (in q array) - - !---------------------------Local workspace----------------------------- - type (active_entry), pointer :: tape(:) => null() ! history tapes - character (len=max_fieldname_len) :: str1 - character(len=128) :: errmsg - integer :: b_ind ! hentry index - integer :: f(ptapes),ff ! hentry index - integer :: idx,pidx,midx,uidx ! substring index for sum dif char - integer :: m ! budget index - logical :: found ! true if global integral found - - character(len=*), parameter :: sub='budget_get_global' - !----------------------------------------------------------------------- - - str1='' - write(str1,*) TRIM(ADJUSTL(name)) - - midx=index(str1, '-') - pidx=index(str1, '+') - idx=midx+pidx - - ! check for difference budget using stagename short format (stg1//op/stg2) where stg1 is name without thermo string appended - if (idx /= 0 .and. (midx==0 .or. pidx==0)) then - write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//trim(adjustl(str1(1:idx)))// & - TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//TRIM(ADJUSTL(str1(idx+1:))) - end if - - uidx=index(str1, '_') - if (uidx == 0) then - !This is a stage name need to append the type of thermo variable using input index - write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//trim(adjustl(str1(1:))) - end if - - b_ind=budget_ind_byname(trim(adjustl(str1))) - - if (b_ind < 0) call endrun(sub//'FATAL field name '//name//' not found'//' looked for '//trim(adjustl(str1))) - - write(str1,*) TRIM(ADJUSTL(budget_name(b_ind))) - - ! Find budget name in list and return global value - call get_field_properties(trim(adjustl(str1)), found, tape_out=tape, ff_out=ff, f_out=f) - - if (found.and.f(thermo_budget_histfile_num)>0) then - call tape(thermo_budget_histfile_num)%hlist(f(thermo_budget_histfile_num))%get_global(global) - if (.not. thermo_budget_vars_massv(me_idx)) global=global/stepsize - else - write(errmsg,*) sub//': FATAL: name not found: ', trim(name) - call endrun(errmsg) - end if - -end subroutine budget_get_global -!============================================================================== -subroutine budget_put_global (name, me_idx, global) - - use cam_history, only: get_field_properties - use cam_history_support, only: active_entry - use cam_thermo, only: thermo_budget_vars_massv - - ! Get the global integral of a budget. Optional abort argument allows returning - ! control to caller when budget name is not found. Default behavior is - ! to call endrun when name is not found. - - !-----------------------------Arguments--------------------------------- - character(len=*), intent(in) :: name ! budget name - integer, intent(in) :: me_idx ! mass energy variable index - real(r8), intent(in) :: global ! global budget index (in q array) - - !---------------------------Local workspace----------------------------- - type (active_entry), pointer :: tape(:) => null() ! history tapes - integer :: m ! budget index - integer :: f(ptapes),ff ! hentry index - character(len=*), parameter :: sub='budget_put_global' - character(len=128) :: errmsg - character (len=128) :: str1 - logical :: found ! true if global integral found - real(r8) :: global_normalized - !----------------------------------------------------------------------- - - ! append thermo field to stage name - write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(me_idx))),"_",TRIM(ADJUSTL(name)) - - ! Find budget name in list and push global value to hentry - call get_field_properties(trim(str1), found, tape_out=tape, ff_out=ff, f_out=f) - if (found.and.f(thermo_budget_histfile_num)>0) then - if (.not. thermo_budget_vars_massv(me_idx)) global_normalized=global/stepsize - call tape(thermo_budget_histfile_num)%hlist(f(thermo_budget_histfile_num))%put_global(global_normalized) - else - write(errmsg,*) sub//': FATAL: name not found: ', trim(name) - call endrun(errmsg) - end if - -end subroutine budget_put_global -!============================================================================== -function budget_ind_byname (name) - ! - ! Get the index of a budget. Ret -1 for not found - !-----------------------------Arguments--------------------------------- - character(len=*), intent(in) :: name ! budget name - - !---------------------------Local workspace----------------------------- - integer :: budget_ind_byname ! function return - integer :: m ! budget index - character(len=*), parameter :: sub='budget_ind_byname' - !----------------------------------------------------------------------- - ! Find budget name in list - budget_ind_byname = -1 - do m = 1, budget_array_max - if (trim(adjustl(name)) == trim(adjustl(budget_name(m))).or.trim(adjustl(name)) == trim(adjustl(budget_stagename(m)))) then - budget_ind_byname = m - return - end if - end do - end function budget_ind_byname - -!============================================================================== - - function is_budget(name) - - ! Get the index of a budget. Optional abort argument allows returning - ! control to caller when budget name is not found. Default behavior is - ! to call endrun when name is not found. - - !-----------------------------Arguments--------------------------------- - character(len=*), intent(in) :: name ! budget name - - !---------------------------Local workspace----------------------------- - logical :: is_budget ! function return - integer :: m ! budget index - character(len=*), parameter :: sub='is_budget' - !----------------------------------------------------------------------- - - ! Find budget name in list of defined budgets - - is_budget = .false. - do m = 1, budget_array_max - if (trim(name) == trim(budget_name(m)).or.trim(name) == trim(budget_stagename(m))) then - is_budget = .true. - return - end if - end do - end function is_budget - - !=========================================================================== - ! Read namelist variables. - subroutine budget_readnl(nlfile) - use namelist_utils, only: find_group_name - use spmd_utils, only: mpi_character, mpi_logical, mpi_integer - use shr_string_mod, only: shr_string_toUpper - - ! Dummy argument: filepath for file containing namelist input - character(len=*), intent(in) :: nlfile - - ! Local variables - integer :: unitn, ierr - integer, parameter :: lsize = 76 - integer, parameter :: fsize = 23 - character(len=*), parameter :: subname = 'budget_readnl :: ' - character(len=8) :: period - logical :: thermo_budgeting - - namelist /thermo_budget_nl/ thermo_budget_history, thermo_budget_histfile_num - !----------------------------------------------------------------------- - - if (masterproc) then - open(newunit=unitn, file=trim(nlfile), status='old') - call find_group_name(unitn, 'thermo_budget_nl', status=ierr) - if (ierr == 0) then - read(unitn, thermo_budget_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(subname//'ERROR reading namelist, thermo_budget_nl') - end if - end if - close(unitn) - end if - - ! Broadcast namelist variables - call mpi_bcast(thermo_budget_history , 1 , mpi_logical , masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_history") - call mpi_bcast(thermo_budget_histfile_num , 1 , mpi_integer , masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_histfile_num") - - ! Write out thermo_budget options - if (masterproc) then - if (thermo_budget_history) then - write(iulog,*)'Thermo budgets will be written to the log file and diagnostics saved to history file:',& - thermo_budget_histfile_num - end if - end if - end subroutine budget_readnl + subroutine e_m_budget (name, stg1name, stg2name, pkgtype, optype, longname, cslam) + use dycore, only: dycore_is + + + ! Register a budget. + + character(len=*), intent(in) :: & + name,stg1name,stg2name ! budget name used as variable name in history file output (8 char max) + + character(len=*), intent(in) :: & + pkgtype ! budget type either phy or dyn + + character(len=*), intent(in) :: & + optype ! dif (difference) or sum or stg (stage) + + character(len=*), intent(in), optional :: & + longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) + + logical, intent(in), optional :: & + cslam ! true => use cslam to transport mass variables + + character(len=*), parameter :: sub='e_m_budget' + character(len=128) :: errmsg + character(len=1) :: opchar + character (len=256) :: str1, str2, str3, strstg1, strstg2 + integer :: ivars + logical :: cslamtr ! using cslam transport for mass tracers + !----------------------------------------------------------------------- + + if (thermo_budget_history) then + if (present(cslam)) then + cslamtr=cslam + else + cslamtr = .false. + end if + + ! register history budget variables + do ivars=1, thermo_budget_num_vars + + write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(name)) + write(strstg1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stg1name)) + write(strstg2,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stg2name)) + write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & + TRIM(ADJUSTL(longname)) + write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) + + + budget_num = budget_num + 1 + budget_pkgtype(budget_num)=pkgtype + + ! set budget name and constants + budget_name(budget_num) = trim(str1) + if (present(longname)) then + budget_longname(budget_num) = trim(str2) + else + budget_longname(budget_num) = trim(str1) + end if + if (optype=='dif') opchar='-' + if (optype=='sum') opchar='+' + if (optype=='stg') then + write(errmsg,*) sub//': FATAL: bad value optype should be sum of dif:', optype + call endrun(errmsg) + end if + budget_stg1name(budget_num) = trim(adjustl(strstg1)) + budget_stg2name(budget_num) = trim(adjustl(strstg2)) + budget_stagename(budget_num)= trim(adjustl(strstg1))//trim(opchar)//trim(adjustl(strstg2)) + budget_optype(budget_num)=optype + + if (pkgtype=='phy') then + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & + gridname='physgrid',op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) + else + if (dycore_is('SE')) then + if (cslamtr .and. thermo_budget_vars_massv(ivars)) then + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & + gridname='FVM',op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) + else + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & + gridname='GLL',op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) + end if + else if (dycore_is('MPAS')) then + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & + gridname='mpas_cell',op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) + else + call endrun(sub//'budget_add is only supported for MPAS and SE dycores') + call endrun(errmsg) + end if + end if + call add_default(TRIM(ADJUSTL(str1)), thermo_budget_histfile_num, 'N') + end do + end if + end subroutine e_m_budget + + !============================================================================================== + + subroutine budget_init() + use time_manager, only: get_step_size + + stepsize=get_step_size() + + end subroutine budget_init + !============================================================================== + + subroutine budget_get_global (name, me_idx, global) + + use cam_history, only: get_field_properties + use cam_history_support, only: active_entry + use cam_thermo, only: thermo_budget_vars_massv + + ! Get the global integral of a budget. Optional abort argument allows returning + ! control to caller when budget name is not found. Default behavior is + ! to call endrun when name is not found. + + !-----------------------------Arguments--------------------------------- + character(len=*), intent(in) :: name ! budget name + integer, intent(in) :: me_idx ! mass energy variable index + real(r8), intent(out) :: global ! global budget index (in q array) + + !---------------------------Local workspace----------------------------- + type (active_entry), pointer :: tape(:) => null() ! history tapes + character (len=max_fieldname_len) :: str1 + character(len=128) :: errmsg + integer :: b_ind ! hentry index + integer :: f(ptapes),ff ! hentry index + integer :: idx,pidx,midx,uidx ! substring index for sum dif char + integer :: m ! budget index + logical :: found ! true if global integral found + + character(len=*), parameter :: sub='budget_get_global' + !----------------------------------------------------------------------- + + str1='' + write(str1,*) TRIM(ADJUSTL(name)) + + midx=index(str1, '-') + pidx=index(str1, '+') + idx=midx+pidx + + ! check for budget using stagename short format (stg1//op/stg2) where stg1 is name without thermo string appended + if (idx /= 0 .and. (midx==0 .or. pidx==0)) then + write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//trim(adjustl(str1(1:idx)))// & + TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//TRIM(ADJUSTL(str1(idx+1:))) + end if + + uidx=index(str1, '_') + if (uidx == 0) then + !This is a stage name need to append the type of thermo variable using input index + write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//trim(adjustl(str1(1:))) + end if + + b_ind=budget_ind_byname(trim(adjustl(str1))) + + if (b_ind < 0) call endrun(sub//'FATAL field name '//name//' not found'//' looked for '//trim(adjustl(str1))) + + write(str1,*) TRIM(ADJUSTL(budget_name(b_ind))) + + ! Find budget name in list and return global value + call get_field_properties(trim(adjustl(str1)), found, tape_out=tape, ff_out=ff, f_out=f) + + if (found.and.f(thermo_budget_histfile_num)>0) then + call tape(thermo_budget_histfile_num)%hlist(f(thermo_budget_histfile_num))%get_global(global) + if (.not. thermo_budget_vars_massv(me_idx)) global=global/stepsize + else + write(errmsg,*) sub//': FATAL: name not found: ', trim(name) + call endrun(errmsg) + end if + + end subroutine budget_get_global + !============================================================================== + subroutine budget_put_global (name, me_idx, global) + + use cam_history, only: get_field_properties + use cam_history_support, only: active_entry + use cam_thermo, only: thermo_budget_vars_massv + + ! Get the global integral of a budget. Optional abort argument allows returning + ! control to caller when budget name is not found. Default behavior is + ! to call endrun when name is not found. + + !-----------------------------Arguments--------------------------------- + character(len=*), intent(in) :: name ! budget name + integer, intent(in) :: me_idx ! mass energy variable index + real(r8), intent(in) :: global ! global budget index (in q array) + + !---------------------------Local workspace----------------------------- + type (active_entry), pointer :: tape(:) => null() ! history tapes + integer :: m ! budget index + integer :: f(ptapes),ff ! hentry index + character(len=*), parameter :: sub='budget_put_global' + character(len=128) :: errmsg + character (len=128) :: str1 + logical :: found ! true if global integral found + real(r8) :: global_normalized + !----------------------------------------------------------------------- + + ! append thermo field to stage name + write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(me_idx))),"_",TRIM(ADJUSTL(name)) + + ! Find budget name in list and push global value to hentry + call get_field_properties(trim(str1), found, tape_out=tape, ff_out=ff, f_out=f) + if (found.and.f(thermo_budget_histfile_num)>0) then + if (.not. thermo_budget_vars_massv(me_idx)) global_normalized=global/stepsize + call tape(thermo_budget_histfile_num)%hlist(f(thermo_budget_histfile_num))%put_global(global_normalized) + else + write(errmsg,*) sub//': FATAL: name not found: ', trim(name) + call endrun(errmsg) + end if + + end subroutine budget_put_global + !============================================================================== + function budget_ind_byname (name) + ! + ! Get the index of a budget. Ret -1 for not found + !-----------------------------Arguments--------------------------------- + character(len=*), intent(in) :: name ! budget name + + !---------------------------Local workspace----------------------------- + integer :: budget_ind_byname ! function return + integer :: m ! budget index + character(len=*), parameter :: sub='budget_ind_byname' + !----------------------------------------------------------------------- + ! Find budget name in list + budget_ind_byname = -1 + do m = 1, budget_array_max + if (trim(adjustl(name)) == trim(adjustl(budget_name(m))).or.trim(adjustl(name)) == trim(adjustl(budget_stagename(m)))) then + budget_ind_byname = m + return + end if + end do + end function budget_ind_byname + + !============================================================================== + + function is_budget(name) + + ! Get the index of a budget. Optional abort argument allows returning + ! control to caller when budget name is not found. Default behavior is + ! to call endrun when name is not found. + + !-----------------------------Arguments--------------------------------- + character(len=*), intent(in) :: name ! budget name + + !---------------------------Local workspace----------------------------- + logical :: is_budget ! function return + integer :: m ! budget index + character(len=*), parameter :: sub='is_budget' + !----------------------------------------------------------------------- + + ! Find budget name in list of defined budgets + + is_budget = .false. + do m = 1, budget_array_max + if (trim(name) == trim(budget_name(m)).or.trim(name) == trim(budget_stagename(m))) then + is_budget = .true. + return + end if + end do + end function is_budget + + !=========================================================================== + ! Read namelist variables. + subroutine budget_readnl(nlfile) + use namelist_utils, only: find_group_name + use spmd_utils, only: mpi_character, mpi_logical, mpi_integer + use shr_string_mod, only: shr_string_toUpper + + ! Dummy argument: filepath for file containing namelist input + character(len=*), intent(in) :: nlfile + + ! Local variables + integer :: unitn, ierr + integer, parameter :: lsize = 76 + integer, parameter :: fsize = 23 + character(len=*), parameter :: subname = 'budget_readnl :: ' + character(len=8) :: period + logical :: thermo_budgeting + + namelist /thermo_budget_nl/ thermo_budget_history, thermo_budget_histfile_num + !----------------------------------------------------------------------- + + if (masterproc) then + open(newunit=unitn, file=trim(nlfile), status='old') + call find_group_name(unitn, 'thermo_budget_nl', status=ierr) + if (ierr == 0) then + read(unitn, thermo_budget_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname//'ERROR reading namelist, thermo_budget_nl') + end if + end if + close(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast(thermo_budget_history , 1 , mpi_logical , masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_history") + call mpi_bcast(thermo_budget_histfile_num , 1 , mpi_integer , masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_histfile_num") + + ! Write out thermo_budget options + if (masterproc) then + if (thermo_budget_history) then + write(iulog,*)'Thermo budgets will be written to the log file and diagnostics saved to history file:',& + thermo_budget_histfile_num + end if + end if + end subroutine budget_readnl end module budgets diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 43941af84c..efe3dc9d1b 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -3473,7 +3473,7 @@ end subroutine list_index recursive subroutine outfld (fname, field, idim, c, avg_subcol_field) use cam_history_buffers, only: hbuf_accum_inst, hbuf_accum_add, hbuf_accum_variance, & hbuf_accum_add00z, hbuf_accum_max, hbuf_accum_min, & - hbuf_accum_addlcltime, hbuf_accum_addnsteps + hbuf_accum_addlcltime use cam_history_support, only: dim_index_2d use subcol_pack_mod, only: subcol_unpack use cam_grid_support, only: cam_grid_id @@ -3649,7 +3649,7 @@ end subroutine subcol_field_avg_handler flag_xyfill, fillvalue) case ('N') ! Time average over nsteps - call hbuf_accum_addnsteps(hbuf, ufield, nacs, dimind, pcols, & + call hbuf_accum_add(hbuf, ufield, nacs, dimind, pcols, & flag_xyfill, fillvalue) case ('X') ! Maximum over time @@ -3691,7 +3691,7 @@ end subroutine subcol_field_avg_handler flag_xyfill, fillvalue) case ('N') ! Time average over nsteps - call hbuf_accum_addnsteps (hbuf, field, nacs, dimind, idim, & + call hbuf_accum_add (hbuf, field, nacs, dimind, idim, & flag_xyfill, fillvalue) case ('X') ! Maximum over time diff --git a/src/control/cam_history_buffers.F90 b/src/control/cam_history_buffers.F90 index ae3c927517..b26162753c 100644 --- a/src/control/cam_history_buffers.F90 +++ b/src/control/cam_history_buffers.F90 @@ -112,59 +112,6 @@ end subroutine hbuf_accum_add !####################################################################### - subroutine hbuf_accum_addnsteps (buf8, field, nacs, dimind, idim, flag_xyfill, fillvalue) - ! - !----------------------------------------------------------------------- - ! - ! Purpose: Add the values of field to 2-D hbuf. - ! - !----------------------------------------------------------------------- - ! - real(r8), pointer :: buf8(:,:) ! 2-D history buffer - integer, pointer :: nacs(:) ! accumulation counter - integer, intent(in) :: idim ! Longitude dimension of field array - logical, intent(in) :: flag_xyfill ! non-applicable xy points flagged with fillvalue - real(r8), intent(in ) :: field(idim,*) ! real*8 array - type (dim_index_2d), intent(in ) :: dimind ! 2-D dimension index - real(r8), intent(in) :: fillvalue - ! - ! Local indices - ! - integer :: ieu, jeu ! number of elements in each dimension - integer :: i,k ! indices - - call dimind%dim_sizes(ieu, jeu) - - if (flag_xyfill) then - do k=1,jeu - do i=1,ieu - if (field(i,k) /= fillvalue) then - buf8(i,k) = buf8(i,k) + field(i,k) - end if - end do - end do - ! - ! Ensure input field has fillvalue defined invariant in the z-direction, then increment nacs - ! - call check_accum (field, idim, ieu, jeu, fillvalue) - do i=1,ieu - if (field(i,1) /= fillvalue) then - nacs(i) = nacs(i) + 1 - end if - end do - else - do k=1,jeu - do i=1,ieu - buf8(i,k) = buf8(i,k) + field(i,k) - end do - end do - nacs(1) = nacs(1) + 1 - end if - - return - end subroutine hbuf_accum_addnsteps - - !####################################################################### subroutine hbuf_accum_variance (hbuf, sbuf, field, nacs, dimind, idim, flag_xyfill, fillvalue) ! !----------------------------------------------------------------------- diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index b408fe7f11..0e18271f04 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -106,7 +106,7 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) tracers => dyn_out % tracers if (compute_energy_diags) then - call tot_energy(nCellsSolve, plev,size(tracers, 1), index_qv, zz(:,1:nCellsSolve), zint(:,1:nCellsSolve), & + call tot_energy_dyn(nCellsSolve, plev,size(tracers, 1), index_qv, zz(:,1:nCellsSolve), zint(:,1:nCellsSolve), & rho_zz(:,1:nCellsSolve), theta_m(:,1:nCellsSolve), tracers(:,:,1:nCellsSolve),& ux(:,1:nCellsSolve),uy(:,1:nCellsSolve),'dBF') end if @@ -671,7 +671,7 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn tracers(idx_dycore,:,1:nCellsSolve)= qk(m,:,: )-dtime*q_tend(m,:,1:nCellsSolve) end do - call tot_energy( & + call tot_energy_dyn( & nCellsSolve, plev, size(tracers, 1), index_qv, zz(:,1:nCellsSolve), zint(:,1:nCellsSolve), rho_zz(:,1:nCellsSolve), & theta_m_new, tracers(:,:,1:nCellsSolve), & ux(:,1:nCellsSolve)+dtime*u_tend(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve), & @@ -685,7 +685,7 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn ! compute energy incl. water change ! theta_m_new = theta_m(:,1:nCellsSolve)+dtime*rtheta_tend(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve) - call tot_energy( & + call tot_energy_dyn( & nCellsSolve, plev, size(tracers, 1), index_qv, zz(:,1:nCellsSolve), zint(:,1:nCellsSolve), & rho_zz(:,1:nCellsSolve), theta_m_new, tracers(:,:,1:nCellsSolve), & ux(:,1:nCellsSolve)+dtime*u_tend(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve), & @@ -795,7 +795,7 @@ subroutine hydrostatic_pressure(nCells, nVertLevels, qsize, index_qv, zz, zgrid, end do end subroutine hydrostatic_pressure -subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, theta_m, q, ux,uy,outfld_name_suffix) +subroutine tot_energy_dyn(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, theta_m, q, ux,uy,outfld_name_suffix) use physconst, only: rair, cpair, gravit,cappa!=R/cp (dry air) use mpas_constants, only: p0,cv,rv,rgas,cp use cam_history, only: outfld, hist_fld_active @@ -892,6 +892,6 @@ subroutine tot_energy(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_zz, t call outfld(name_out(wiidx),ice ,ncells,1) call outfld(name_out(teidx),potential_energy+internal_energy+kinetic_energy,ncells,1) -end subroutine tot_energy +end subroutine tot_energy_dyn end module dp_coupling diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index 65bc0b797b..4ec329a7af 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -40,7 +40,7 @@ module dyn_comp use mpas_timekeeping, only : MPAS_TimeInterval_type use cam_mpas_subdriver, only: cam_mpas_global_sum_real -use budgets, only: budget_add +use budgets, only: e_m_snapshot, e_m_budget implicit none @@ -538,20 +538,18 @@ subroutine dyn_init(dyn_in, dyn_out) ! initialize history for MPAS energy budgets if (thermo_budget_history) then - ! Register stages for budgets - + + ! Define energy/mass snapshots using stage structure do istage = 1, num_stages - call budget_add(TRIM(ADJUSTL(stage(istage))), 'dyn', longname=TRIM(ADJUSTL(stage_txt(istage)))) + call e_m_snapshot(TRIM(ADJUSTL(stage(istage))), 'dyn', longname=TRIM(ADJUSTL(stage_txt(istage)))) end do - ! ! initialize MPAS energy budgets ! add budgets that are derived from stages ! - - call budget_add('mpas_param','dAP','dBF',pkgtype='dyn',optype='dif',longname="dE/dt parameterizations+efix in dycore (dparam)(dAP-dBF)") - call budget_add('mpas_dmea' ,'dAM','dAP',pkgtype='dyn',optype='dif',longname="dE/dt dry mass adjustment in dycore (dAM-dAP)") - call budget_add('mpas_phys_total' ,'dAM','dBF',pkgtype='dyn',optype='dif',longname="dE/dt physics total in dycore (phys) (dAM-dBF)") + call e_m_budget('mpas_param','dAP','dBF',pkgtype='dyn',optype='dif',longname="dE/dt parameterizations+efix in dycore (dparam)(dAP-dBF)") + call e_m_budget('mpas_dmea' ,'dAM','dAP',pkgtype='dyn',optype='dif',longname="dE/dt dry mass adjustment in dycore (dAM-dAP)") + call e_m_budget('mpas_phys_total' ,'dAM','dBF',pkgtype='dyn',optype='dif',longname="dE/dt physics total in dycore (phys) (dAM-dBF)") end if ! diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index 66f8e697fd..08b8bd8098 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -57,7 +57,7 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) use time_mod, only: timelevel_qdp use control_mod, only: qsplit use test_fvm_mapping, only: test_mapping_overwrite_dyn_state, test_mapping_output_phys_state - use prim_advance_mod, only: calc_tot_energy_dynamics + use prim_advance_mod, only: tot_energy_dyn ! arguments type(dyn_export_t), intent(inout) :: dyn_out ! dynamics export type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -128,7 +128,7 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) allocate(q_tmp(nphys_pts,pver,pcnst,nelemd)) allocate(omega_tmp(nphys_pts,pver,nelemd)) - call calc_tot_energy_dynamics(elem,dyn_out%fvm, 1, nelemd,tl_f , tl_qdp_np0,'dBF') + call tot_energy_dyn(elem,dyn_out%fvm, 1, nelemd,tl_f , tl_qdp_np0,'dBF') if (use_gw_front .or. use_gw_front_igw) then allocate(frontgf(nphys_pts,pver,nelemd), stat=ierr) diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index d08b9df3a7..9864aa5d7e 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -10,7 +10,7 @@ module prim_advance_mod private save - public :: prim_advance_exp, prim_advance_init, applyCAMforcing, calc_tot_energy_dynamics, compute_omega + public :: prim_advance_exp, prim_advance_init, applyCAMforcing, tot_energy_dyn, compute_omega type (EdgeBuffer_t) :: edge3,edgeOmega,edgeSponge real (kind=r8), allocatable :: ur_weights(:) @@ -428,7 +428,7 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu else call output_qdp_var_dynamics(ftmp(:,:,:,:,:),np,qsize,nets,nete,'PDC') end if - if (ftype==1.and.nsubstep==1) call calc_tot_energy_dynamics(elem,fvm,nets,nete,np1,np1_qdp,'p2d') + if (ftype==1.and.nsubstep==1) call tot_energy_dyn(elem,fvm,nets,nete,np1,np1_qdp,'p2d') if (ntrac>0) deallocate(ftmp_fvm) end subroutine applyCAMforcing @@ -510,7 +510,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! do ic=1,hypervis_subcycle - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dBH') + call tot_energy_dyn(elem,fvm,nets,nete,nt,qn0,'dBH') rhypervis_subcycle=1.0_r8/real(hypervis_subcycle,kind=r8) call biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend,hvcoord) @@ -670,7 +670,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, enddo end do - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dCH') + call tot_energy_dyn(elem,fvm,nets,nete,nt,qn0,'dCH') do ie=nets,nete !$omp parallel do num_threads(vert_num_threads), private(k,i,j,v1,v2,heating) do k=ksponge_end,nlev @@ -693,7 +693,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, enddo enddo enddo - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dAH') + call tot_energy_dyn(elem,fvm,nets,nete,nt,qn0,'dAH') end do ! @@ -768,7 +768,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, ! Horizontal Laplacian diffusion ! dt=dt2/hypervis_subcycle_sponge - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dBS') + call tot_energy_dyn(elem,fvm,nets,nete,nt,qn0,'dBS') kblk = ksponge_end do ic=1,hypervis_subcycle_sponge rhypervis_subcycle=1.0_r8/real(hypervis_subcycle_sponge,kind=r8) @@ -948,7 +948,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, end do end do call t_stopf('sponge_diff') - call calc_tot_energy_dynamics(elem,fvm,nets,nete,nt,qn0,'dAS') + call tot_energy_dyn(elem,fvm,nets,nete,nt,qn0,'dAS') end subroutine advance_hypervis_dp @@ -1434,7 +1434,7 @@ subroutine distribute_flux_at_corners(cflux, corners, getmapP) endif end subroutine distribute_flux_at_corners - subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suffix) + subroutine tot_energy_dyn(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suffix) use dimensions_mod, only: npsq,nlev,np,lcp_moist,nc,ntrac,qsize use physconst, only: gravit, cpair, rearth, omega use element_mod, only: element_t @@ -1650,7 +1650,7 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf end do endif ! if thermo budget history - end subroutine calc_tot_energy_dynamics + end subroutine tot_energy_dyn subroutine output_qdp_var_dynamics(qdp,nx,num_trac,nets,nete,outfld_name) diff --git a/src/dynamics/se/dycore/prim_driver_mod.F90 b/src/dynamics/se/dycore/prim_driver_mod.F90 index 5ea869b53c..8538156882 100644 --- a/src/dynamics/se/dycore/prim_driver_mod.F90 +++ b/src/dynamics/se/dycore/prim_driver_mod.F90 @@ -221,7 +221,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst use time_mod, only: TimeLevel_t, timelevel_update, timelevel_qdp, nsplit use control_mod, only: statefreq,qsplit, rsplit, variable_nsplit use prim_advance_mod, only: applycamforcing - use prim_advance_mod, only: calc_tot_energy_dynamics,compute_omega + use prim_advance_mod, only: tot_energy_dyn,compute_omega use prim_state_mod, only: prim_printstate, adjust_nsplit use prim_advection_mod, only: vertical_remap, deriv use thread_mod, only: omp_get_thread_num @@ -282,9 +282,9 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst call TimeLevel_Qdp( tl, qsplit, n0_qdp) - call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%n0,n0_qdp,'dAF') + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dAF') call ApplyCAMForcing(elem,fvm,tl%n0,n0_qdp,dt_remap,dt_phys,nets,nete,nsubstep) - call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') + call tot_energy_dyn(elem,fvm,nets,nete,tl%n0,n0_qdp,'dBD') do r=1,rsplit if (r.ne.1) call TimeLevel_update(tl,"leapfrog") call prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,r) @@ -300,7 +300,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst ! always for tracers !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAD') + call tot_energy_dyn(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAD') if (variable_nsplit.or.compute_diagnostics) then ! @@ -317,7 +317,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! time step is complete. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - call calc_tot_energy_dynamics(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAR') + call tot_energy_dyn(elem,fvm,nets,nete,tl%np1,np1_qdp,'dAR') if (nsubstep==nsplit) then call compute_omega(hybrid,tl%np1,np1_qdp,elem,deriv,nets,nete,dt_remap,hvcoord) diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index dda561ac11..e6ca61408a 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -605,7 +605,7 @@ subroutine dyn_init(dyn_in, dyn_out) use control_mod, only: vert_remap_uvTq_alg, vert_remap_tracer_alg use std_atm_profile, only: std_atm_height use dyn_tests_utils, only: vc_dycore, vc_dry_pressure, string_vc, vc_str_lgth - use budgets, only: budget_add, thermo_budget_history + use budgets, only: e_m_snapshot, e_m_budget, thermo_budget_history ! Dummy arguments: type(dyn_import_t), intent(out) :: dyn_in @@ -903,39 +903,39 @@ subroutine dyn_init(dyn_in, dyn_out) ! Register stages for budgets do istage = 1, num_stages - call budget_add(TRIM(ADJUSTL(stage(istage))), 'dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), cslam=ntrac>0) + call e_m_snapshot(TRIM(ADJUSTL(stage(istage))), 'dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), cslam=ntrac>0) end do ! ! Register dif/sum budgets. ! - call budget_add('BD_dyn_total','dBF','dED','dyn','dif',longname="dE/dt dyn total (dycore+phys tendency (dBF-dED)",cslam=ntrac>0) + call e_m_budget('BD_dyn_total','dBF','dED','dyn','dif',longname="dE/dt dyn total (dycore+phys tendency (dBF-dED)",cslam=ntrac>0) - call budget_add('rate_2d_dyn','dAD','dBD','dyn','dif',longname="rate_of_change_2d_dyn (dAD-dBD)",cslam=ntrac>0) + call e_m_budget('rate_2d_dyn','dAD','dBD','dyn','dif',longname="rate_of_change_2d_dyn (dAD-dBD)",cslam=ntrac>0) - call budget_add('rate_vert_remap','dAR','dAD','dyn','dif',longname="rate_of_change_2d_dyn (dAR-dAD)",cslam=ntrac>0) + call e_m_budget('rate_vert_remap','dAR','dAD','dyn','dif',longname="rate_of_change_2d_dyn (dAR-dAD)",cslam=ntrac>0) - call budget_add('BD_dyn_adai','rate_2d_dyn','rate_vert_remap','dyn','sum',longname="dE/dt total adiabatic dynamics (adiab=rate2ddyn+vremap) ",cslam=ntrac>0) + call e_m_budget('BD_dyn_adai','rate_2d_dyn','rate_vert_remap','dyn','sum',longname="dE/dt total adiabatic dynamics (adiab=rate2ddyn+vremap) ",cslam=ntrac>0) - call budget_add('BD_dyn_2D','dAD','dBD','dyn','dif',longname="dE/dt 2D dynamics (dAD-dBD)",cslam=ntrac>0) + call e_m_budget('BD_dyn_2D','dAD','dBD','dyn','dif',longname="dE/dt 2D dynamics (dAD-dBD)",cslam=ntrac>0) - call budget_add('BD_dyn_remap','dAR','dAD','dyn','dif',longname="dE/dt vertical remapping (dAR-dAD)",cslam=ntrac>0) + call e_m_budget('BD_dyn_remap','dAR','dAD','dyn','dif',longname="dE/dt vertical remapping (dAR-dAD)",cslam=ntrac>0) - call budget_add('BD_dyn_ptend','dBD','dAF','dyn','dif',longname="dE/dt physics tendency in dynamics (dBD-dAF)",cslam=ntrac>0) + call e_m_budget('BD_dyn_ptend','dBD','dAF','dyn','dif',longname="dE/dt physics tendency in dynamics (dBD-dAF)",cslam=ntrac>0) - call budget_add('BD_dyn_hvis','dCH','dBH','dyn','dif',longname="dE/dt hypervis del4 (dCH-dBH)",cslam=ntrac>0) + call e_m_budget('BD_dyn_hvis','dCH','dBH','dyn','dif',longname="dE/dt hypervis del4 (dCH-dBH)",cslam=ntrac>0) - call budget_add('BD_dyn_fric','dAH','dCH','dyn','dif',longname="dE/dt hypervis frictional heating del4 (dAH-dCH)",cslam=ntrac>0) + call e_m_budget('BD_dyn_fric','dAH','dCH','dyn','dif',longname="dE/dt hypervis frictional heating del4 (dAH-dCH)",cslam=ntrac>0) - call budget_add('BD_dyn_difdel4tot','dAH','dBH','dyn','dif',longname="dE/dt hypervis del4 total (dAH-dBH)",cslam=ntrac>0) + call e_m_budget('BD_dyn_difdel4tot','dAH','dBH','dyn','dif',longname="dE/dt hypervis del4 total (dAH-dBH)",cslam=ntrac>0) - call budget_add('BD_dyn_sponge','dAS','dBS','dyn','dif',longname="dE/dt hypervis sponge total (dAS-dBS)",cslam=ntrac>0) + call e_m_budget('BD_dyn_sponge','dAS','dBS','dyn','dif',longname="dE/dt hypervis sponge total (dAS-dBS)",cslam=ntrac>0) - call budget_add('BD_dyn_difftot','BD_dyn_difdel4tot','BD_dyn_sponge','dyn','sum',longname="dE/dt explicit diffusion total (hvisdel4tot+hvisspngtot)",cslam=ntrac>0) + call e_m_budget('BD_dyn_difftot','BD_dyn_difdel4tot','BD_dyn_sponge','dyn','sum',longname="dE/dt explicit diffusion total (hvisdel4tot+hvisspngtot)",cslam=ntrac>0) - call budget_add('BD_dyn_res','BD_dyn_2D','BD_dyn_difftot','dyn','dif',longname="dE/dt residual (2ddyn-expdifftot)",cslam=ntrac>0) + call e_m_budget('BD_dyn_res','BD_dyn_2D','BD_dyn_difftot','dyn','dif',longname="dE/dt residual (2ddyn-expdifftot)",cslam=ntrac>0) - call budget_add('hrate','dAH','dCH','dyn','dif',longname="rate of change heating term put back in (dAH-dCH)",cslam=ntrac>0) + call e_m_budget('hrate','dAH','dCH','dyn','dif',longname="rate of change heating term put back in (dAH-dCH)",cslam=ntrac>0) end if ! diff --git a/src/dynamics/se/stepon.F90 b/src/dynamics/se/stepon.F90 index febda50539..88dda66c3d 100644 --- a/src/dynamics/se/stepon.F90 +++ b/src/dynamics/se/stepon.F90 @@ -154,7 +154,7 @@ subroutine stepon_run2(phys_state, phys_tend, dyn_in, dyn_out) use time_mod, only: TimeLevel_Qdp use control_mod, only: qsplit - use prim_advance_mod, only: calc_tot_energy_dynamics + use prim_advance_mod, only: tot_energy_dyn ! arguments @@ -194,7 +194,7 @@ subroutine stepon_run2(phys_state, phys_tend, dyn_in, dyn_out) call t_stopf('p_d_coupling') if (iam < par%nprocs) then - call calc_tot_energy_dynamics(dyn_in%elem,dyn_in%fvm, 1, nelemd, tl_f, tl_fQdp,'dED') + call tot_energy_dyn(dyn_in%elem,dyn_in%fvm, 1, nelemd, tl_f, tl_fQdp,'dED') end if end subroutine stepon_run2 diff --git a/src/physics/cam/cam_diagnostics.F90 b/src/physics/cam/cam_diagnostics.F90 index fd64dd60d0..4b5db6ce76 100644 --- a/src/physics/cam/cam_diagnostics.F90 +++ b/src/physics/cam/cam_diagnostics.F90 @@ -190,7 +190,7 @@ subroutine diag_init_dry(pbuf2d) use cam_history, only: addfld, add_default, horiz_only use cam_history, only: register_vector_field use tidal_diag, only: tidal_diag_init - use budgets, only: budget_add, thermo_budget_history + use budgets, only: e_m_snapshot, e_m_budget, thermo_budget_history type(physics_buffer_desc), pointer, intent(in) :: pbuf2d(:,:) @@ -396,24 +396,24 @@ subroutine diag_init_dry(pbuf2d) if (thermo_budget_history) then ! - ! energy diagnostics addflds for vars_stage combinations plus budget_adds + ! energy diagnostics addflds for vars_stage combinations plus e_m_snapshots ! do istage = 1, num_stages - call budget_add(TRIM(ADJUSTL(stage(istage))),'phy',longname=TRIM(ADJUSTL(stage_txt(istage)))) + call e_m_snapshot(TRIM(ADJUSTL(stage(istage))),'phy',longname=TRIM(ADJUSTL(stage_txt(istage)))) end do ! Create budgets that are a sum/dif of 2 stages - call budget_add('BP_param_and_efix','phAP','phBF','phy','dif',longname='dE/dt CAM physics parameterizations + efix dycore E (phAP-phBF)') - call budget_add('BD_param_and_efix','dyAP','dyBF','phy','dif',longname='dE/dt CAM physics parameterizations + efix dycore E (dyAP-dyBF)') - call budget_add('BP_phy_params','phAP','phBP','phy','dif',longname='dE/dt CAM physics parameterizations (phAP-phBP)') - call budget_add('BD_phy_params','dyAP','dyBP','phy','dif',longname='dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)') - call budget_add('BP_pwork','phAM','phAP','phy','dif',longname='dE/dt dry mass adjustment (phAM-phAP)') - call budget_add('BD_pwork','dyAM','dyAP','phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)') - call budget_add('BP_efix','phBP','phBF','phy','dif',longname='dE/dt energy fixer (phBP-phBF)') - call budget_add('BD_efix','dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E (dyBP-dyBF)') - call budget_add('BP_phys_tot','phAM','phBF','phy','dif',longname='dE/dt physics total (phAM-phBF)') - call budget_add('BD_phys_tot','dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)') + call e_m_budget('BP_param_and_efix','phAP','phBF','phy','dif',longname='dE/dt CAM physics parameterizations + efix dycore E (phAP-phBF)') + call e_m_budget('BD_param_and_efix','dyAP','dyBF','phy','dif',longname='dE/dt CAM physics parameterizations + efix dycore E (dyAP-dyBF)') + call e_m_budget('BP_phy_params','phAP','phBP','phy','dif',longname='dE/dt CAM physics parameterizations (phAP-phBP)') + call e_m_budget('BD_phy_params','dyAP','dyBP','phy','dif',longname='dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)') + call e_m_budget('BP_pwork','phAM','phAP','phy','dif',longname='dE/dt dry mass adjustment (phAM-phAP)') + call e_m_budget('BD_pwork','dyAM','dyAP','phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)') + call e_m_budget('BP_efix','phBP','phBF','phy','dif',longname='dE/dt energy fixer (phBP-phBF)') + call e_m_budget('BD_efix','dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E (dyBP-dyBF)') + call e_m_budget('BP_phys_tot','phAM','phBF','phy','dif',longname='dE/dt physics total (phAM-phBF)') + call e_m_budget('BD_phys_tot','dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)') endif end subroutine diag_init_dry diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 06d719bb86..1bd55b6545 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -50,7 +50,7 @@ module check_energy public :: check_tracers_init ! initialize tracer integrals and cumulative boundary fluxes public :: check_tracers_chng ! check changes in integrals against cumulative boundary fluxes - public :: calc_te_and_aam_budgets ! calculate and output total energy and axial angular momentum diagnostics + public :: tot_energy_phys ! calculate and output total energy and axial angular momentum diagnostics ! Private module data @@ -816,7 +816,7 @@ end subroutine check_tracers_chng !####################################################################### - subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) + subroutine tot_energy_phys(state, outfld_name_suffix,vc) use physconst, only: gravit,rearth,omega use cam_thermo, only: get_hydrostatic_energy,thermo_budget_num_vars,thermo_budget_vars, & wvidx,wlidx,wiidx,seidx,keidx,moidx,mridx,ttidx,teidx @@ -884,7 +884,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) cp_or_cv(:ncol,:) = cpairv(:ncol,:,lchnk) end if else - call endrun('calc_te_and_aam_budgets: energy diagnostics not implemented/tested for subcolumns') + call endrun('tot_energy_phys: energy diagnostics not implemented/tested for subcolumns') end if if (vc_loc == vc_height) then @@ -969,7 +969,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) call outfld(name_out(mridx) ,mr, pcols,lchnk ) call outfld(name_out(moidx) ,mo, pcols,lchnk ) - end subroutine calc_te_and_aam_budgets + end subroutine tot_energy_phys end module check_energy diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 6d700f480d..4770a5c63b 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -1370,7 +1370,7 @@ subroutine tphysac (ztodt, cam_in, & use aero_model, only: aero_model_drydep use carma_intr, only: carma_emission_tend, carma_timestep_tend use carma_flags_mod, only: carma_do_aerosol, carma_do_emission - use check_energy, only: check_energy_chng, calc_te_and_aam_budgets + use check_energy, only: check_energy_chng, tot_energy_phys use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng use time_manager, only: get_nstep use cam_abortutils, only: endrun @@ -1816,8 +1816,8 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat) end if - call calc_te_and_aam_budgets(state, 'phAP') - call calc_te_and_aam_budgets(state, 'dyAP',vc=vc_dycore) + call tot_energy_phys(state, 'phAP') + call tot_energy_phys(state, 'dyAP',vc=vc_dycore) !--------------------------------------------------------------------------------- ! Enforce charge neutrality after O+ change from ionos_tend @@ -1885,8 +1885,8 @@ subroutine tphysac (ztodt, cam_in, & ! update cp/cv for energy computation based in updated water variables call cam_thermo_water_update(state%q(:ncol,:,:), lchnk, ncol, vc_dycore, & to_dry_factor=state%pdel(:ncol,:)/state%pdeldry(:ncol,:)) - call calc_te_and_aam_budgets(state, 'phAM') - call calc_te_and_aam_budgets(state, 'dyAM', vc=vc_dycore) + call tot_energy_phys(state, 'phAM') + call tot_energy_phys(state, 'dyAM', vc=vc_dycore) ! Restore pre-"physics_dme_adjust" tracers state%q(:ncol,:pver,:pcnst) = tmp_trac(:ncol,:pver,:pcnst) state%pdel(:ncol,:pver) = tmp_pdel(:ncol,:pver) @@ -1907,8 +1907,8 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat) end if - call calc_te_and_aam_budgets(state, 'phAM') - call calc_te_and_aam_budgets(state, 'dyAM', vc=vc_dycore) + call tot_energy_phys(state, 'phAM') + call tot_energy_phys(state, 'dyAM', vc=vc_dycore) endif @@ -2000,7 +2000,7 @@ subroutine tphysbc (ztodt, state, & use convect_shallow, only: convect_shallow_tend use check_energy, only: check_energy_chng, check_energy_fix, check_energy_timestep_init use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng - use check_energy, only: calc_te_and_aam_budgets + use check_energy, only: tot_energy_phys use dycore, only: dycore_is use aero_model, only: aero_model_wetdep use carma_intr, only: carma_wetdep_tend, carma_timestep_tend @@ -2205,16 +2205,16 @@ subroutine tphysbc (ztodt, state, & !=================================================== call t_startf('energy_fixer') - call calc_te_and_aam_budgets(state, 'phBF') - call calc_te_and_aam_budgets(state, 'dyBF',vc=vc_dycore) + call tot_energy_phys(state, 'phBF') + call tot_energy_phys(state, 'dyBF',vc=vc_dycore) if (.not.dycore_is('EUL')) then call check_energy_fix(state, ptend, nstep, flx_heat) call physics_update(state, ptend, ztodt, tend) call check_energy_chng(state, tend, "chkengyfix", nstep, ztodt, zero, zero, zero, flx_heat) call outfld( 'EFIX', flx_heat , pcols, lchnk ) end if - call calc_te_and_aam_budgets(state, 'phBP') - call calc_te_and_aam_budgets(state, 'dyBP',vc=vc_dycore) + call tot_energy_phys(state, 'phBP') + call tot_energy_phys(state, 'dyBP',vc=vc_dycore) ! Save state for convective tendency calculations. call diag_conv_tend_ini(state, pbuf) From ff7debe86cf6ecbaf0d003d5bdc0226826f7c1a4 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 17 Mar 2023 16:43:05 -0600 Subject: [PATCH 071/140] Changelog for 099 because git is unable to merge --- doc/ChangeLog | 810 ++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 627 insertions(+), 183 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 005f65c8a0..440f790ed4 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,250 +1,694 @@ =============================================================== -Tag name: cam6_3_XXX -Originator(s): pel, jet -Date: 8 March 2023 -One-line Summary: Science and infrastructure updates for inline energy/mass budgets -Github PR URL: https://github.com/ESCOMP/CAM/pull/ +Tag name: cam6_3_099 +Originator(s): adamrher, eaton +Date: Thu Mar 16 11:22:00 AM EDT 2023 +One-line Summary: fix drydep emissions for cam_dev physics +Github PR URL: https://github.com/ESCOMP/CAM/pull/763 Purpose of changes (include the issue number and title text for each relevant GitHub issue): - Add inline energy/mass budgets support. (#519) Science changes are - included that help close the mass and energy budgets of physics - and the SE/MPAS dycores (#521) as well as adding all water - constituents to atmospheric mass (pressure) (#520) - - As of this commit energy/mass budgets have been roughed in for - physics and the SE and MPAS dycores. Similar to amwg_diagnostic - functionality, energy/mass budget diagnostic fields will be added - to a history file via the thermo_budget_histfile_num namelist - parameter. Globally averaged energy budget summaries are also - calculated and written to the atm log file every time the budget - history tape is written to. The period over which energy and mass - budgets are averaged is the same as the averaging period of the - history budget file. Thus history budgets can be output/averaged - at timestep, hour, or month resolutions using the nhtfrq variable - specific to the budget history file identified by - thermo_budget_histfile_num. The new namelist logical variable - thermo_buget_history is used to turn budgeting on (.true.) or off - (.false.) The default is .false. (no budgeting) because of the - global gathers needed to create the budgets. - - An energy or mass budget is defined by a mathematical operation - (sum/difference) of two energy/mass snapshots. For instance one - can talk of the energy lost/gained by the physics - parameterizations by comparing snapshots taken before and after - running the physics. - - An energy budget is created, logged and written to the budget history tape in four steps - 1) call e_m_snapshot to define multiple energy/mass snapshots - 2) call e_m_budget to define a budget as the difference/sum of two snapshots. - 3) call tot_energy_phys (or tot_energy_dyn) for each named snapshot - 4) setting namelist variables thermo_budget_history, thermo_budget_histfile_num, nhtfrq - - Energy and mass snapshots are defined and added to the history - buffer via the e_m_snapshot subroutine. The e_m_snapshot routine - creates a set of vertically integrated energy and mass history - output fields based on the snapshot name parameter prepended with - the types of energy and mass that are carried in cam and defined - in cam_thermo.F90 For example calling e_m_snapshot with a name of - 'dAP', perhaps standing for an energy snapshot after physics is - called, will create a set of fields that contain kinetic (KE_dAP), - sensible (SE_dAP), potential (PO_dAP) and total (TE_dap) energies - as well as atmospheric vapor (wv_dAP), liquid (wl_dAP) and ice - (wi_dAP) masses. A call to calc_total_energy for the each named - snapshot (here placed after after the physics parameterization) - will calculate and outfld the 9 or so specific energy and mass - snapshots. - - The e_m_budget routine defines a named budget composed of the - difference or sum of two snapshots. As with e_m_shapshot the - budget name is prepended with the same energies identifiers as - e_m_snapshot. All energy/mass snapshots as well as the budgets are - saved to the history buffer and written to the budget history - file. tot_energy_phys and tot_energy_dyn routines exists for both - physics and dynamics to allow snapshots tailored to thermodynamic - needs and data structures of those packages. +. Fixes #759 (https://github.com/ESCOMP/CAM/issues/759) + drydep of gas phase species "skipped" in cam_dev -Describe any changes made to build system: +Describe any changes made to build system: none -Describe any changes made to the namelist: - New budgeting namelist variables have been added. Interface - follows existing functionality to outfld standard diagnostics for - budgeting and diagnosis. +Describe any changes made to the namelist: none - thermo_budget_histfile_num: integer identifing which history file will contain - additional budgeting diagnostic fields - thermo_budget_history: logical that turns history budgeting on and off. +List any changes to the defaults for the boundary datasets: none -List any changes to the defaults for the boundary datasets: N/A +Describe any substantial timing or memory changes: none -Describe any substantial timing or memory changes: - Global gathers are done each time a thermo budgeting field is - written to the history file. The budgeting diagnostics are not - meant to be enabled during a production run. +Code reviewed by: jtruesdal, cacraigucar, fvitt, nusbaume -Code reviewed by: - -List all files eliminated: N/A +List all files eliminated: none -List all files added and what they do: - A src/cam/control/budget.F90 - provides support for energy/mass budgeting using cam_history infrastructure. +List all files added and what they do: none List all existing files that have been modified, and describe the changes: - M Externals.cfg - - update to include ctsm tag supporting MPAS defaults +src/chemistry/mozart/chemistry.F90 +. add state%rpdel, state%rpdeldry to actual args in call to + gas_phase_chemdr + +src/chemistry/mozart/mo_gas_phase_chemdr.F90 +. add rpdel, rpdeldry to dummy args for gas_phase_chemdr +. access cam_physpkg_is from phys_control module +. access gravit from physconst +. access cnst_type from constituents +. if cam_dev physics then apply drydep fluxes directly to the species + tendency array, else apply to the emissions array. + + +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: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_L32wsc (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + + - There are baseline diffs in all tests that use cam_dev physics. + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + + - pre-existing failure + +izumi/gnu/aux_cam: + + - All PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB except for cam_dev physics due to + fix in treatment of drydep fluxes. + +=============================================================== +=============================================================== - M namelist_defaults_cam.xml - - new mpas initial data default for mpasa120 aquaplanet. - - update cam_dev defaults to add Graupel constituent. +Tag name: cam6_3_098 +Originator(s): mvertens, eaton +Date: Tue Mar 14 09:16:31 MDT 2023 +One-line Summary: always pass NDEP from CAM and remove sst specs +Github PR URL: https://github.com/ESCOMP/CAM/pull/764 - M namelist_definition.xml - - new averaging flag option for budget variables 'N' allows normalization by nsteps. - - nstep normalization is required to properly budget subcycled fields. - - new namelist parameters for budgeting +Purpose of changes (include the issue number and title text for each relevant GitHub issue): - M cam_comp.F90 - - add call to print budgets. The print_budget function needs to be defined for all dycores. +. Resolve issue #104 - https://github.com/ESCOMP/CAM/issues/104 + Always send Nitrogen-deposition to surface components. - M cam_history.F90 - - new functionality for history buffered fields - - new area weighted global averaging functionality for history fields. - - create new composed hbuf field which is created from a sum/difference operation on - two existing fields. - - restart information added for budgeting. + This PR enables CAM to read in ndep (using the CDEPS inline API) from + forcing files if it is not computing NDEP prognostically. As a result + CAM will ALWAYS send NDEP to the mediator. - M cam_history_buffers.F90 - - new subroutine for nstep field averaging + Right how, CLM is not using the passed NDEP from the streams - since it + is still reading the drv_flds_in for NDEP. - M cam_history_support.F90 - - added support for new global average functionality + It is now possible for the drv_flds_in entry for ndep to be removed + and CLM can always accept NDEP from either CAM or DATM. - M runtime_opts.F90 - - added budget namelist read + New XML variables are introduced to specify the stream forcing. This is + being done in CTSM as well for all of its CDEPS stream specific variables. - M atm_comp_nuopc.F90 - - bug fix, support for E/W formatted initial data longitudes spanning -180:180 + NOTE: that CTSM also needs a new PR in order to accept these new fields + from CAM rather than use its own internal streams. + +. Remove old sst specs from the namelist. This is a cleanup. - M eul/dp_coupling.F90 - - update calling parameters +Describe any changes made to build system: none - M eul/dycore_budget.F90 - - Dummy routine for printing EUL budget - not fully supported yet. +Describe any changes made to the namelist: +. The follow variables are in new group ndep_stream_nl which is read in + src/cpl/nuopc/atm_stream_ndep.F90 + stream_ndep_year_first + stream_ndep_year_last + stream_ndep_year_align + stream_ndep_data_filename + stream_ndep_mesh_filename + +List any changes to the defaults for the boundary datasets: +. NDEP datasets are added by cime_config/config_component.xml + +Describe any substantial timing or memory changes: not tested + +Code reviewed by: gold2718, fvitt, cacraigucar, nusbaume, brian-eaton + +List all files eliminated: none + +List all files added and what they do: - M fv/dp_coupling.F90 - - update calling parameters +src/cpl/nuopc/atm_stream_ndep.F90 +. Contains methods for reading in nitrogen deposition data file. Also + includes functions for dynamic ndep file handling and interpolation. +. Reads namelist group ndep_stream_nl from the atm_in file. + +List all existing files that have been modified, and describe the changes: +bld/configure +. remove documentation for -ocn option. + +bld/namelist_files/namelist_defaults_cam.xml +. remove old settings for bndtvs, bndtvs_domain, and focndomain. DOM and + DOCN are no longer used. + +bld/namelist_files/namelist_definition.xml +. 5 new variables, stream_ndep_*, are added to group ndep_stream_nl +. bndtvs, focndomain, and bndtvs_domain removed +. 5 new variables, *_ndep, added to group ndep_stream_nml + +bld/namelist_files/use_cases/1850-2005_cam5.xml +bld/namelist_files/use_cases/sd_waccm_sulfur.xml +bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml +. remove defaults for stream_year_*, bndtvs, sstcyc + +bld/namelist_files/use_cases/aquaplanet_cam3.xml +bld/namelist_files/use_cases/aquaplanet_cam4.xml +bld/namelist_files/use_cases/aquaplanet_cam5.xml +bld/namelist_files/use_cases/aquaplanet_cam6.xml +bld/namelist_files/use_cases/aquaplanet_rce_cam6.xml +. remove default for aqua_planet (no longer in the namelist definition file) + +cime_config/buildnml +. get values of stream_ndep_* from the corresponding case variables + (CAM_STREAM_NDEP_*). Add the namelist key=value pairs to the string that + is generated to be passed via the -namelist option. + +cime_config/config_component.xml +. add values for the case variables CAM_STREAM_NDEP_* + +src/control/camsrfexch.F90 +. remove conditionals from allocation of cam_out%nhx_nitrogen_flx and + cam_out%noy_nitrogen_flx. CAM always provides this data now. + +src/cpl/nuopc/atm_comp_nuopc.F90 +. add explicit use/only statements for ESMF module +. add ESMF Mesh and clock objects with module scope, and add to the calling + args for export_fields. They are needed to generate streams. + +src/cpl/nuopc/atm_import_export.F90 +. mods so that nhx/noy are always in the list of fields that are exported. + If ndep_nflds=0 then the set_active_Faxa_* flags are set false. +. model_mesh, model_clock added to export_fields arg list +. add code to export_fields to use the stream code to set nhx/noy + deposition if it hasn't been computed. + +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. - M fv/dycore_budget.F90 - - Dummy routine for printing FV budget - not fully supported yet. +cheyenne/intel/aux_cam: + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + FAIL ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase NLCOMP + FAIL ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vmct.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + FAIL ERC_D_Ln9_Vmct.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase NLCOMP + ERC_D_Ln9_Vmct.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + FAIL ERC_D_Ln9_Vmct.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase NLCOMP + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator (Overall: NLFAIL) details: + FAIL ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator NLCOMP + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + FAIL ERC_D_Ln9_Vnuopc.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase NLCOMP + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + FAIL ERC_D_Ln9_Vnuopc.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase NLCOMP + ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.cheyenne_intel.cam-co2rmp_usecase (Overall: DIFF) details: + FAIL ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.cheyenne_intel.cam-co2rmp_usecase NLCOMP + FAIL ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.cheyenne_intel.cam-co2rmp_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s NLCOMP + ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s NLCOMP + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: NLFAIL) details: + FAIL ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d NLCOMP + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + FAIL ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h NLCOMP + FAIL ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + FAIL ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes NLCOMP + FAIL ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_Ln9_Vmct.f09_f09_mg17.2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_Ln9_Vmct.f09_f09_mg17.2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-outfrq9s NLCOMP + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 NLCOMP + FAIL ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 NLCOMP + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s NLCOMP + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: NLFAIL) details: + FAIL ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 NLCOMP + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_L32wsc (Overall: DIFF) details: + FAIL ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_L32wsc NLCOMP + FAIL ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_L32wsc BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + FAIL ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 NLCOMP + FAIL ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + FAIL ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 NLCOMP + FAIL ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined (Overall: NLFAIL) details: + FAIL ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined NLCOMP + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: DIFF) details: + FAIL SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep NLCOMP + FAIL SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: DIFF) details: + FAIL SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase NLCOMP + FAIL SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ld5_Vnuopc.f19_f19_mg17.PC4.cheyenne_intel.cam-cam4_port5d (Overall: NLFAIL) details: + FAIL SMS_D_Ld5_Vnuopc.f19_f19_mg17.PC4.cheyenne_intel.cam-cam4_port5d NLCOMP + SMS_D_Ln9_Vmct.T42_T42.2000_CAM60%SCAM_CLM50%SP_CICE5%PRES_DOCN%DOM_SROF_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL SMS_D_Ln9_Vmct.T42_T42.2000_CAM60%SCAM_CLM50%SP_CICE5%PRES_DOCN%DOM_SROF_SGLC_SWAV.cheyenne_intel.cam-outfrq9s NLCOMP + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: NLFAIL) details: + FAIL SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday NLCOMP + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s NLCOMP + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: NLFAIL) details: + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase NLCOMP + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s NLCOMP + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: NLFAIL) details: + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s NLCOMP + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + FAIL SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d NLCOMP + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + FAIL SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d NLCOMP + FAIL SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: NLFAIL) details: + FAIL SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d NLCOMP + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: NLFAIL) details: + FAIL SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 NLCOMP + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + FAIL SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m NLCOMP + FAIL SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + FAIL SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging NLCOMP + FAIL SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: NLFAIL) details: + FAIL SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s NLCOMP + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + FAIL SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs NLCOMP + FAIL SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + FAIL SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem NLCOMP + FAIL SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem BASELINE /glade/p/cesm/amwg/cesm_baselines/cam6_3_097: FIELDLIST field lists differ (otherwise bit-for-bit) - M fv/metdata.F90 - - thermodynamic activespecies variables +The NLCOMP failures are due to adding the ndep_stream_nl group to atm_in. +The BASELINE test failures are due to different field list in the cpl.hi files. - M fv3/dp_coupling.F90 - - update calling parameters +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae NLCOMP + FAIL DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae RUN time=223 + PEND DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae COMPARE_base_da + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: NLFAIL) details: + FAIL ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase NLCOMP + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase NLCOMP + FAIL ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + FAIL ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac NLCOMP + FAIL ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + FAIL ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 NLCOMP + FAIL ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERI_D_Ln18_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + FAIL ERI_D_Ln18_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic NLCOMP + ERI_D_Ln18_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: NLFAIL) details: + FAIL ERI_D_Ln18_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic NLCOMP + ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: NLFAIL) details: + FAIL ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf NLCOMP + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf NLCOMP + FAIL ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s NLCOMP + ERS_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERS_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s NLCOMP + PEM_D_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + FAIL PEM_D_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s NLCOMP + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ld2_Vnuopc.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: NLFAIL) details: + FAIL SMS_D_Ld2_Vnuopc.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port NLCOMP + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s NLCOMP + FAIL SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) details: + FAIL SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem NLCOMP + FAIL SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: DIFF) details: + FAIL SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm NLCOMP + FAIL SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_P1x1_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: NLFAIL) details: + FAIL SMS_D_Ln9_P1x1_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s NLCOMP + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + FAIL SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase NLCOMP + FAIL SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + FAIL SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s NLCOMP + FAIL SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_nag: FIELDLIST field lists differ (otherwise bit-for-bit) + TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: NLFAIL) details: + FAIL TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac NLCOMP + TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: NLFAIL) details: + FAIL TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 NLCOMP - M fv3/dycore_budget.F90 - - Dummy routine for printing FV3 budget - not fully supported yet. +The DAE failure is pre-existing. +The NLCOMP failures are due to adding the ndep_stream_nl group to atm_in. +The BASELINE test failures are due to different field list in the cpl.hi files. - M mpas/dp_coupling.F90 - - science updates - - all water constitutents added to pressure - - mods to further reduce bias in energy budget +izumi/gnu/aux_cam: - M mpas/dycore_budget.F90 - - Routine for printing MPAS budget + ERC_D_Ln9_Vnuopc.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator (Overall: NLFAIL) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator NLCOMP + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s NLCOMP + FAIL ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + ERC_D_Ln9_Vnuopc.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + FAIL ERC_D_Ln9_Vnuopc.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s NLCOMP + ERC_D_Ln9_Vnuopc.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + FAIL ERC_D_Ln9_Vnuopc.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s NLCOMP + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC3.izumi_gnu.cam-outfrq3s_usecase (Overall: DIFF) details: + FAIL ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC3.izumi_gnu.cam-outfrq3s_usecase NLCOMP + FAIL ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC3.izumi_gnu.cam-outfrq3s_usecase BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + ERI_D_Ln18_Vnuopc.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: DIFF) details: + FAIL ERI_D_Ln18_Vnuopc.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp NLCOMP + FAIL ERI_D_Ln18_Vnuopc.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + ERP_Ln9_Vnuopc.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: NLFAIL) details: + FAIL ERP_Ln9_Vnuopc.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s NLCOMP + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + FAIL ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + PEM_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: NLFAIL) details: + FAIL PEM_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s NLCOMP + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: DIFF) details: + FAIL SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep NLCOMP + FAIL SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + FAIL SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 NLCOMP + FAIL SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: DIFF) details: + FAIL SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc NLCOMP + FAIL SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee NLCOMP + FAIL SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + FAIL SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac NLCOMP + FAIL SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) + SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + FAIL SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s NLCOMP + FAIL SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s BASELINE /fs/cgd/csm/models/atm/cam/pretag_bl/cam6_3_097_gnu: FIELDLIST field lists differ (otherwise bit-for-bit) - M mpas/dyn_comp.F90 - - Add core budgets for mpas energy and mass - stages +The NLCOMP failures are due to adding the ndep_stream_nl group to atm_in. +The BASELINE test failures are due to different field list in the cpl.hi files. - M mpas/dyn_grid.F90 - - register area weights for mpas grids +CAM tag used for the baseline comparison tests if different than previous +tag: - M se/dp_coupling.F90 - - science updates - - all water constitutents added to pressure - - mods to further reduce bias in energy budget +Summarize any changes to answers: none. - M se/global_norms_mod.F90 - - new interface for calculating both elem and fvm global integrals (fvm added) +=============================================================== +=============================================================== - M se/dycore/prim_advance_mod.F90 - - science updates to close energy budget - - refactor energy calc routine. - - new hydrostatic energy routine with potential energy now split out from SE +Tag name: cam6_3_097 +Originator(s): andrewgettelman, tilmes, fvitt +Date: 13 Mar 2023 +One-line Summary: Heterogeneous freezing science updates and bug fixes +Github PR URL: https://github.com/ESCOMP/CAM/pull/755 - M se/dycore_budget.F90 - - Routine for printing SE energy/mass budgets +Purpose of changes (include the issue number and title text for each relevant GitHub issue): - M se/dyn_comp.F90 - - Add core budget variables for se energy and mass - stages + The following science updates and bug fixes to heterogeneous freezing parameterization + - new namelist parameters for scaling of dust and black carbon contributions + to heterogeneous freezing rates + - use physical approach to calculate species fractions + - use consistent concentrations of cloud-borne and ambient aerosol + - include sulfate in coarse dust fraction calculation + Update PUMAS external - M se/dyn_grid.F90 - - register area weights for se grids - - call budget_add for all SE energy/mass budget fields. +Describe any changes made to build system: N/A - M infrastructure/phys_grid.F90 - - register area weights for physic grid - - call budget_add for all SE energy/mass budget fields. +Describe any changes made to the namelist: - M cam_diagnostics.F90 - - register physics energy/mass budgets using budget_add calls - - physics energy/mass variables (physics budget stages) + New namelist parameters: - M check_energy.F90 - - update calls to get hydrostatic energy (include new potential energy input param) - - update calc energy/mass routine for potential energy calculation. + hetfrz_bc_scalfac + Heterogeneous freezing scaling factor for black carbon aerosols. + Default: 0.01 - M constituents.F90 - - clean up unused variables (NAG) + hetfrz_dust_scalfac + Heterogeneous freezing scaling factor for dust aerosols. + Default: 0.05 - M geopotential.F90 - - remove unused routines/variables (NAG) - - add computation of generalized virtual temp to geopotential_t +List any changes to the defaults for the boundary datasets: N/A - M phys_control.F90 - - code cleanup +Describe any substantial timing or memory changes: N/A - M cam/phys_grid.F90 - - register area weights for global integrals +Code reviewed by: andrewgettelman, cacraigucar, jtruesdal, adamrher, nusbaume - M physics_types.F90 - - science updates for energy/mass budgets +List all files eliminated: N/A - M cam/physpkg.F90 - - science updates for energy/mass budgets - - science updates for energy/mass budgets +List all files added and what they do: N/A - M cam_dev/physpkg.F90 - - science updates for energy/mass budgets +List all existing files that have been modified, and describe the changes: +M Externals_CAM.cfg + - pumas update - M simple/physpkg.F90 - - science updates for energy/mass budgets (update dme_adjust) +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cam.xml +M bld/namelist_files/namelist_definition.xml + - new hetfrz scaling factors namelist parameters - M utils/air_composition.F90 - - refactor/cleanup/rename +M src/physics/cam/hetfrz_classnuc_cam.F90 + - add scaling factor for dust - M utils/grid_support.F90 - - support for global area weighting for budgets +M src/physics/cam/hetfrz_classnuc.F90 + - new hetfrz scaling factors namelist parameters for dust and BC + - remove separate interface for collection of cloud-borne aerosols + so that cloud-borne and ambient aerosol concentrations are consistent + - set num_to_mass_in to false (use physical approach to calc species fractions) + and calc primary carbon fraction consistently + - include SO4 in dst3 fraction calculation - M utils/cam_thermo.F90 - - energy and mass budget variables and descriptions. +M src/physics/cam/microp_aero.F90 + - remove separate interface for collection of cloud-borne aerosols + so that cloud-borne and ambient aerosol concentrations are consistent 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: Expecting namelist and baseline failures +cheyenne/intel/aux_cam: + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) 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_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERP_Ln9_Vmct.f09_f09_mg17.2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) 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: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_L32wsc (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.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vmct.T42_T42.2000_CAM60%SCAM_CLM50%SP_CICE5%PRES_DOCN%DOM_SROF_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (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: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) 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: NLFAIL) 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: + - expect different answers in cam6 configurations + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - pre-existing failure -izumi/nag/aux_cam: Expecting namelist and baseline failures + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + - expect different answers in cam6 configurations -izumi/gnu/aux_cam: Expecting namelist and baseline failures +izumi/gnu/aux_cam: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + - expect different answers in cam6 configurations -Summarize any changes to answers: climate changing +Summarize any changes to answers: larger than roundoff +=============================================================== =============================================================== Tag name: cam6_3_096 From 03097ad390e3d6d51bd9558737f0227268edafa8 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 17 Mar 2023 16:48:17 -0600 Subject: [PATCH 072/140] update ChangeLog and rename calc_te routines in cam_dev for budgets --- doc/ChangeLog | 248 ++++++++++++++++++++++++++++++++ src/physics/cam_dev/physpkg.F90 | 24 ++-- 2 files changed, 260 insertions(+), 12 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 440f790ed4..9b8871b618 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,253 @@ =============================================================== +Tag name: cam6_3_XXX +Originator(s): pel, jet +Date: 8 March 2023 +One-line Summary: Science and infrastructure updates for inline energy/mass budgets +Github PR URL: https://github.com/ESCOMP/CAM/pull/ + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Add inline energy/mass budgets support. (#519) Science changes are + included that help close the mass and energy budgets of physics + and the SE/MPAS dycores (#521) as well as adding all water + constituents to atmospheric mass (pressure) (#520) + + As of this commit energy/mass budgets have been roughed in for + physics and the SE and MPAS dycores. Similar to amwg_diagnostic + functionality, energy/mass budget diagnostic fields will be added + to a history file via the thermo_budget_histfile_num namelist + parameter. Globally averaged energy budget summaries are also + calculated and written to the atm log file every time the budget + history tape is written to. The period over which energy and mass + budgets are averaged is the same as the averaging period of the + history budget file. Thus history budgets can be output/averaged + at timestep, hour, or month resolutions using the nhtfrq variable + specific to the budget history file identified by + thermo_budget_histfile_num. The new namelist logical variable + thermo_buget_history is used to turn budgeting on (.true.) or off + (.false.) The default is .false. (no budgeting) because of the + global gathers needed to create the budgets. + + An energy or mass budget is defined by a mathematical operation + (sum/difference) of two energy/mass snapshots. For instance one + can talk of the energy lost/gained by the physics + parameterizations by comparing snapshots taken before and after + running the physics. + + An energy budget is created, logged and written to the budget history tape in four steps + 1) call e_m_snapshot to define multiple energy/mass snapshots + 2) call e_m_budget to define a budget as the difference/sum of two snapshots. + 3) call tot_energy_phys (or tot_energy_dyn) for each named snapshot + 4) setting namelist variables thermo_budget_history, thermo_budget_histfile_num, nhtfrq + + Energy and mass snapshots are defined and added to the history + buffer via the e_m_snapshot subroutine. The e_m_snapshot routine + creates a set of vertically integrated energy and mass history + output fields based on the snapshot name parameter prepended with + the types of energy and mass that are carried in cam and defined + in cam_thermo.F90 For example calling e_m_snapshot with a name of + 'dAP', perhaps standing for an energy snapshot after physics is + called, will create a set of fields that contain kinetic (KE_dAP), + sensible (SE_dAP), potential (PO_dAP) and total (TE_dap) energies + as well as atmospheric vapor (wv_dAP), liquid (wl_dAP) and ice + (wi_dAP) masses. A call to calc_total_energy for the each named + snapshot (here placed after after the physics parameterization) + will calculate and outfld the 9 or so specific energy and mass + snapshots. + + The e_m_budget routine defines a named budget composed of the + difference or sum of two snapshots. As with e_m_shapshot the + budget name is prepended with the same energies identifiers as + e_m_snapshot. All energy/mass snapshots as well as the budgets are + saved to the history buffer and written to the budget history + file. tot_energy_phys and tot_energy_dyn routines exists for both + physics and dynamics to allow snapshots tailored to thermodynamic + needs and data structures of those packages. + +Describe any changes made to build system: + +Describe any changes made to the namelist: + New budgeting namelist variables have been added. Interface + follows existing functionality to outfld standard diagnostics for + budgeting and diagnosis. + + thermo_budget_histfile_num: integer identifing which history file will contain + additional budgeting diagnostic fields + thermo_budget_history: logical that turns history budgeting on and off. + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: + Global gathers are done each time a thermo budgeting field is + written to the history file. The budgeting diagnostics are not + meant to be enabled during a production run. + +Code reviewed by: + +List all files eliminated: N/A + +List all files added and what they do: + A src/cam/control/budget.F90 + provides support for energy/mass budgeting using cam_history infrastructure. + +List all existing files that have been modified, and describe the changes: + + M Externals.cfg + - update to include ctsm tag supporting MPAS defaults + + M namelist_defaults_cam.xml + - new mpas initial data default for mpasa120 aquaplanet. + - update cam_dev defaults to add Graupel constituent. + + M namelist_definition.xml + - new averaging flag option for budget variables 'N' allows normalization by nsteps. + - nstep normalization is required to properly budget subcycled fields. + - new namelist parameters for budgeting + + M cam_comp.F90 + - add call to print budgets. The print_budget function needs to be defined for all dycores. + + M cam_history.F90 + - new functionality for history buffered fields + - new area weighted global averaging functionality for history fields. + - create new composed hbuf field which is created from a sum/difference operation on + two existing fields. + - restart information added for budgeting. + + M cam_history_buffers.F90 + - new subroutine for nstep field averaging + + M cam_history_support.F90 + - added support for new global average functionality + + M runtime_opts.F90 + - added budget namelist read + + M atm_comp_nuopc.F90 + - bug fix, support for E/W formatted initial data longitudes spanning -180:180 + + M eul/dp_coupling.F90 + - update calling parameters + + M eul/dycore_budget.F90 + - Dummy routine for printing EUL budget - not fully supported yet. + + M fv/dp_coupling.F90 + - update calling parameters + + M fv/dycore_budget.F90 + - Dummy routine for printing FV budget - not fully supported yet. + + M fv/metdata.F90 + - thermodynamic activespecies variables + + M fv3/dp_coupling.F90 + - update calling parameters + + M fv3/dycore_budget.F90 + - Dummy routine for printing FV3 budget - not fully supported yet. + + M mpas/dp_coupling.F90 + - science updates + - all water constitutents added to pressure + - mods to further reduce bias in energy budget + + M mpas/dycore_budget.F90 + - Routine for printing MPAS budget + + M mpas/dyn_comp.F90 + - Add core budgets for mpas energy and mass - stages + + M mpas/dyn_grid.F90 + - register area weights for mpas grids + + M se/dp_coupling.F90 + - science updates + - all water constitutents added to pressure + - mods to further reduce bias in energy budget + + M se/global_norms_mod.F90 + - new interface for calculating both elem and fvm global integrals (fvm added) + + M se/dycore/prim_advance_mod.F90 + - science updates to close energy budget + - refactor energy calc routine. + - new hydrostatic energy routine with potential energy now split out from SE + + M se/dycore_budget.F90 + - Routine for printing SE energy/mass budgets + + M se/dyn_comp.F90 + - Add core budget variables for se energy and mass - stages + + M se/dyn_grid.F90 + - register area weights for se grids + - call budget_add for all SE energy/mass budget fields. + + M infrastructure/phys_grid.F90 + - register area weights for physic grid + - call budget_add for all SE energy/mass budget fields. + + M cam_diagnostics.F90 + - register physics energy/mass budgets using budget_add calls + - physics energy/mass variables (physics budget stages) + + M check_energy.F90 + - update calls to get hydrostatic energy (include new potential energy input param) + - update calc energy/mass routine for potential energy calculation. + + M constituents.F90 + - clean up unused variables (NAG) + + M geopotential.F90 + - remove unused routines/variables (NAG) + - add computation of generalized virtual temp to geopotential_t + + M phys_control.F90 + - code cleanup + + M cam/phys_grid.F90 + - register area weights for global integrals + + M physics_types.F90 + - science updates for energy/mass budgets + + M cam/physpkg.F90 + - science updates for energy/mass budgets + - science updates for energy/mass budgets + + M cam_dev/physpkg.F90 + - science updates for energy/mass budgets + + M simple/physpkg.F90 + - science updates for energy/mass budgets (update dme_adjust) + + M utils/air_composition.F90 + - refactor/cleanup/rename + + M utils/grid_support.F90 + - support for global area weighting for budgets + + M utils/cam_thermo.F90 + - energy and mass budget variables and descriptions. + +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: Expecting namelist and baseline failures + +izumi/nag/aux_cam: Expecting namelist and baseline failures + +izumi/gnu/aux_cam: Expecting namelist and baseline failures + +Summarize any changes to answers: climate changing + +=============================================================== +=============================================================== + Tag name: cam6_3_099 Originator(s): adamrher, eaton Date: Thu Mar 16 11:22:00 AM EDT 2023 diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index 9cf003852c..62a717d568 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -1317,7 +1317,7 @@ subroutine tphysac (ztodt, cam_in, & use aoa_tracers, only: aoa_tracers_timestep_tend use physconst, only: rhoh2o use aero_model, only: aero_model_drydep - use check_energy, only: check_energy_chng, calc_te_and_aam_budgets + use check_energy, only: check_energy_chng, tot_energy_phys use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng use time_manager, only: get_nstep use cam_abortutils, only: endrun @@ -2274,8 +2274,8 @@ subroutine tphysac (ztodt, cam_in, & call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) end if - call calc_te_and_aam_budgets(state, 'phAP') - call calc_te_and_aam_budgets(state, 'dyAP',vc=vc_dycore) + call tot_energy_phys(state, 'phAP') + call tot_energy_phys(state, 'dyAP',vc=vc_dycore) !--------------------------------------------------------------------------------- ! Enforce charge neutrality after O+ change from ionos_tend @@ -2327,8 +2327,8 @@ subroutine tphysac (ztodt, cam_in, & call cam_thermo_water_update(state%q(:ncol,:,:), lchnk, ncol, vc_dycore,& to_dry_factor=state%pdel(:ncol,:)/state%pdeldry(:ncol,:)) - call calc_te_and_aam_budgets(state, 'phAM') - call calc_te_and_aam_budgets(state, 'dyAM', vc=vc_dycore) + call tot_energy_phys(state, 'phAM') + call tot_energy_phys(state, 'dyAM', vc=vc_dycore) ! Restore pre-"physics_dme_adjust" tracers state%q(:ncol,:pver,:pcnst) = tmp_trac(:ncol,:pver,:pcnst) state%pdel(:ncol,:pver) = tmp_pdel(:ncol,:pver) @@ -2348,8 +2348,8 @@ subroutine tphysac (ztodt, cam_in, & fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) end if - call calc_te_and_aam_budgets(state, 'phAM') - call calc_te_and_aam_budgets(state, 'dyAM', vc=vc_dycore) + call tot_energy_phys(state, 'phAM') + call tot_energy_phys(state, 'dyAM', vc=vc_dycore) endif !!! REMOVE THIS CALL, SINCE ONLY Q IS BEING ADJUSTED. WON'T BALANCE ENERGY. TE IS SAVED BEFORE THIS @@ -2429,7 +2429,7 @@ subroutine tphysbc (ztodt, state, & use convect_diagnostics,only: convect_diagnostics_calc use check_energy, only: check_energy_chng, check_energy_fix use check_energy, only: check_tracers_data, check_tracers_init - use check_energy, only: calc_te_and_aam_budgets + use check_energy, only: tot_energy_phys use dycore, only: dycore_is use radiation, only: radiation_tend use perf_mod @@ -2604,8 +2604,8 @@ subroutine tphysbc (ztodt, state, & !=================================================== call t_startf('energy_fixer') - call calc_te_and_aam_budgets(state, 'phBF') - call calc_te_and_aam_budgets(state, 'dyBF',vc=vc_dycore) + call tot_energy_phys(state, 'phBF') + call tot_energy_phys(state, 'dyBF',vc=vc_dycore) if (.not.dycore_is('EUL')) then call check_energy_fix(state, ptend, nstep, flx_heat) @@ -2614,8 +2614,8 @@ subroutine tphysbc (ztodt, state, & call outfld( 'EFIX', flx_heat , pcols, lchnk ) end if - call calc_te_and_aam_budgets(state, 'phBP') - call calc_te_and_aam_budgets(state, 'dyBP',vc=vc_dycore) + call tot_energy_phys(state, 'phBP') + call tot_energy_phys(state, 'dyBP',vc=vc_dycore) ! Save state for convective tendency calculations. call diag_conv_tend_ini(state, pbuf) From 1bac31539fa3c26820fa29030b186254f3bd3c0c Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Tue, 21 Mar 2023 09:55:52 -0600 Subject: [PATCH 073/140] turn on physical frictional heating (WACCM-x) --- src/dynamics/se/dycore/prim_advance_mod.F90 | 36 +++++++++++---------- 1 file changed, 19 insertions(+), 17 deletions(-) diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index 9864aa5d7e..c6b330b48d 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -926,25 +926,27 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, enddo enddo enddo - !$omp parallel do num_threads(vert_num_threads) private(k,i,j,v1,v2,v1new,v2new) - do k=1,ksponge_end - !OMP_COLLAPSE_SIMD - !DIR_VECTOR_ALIGNED - do j=1,np - do i=1,np - ! update v first (gives better results than updating v after heating) - elem(ie)%state%v(i,j,:,k,nt)=elem(ie)%state%v(i,j,:,k,nt) + & - vtens(i,j,:,k,ie) - elem(ie)%state%T(i,j,k,nt)=elem(ie)%state%T(i,j,k,nt) & - +ttens(i,j,k,ie) - - v1new=elem(ie)%state%v(i,j,1,k,nt) - v2new=elem(ie)%state%v(i,j,2,k,nt) - v1 =elem(ie)%state%v(i,j,1,k,nt)- vtens(i,j,1,k,ie) - v2 =elem(ie)%state%v(i,j,2,k,nt)- vtens(i,j,2,k,ie) + if (molecular_diff>0) then + !$omp parallel do num_threads(vert_num_threads) private(k,i,j,v1,v2,v1new,v2new) + do k=1,ksponge_end + !OMP_COLLAPSE_SIMD + !DIR_VECTOR_ALIGNED + do j=1,np + do i=1,np + ! update v first (gives better results than updating v after heating) + elem(ie)%state%v(i,j,:,k,nt)=elem(ie)%state%v(i,j,:,k,nt) + & + vtens(i,j,:,k,ie) + elem(ie)%state%T(i,j,k,nt)=elem(ie)%state%T(i,j,k,nt) & + +ttens(i,j,k,ie) + + v1new=elem(ie)%state%v(i,j,1,k,nt) + v2new=elem(ie)%state%v(i,j,2,k,nt) + v1 =elem(ie)%state%v(i,j,1,k,nt)- vtens(i,j,1,k,ie) + v2 =elem(ie)%state%v(i,j,2,k,nt)- vtens(i,j,2,k,ie) + enddo enddo enddo - enddo + end if end do end do call t_stopf('sponge_diff') From 74d3a2d081db811e6bd845844086db0542517b64 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Wed, 22 Mar 2023 09:05:18 -0600 Subject: [PATCH 074/140] bug in previous commit --- src/dynamics/se/dycore/prim_advance_mod.F90 | 22 +++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index c6b330b48d..71ee739ab3 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -675,7 +675,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, !$omp parallel do num_threads(vert_num_threads), private(k,i,j,v1,v2,heating) do k=ksponge_end,nlev ! - ! only do "frictional heating" away from del2 sponge + ! only do "frictional heating" away from sponge ! !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED @@ -923,26 +923,32 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, vtens(i,j,2,k,ie)=dt*vtens(i,j,2,k,ie)*elem(ie)%rspheremp(i,j) ttens(i,j,k,ie)=dt*ttens(i,j,k,ie)*elem(ie)%rspheremp(i,j) elem(ie)%state%dp3d(i,j,k,nt)=elem(ie)%state%dp3d(i,j,k,nt)*elem(ie)%rspheremp(i,j) + ! update v first (gives better results than updating v after heating) + elem(ie)%state%v(i,j,:,k,nt)=elem(ie)%state%v(i,j,:,k,nt) + vtens(i,j,:,k,ie) + elem(ie)%state%T(i,j, k,nt)=elem(ie)%state%T(i,j, k,nt) + ttens(i,j, k,ie) enddo enddo enddo if (molecular_diff>0) then + ! + ! no frictional heating for artificial sponge + ! !$omp parallel do num_threads(vert_num_threads) private(k,i,j,v1,v2,v1new,v2new) do k=1,ksponge_end !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,np - do i=1,np - ! update v first (gives better results than updating v after heating) - elem(ie)%state%v(i,j,:,k,nt)=elem(ie)%state%v(i,j,:,k,nt) + & - vtens(i,j,:,k,ie) - elem(ie)%state%T(i,j,k,nt)=elem(ie)%state%T(i,j,k,nt) & - +ttens(i,j,k,ie) - + do i=1,np v1new=elem(ie)%state%v(i,j,1,k,nt) v2new=elem(ie)%state%v(i,j,2,k,nt) v1 =elem(ie)%state%v(i,j,1,k,nt)- vtens(i,j,1,k,ie) v2 =elem(ie)%state%v(i,j,2,k,nt)- vtens(i,j,2,k,ie) + ! + ! frictional heating + ! + heating = 0.5_r8*(v1new*v1new+v2new*v2new-(v1*v1+v2*v2)) + elem(ie)%state%T(i,j,k,nt)=elem(ie)%state%T(i,j,k,nt) & + -heating*inv_cp_full(i,j,k,ie) enddo enddo enddo From 169a28cf2d2aa274fa8ca4989f7389f487264492 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Wed, 22 Mar 2023 09:10:39 -0600 Subject: [PATCH 075/140] new energy code in simple physics --- src/physics/simple/physpkg.F90 | 57 +++++++++++++++++++++++----------- src/utils/air_composition.F90 | 3 -- 2 files changed, 39 insertions(+), 21 deletions(-) diff --git a/src/physics/simple/physpkg.F90 b/src/physics/simple/physpkg.F90 index c870be5fe7..93cb3c530a 100644 --- a/src/physics/simple/physpkg.F90 +++ b/src/physics/simple/physpkg.F90 @@ -119,6 +119,8 @@ subroutine phys_register if (moist_physics) then call pbuf_add_field('CLDLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), cldliqini_idx) call pbuf_add_field('CLDICEINI', 'physpkg', dtype_r8, (/pcols,pver/), cldiceini_idx) + call pbuf_add_field('TOTLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), totliqini_idx) + call pbuf_add_field('TOTICEINI', 'physpkg', dtype_r8, (/pcols,pver/), toticeini_idx) end if ! check energy package @@ -471,9 +473,9 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) use cam_diagnostics, only: diag_phys_tend_writeout, diag_surf use tj2016_cam, only: thatcher_jablonowski_sfc_pbl_hs_tend use dycore, only: dycore_is - use check_energy, only: calc_te_and_aam_budgets + use check_energy, only: tot_energy_phys use cam_history, only: hist_fld_active - + use cam_thermo, only: cam_thermo_water_update ! Arguments ! real(r8), intent(in) :: ztodt ! Two times model timestep (2 delta-t) @@ -499,7 +501,7 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) integer :: ixcldliq integer :: ixcldice integer :: k - integer :: ncol + integer :: ncol, lchnk integer :: itim_old logical :: moist_mixing_ratio_dycore @@ -510,6 +512,7 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) ! number of active atmospheric columns ncol = state%ncol + lchnk = state%lchnk ! Associate pointers with physics buffer fields itim_old = pbuf_old_tim_idx() @@ -544,8 +547,8 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) call physics_update(state, ptend, ztodt, tend) end if - call calc_te_and_aam_budgets(state, 'phAP') - call calc_te_and_aam_budgets(state, 'dyAP',vc=vc_dycore) + call tot_energy_phys(state, 'phAP') + call tot_energy_phys(state, 'dyAP',vc=vc_dycore) ! FV: convert dry-type mixing ratios to moist here because ! physics_dme_adjust assumes moist. This is done in p_d_coupling for @@ -585,9 +588,11 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) call set_dry_to_wet(state) call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) - - call calc_te_and_aam_budgets(state, 'phAM') - call calc_te_and_aam_budgets(state, 'dyAM',vc=vc_dycore) + ! update cp/cv for energy computation based in updated water variables + call cam_thermo_water_update(state%q(:ncol,:,:), lchnk, ncol, vc_dycore, & + to_dry_factor=state%pdel(:ncol,:)/state%pdeldry(:ncol,:)) + call tot_energy_phys(state, 'phAM') + call tot_energy_phys(state, 'dyAM',vc=vc_dycore) ! Restore pre-"physics_dme_adjust" tracers state%q(:ncol,:pver,:pcnst) = tmp_trac(:ncol,:pver,:pcnst) state%pdel(:ncol,:pver) = tmp_pdel(:ncol,:pver) @@ -596,16 +601,16 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) if (moist_mixing_ratio_dycore) then call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) - call calc_te_and_aam_budgets(state, 'phAM') - call calc_te_and_aam_budgets(state, 'dyAM',vc=vc_dycore) + call tot_energy_phys(state, 'phAM') + call tot_energy_phys(state, 'dyAM',vc=vc_dycore) end if else tmp_q (:ncol,:pver) = 0.0_r8 tmp_cldliq(:ncol,:pver) = 0.0_r8 tmp_cldice(:ncol,:pver) = 0.0_r8 - call calc_te_and_aam_budgets(state, 'phAM') - call calc_te_and_aam_budgets(state, 'dyAM',vc=vc_dycore) + call tot_energy_phys(state, 'phAM') + call tot_energy_phys(state, 'dyAM',vc=vc_dycore) end if ! store T in buffer for use in computing dynamics T-tendency in next timestep @@ -654,7 +659,7 @@ subroutine tphysbc (ztodt, state, tend, pbuf, cam_out, cam_in ) use time_manager, only: get_nstep use check_energy, only: check_energy_chng, check_energy_fix, check_energy_timestep_init use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng - use check_energy, only: calc_te_and_aam_budgets + use check_energy, only: tot_energy_phys use chemistry, only: chem_is_active, chem_timestep_tend use held_suarez_cam, only: held_suarez_tend use kessler_cam, only: kessler_tend @@ -663,6 +668,8 @@ subroutine tphysbc (ztodt, state, tend, pbuf, cam_out, cam_in ) use cam_snapshot_common,only: cam_snapshot_all_outfld use cam_snapshot_common,only: cam_snapshot_ptend_outfld use physics_types, only: dyn_te_idx + use air_composition, only: thermodynamic_active_species_liq_num,thermodynamic_active_species_liq_idx + use air_composition, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_ice_idx ! Arguments real(r8), intent(in) :: ztodt ! model time increment @@ -683,12 +690,15 @@ subroutine tphysbc (ztodt, state, tend, pbuf, cam_out, cam_in ) integer :: itim_old integer :: ixcldliq integer :: ixcldice + integer :: m, m_cnst ! physics buffer fields for total energy and mass adjustment real(r8), pointer :: teout(:) real(r8), pointer :: qini(:,:) real(r8), pointer :: cldliqini(:,:) real(r8), pointer :: cldiceini(:,:) + real(r8), pointer :: totliqini(:,:) + real(r8), pointer :: toticeini(:,:) real(r8), pointer :: dtcore(:,:) real(r8) :: zero(pcols) ! array of zeros @@ -716,6 +726,8 @@ subroutine tphysbc (ztodt, state, tend, pbuf, cam_out, cam_in ) if (moist_physics) then call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) call pbuf_get_field(pbuf, cldiceini_idx, cldiceini) + call pbuf_get_field(pbuf, totliqini_idx, totliqini) + call pbuf_get_field(pbuf, toticeini_idx, toticeini) end if ! Set accumulated physics tendencies to 0 @@ -740,8 +752,8 @@ subroutine tphysbc (ztodt, state, tend, pbuf, cam_out, cam_in ) !=================================================== ! Global mean total energy fixer and AAM diagnostics !=================================================== - call calc_te_and_aam_budgets(state, 'phBF') - call calc_te_and_aam_budgets(state, 'dyBF',vc=vc_dycore) + call tot_energy_phys(state, 'phBF') + call tot_energy_phys(state, 'dyBF',vc=vc_dycore) call t_startf('energy_fixer') @@ -754,8 +766,8 @@ subroutine tphysbc (ztodt, state, tend, pbuf, cam_out, cam_in ) call t_stopf('energy_fixer') - call calc_te_and_aam_budgets(state, 'phBP') - call calc_te_and_aam_budgets(state, 'dyBP',vc=vc_dycore) + call tot_energy_phys(state, 'phBP') + call tot_energy_phys(state, 'dyBP',vc=vc_dycore) ! Save state for convective tendency calculations. call diag_conv_tend_ini(state, pbuf) @@ -771,8 +783,17 @@ subroutine tphysbc (ztodt, state, tend, pbuf, cam_out, cam_in ) if (ixcldice > 0) then cldiceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) end if + totliqini(:ncol,:pver) = 0.0_r8 + do m_cnst=1,thermodynamic_active_species_liq_num + m = thermodynamic_active_species_liq_idx(m_cnst) + totliqini(:ncol,:pver) = totliqini(:ncol,:pver)+state%q(:ncol,:pver,m) + end do + toticeini(:ncol,:pver) = 0.0_r8 + do m_cnst=1,thermodynamic_active_species_ice_num + m = thermodynamic_active_species_ice_idx(m_cnst) + toticeini(:ncol,:pver) = toticeini(:ncol,:pver)+state%q(:ncol,:pver,m) + end do end if - call outfld('TEOUT', teout , pcols, lchnk ) call outfld('TEINP', state%te_ini(:,dyn_te_idx), pcols, lchnk ) call outfld('TEFIX', state%te_cur(:,dyn_te_idx), pcols, lchnk ) diff --git a/src/utils/air_composition.F90 b/src/utils/air_composition.F90 index c82fdfffab..1369e93b42 100644 --- a/src/utils/air_composition.F90 +++ b/src/utils/air_composition.F90 @@ -657,7 +657,6 @@ end subroutine dry_air_composition_update subroutine water_composition_update(mmr, lchnk, ncol, vcoord, to_dry_factor) use cam_abortutils, only: endrun use dyn_tests_utils, only: vc_height, vc_moist_pressure, vc_dry_pressure - use physconst, only: r_universal, cpair, rair, cpwv, rh2o, cpliq, cpice, mwdry!xxx real(r8), intent(in) :: mmr(:,:,:) ! constituents array integer, intent(in) :: lchnk ! Chunk number integer, intent(in) :: ncol ! number of columns @@ -678,8 +677,6 @@ subroutine water_composition_update(mmr, lchnk, ncol, vcoord, to_dry_factor) ! cp_or_cv_dycore(:ncol,:,lchnk)=cp_or_cv_dycore(:ncol,:,lchnk)*& (cpairv(:ncol,:,lchnk)-rairv(:ncol,:,lchnk)) /rairv(:ncol,:,lchnk) -! cp_or_cv_dycore(:ncol,:,lchnk)=rair*& -! (cpairv(:ncol,:,lchnk)-rairv(:ncol,:,lchnk))/rairv(:ncol,:,lchnk) end if end subroutine water_composition_update From 632731ee80df09ef99168772d72a562fa2830d5b Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Wed, 22 Mar 2023 11:58:09 -0600 Subject: [PATCH 076/140] cleanup (variable names se/dyn_comp.F90 and log file code) --- src/dynamics/se/dycore_budget.F90 | 133 ++++-------------------------- src/dynamics/se/dyn_comp.F90 | 44 ++++------ 2 files changed, 31 insertions(+), 146 deletions(-) diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index 528ec19b51..a9c9115f28 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -38,7 +38,7 @@ subroutine print_budget(hstwr) real(r8), dimension(4) :: dy_param,dy_EFIX,dy_DMEA,dy_param_and_efix,dy_phys_total real(r8), dimension(4) :: se_phys_total real(r8) :: dycore, err, param, pefix, & - pdmea, phys_total, dyn_total, dyn_phys_total, & + pdmea, phys_total, dyn_phys_total, & rate_of_change_2D_dyn, rate_of_change_vertical_remapping, & diffusion_del4, diffusion_fric, diffusion_del4_tot, diffusion_sponge, & diffusion_total, twoDresidual, & @@ -92,7 +92,6 @@ subroutine print_budget(hstwr) call budget_get_global('dBF' ,idx(i),E_dBF(i)) !state passed to physics end do - call budget_get_global('dBF-dED',teidx,dyn_total) call budget_get_global('dAD-dBD',teidx,rate_of_change_2D_dyn) call budget_get_global('dAR-dAD',teidx,rate_of_change_vertical_remapping) dADIA = rate_of_change_2D_dyn+rate_of_change_vertical_remapping @@ -137,10 +136,10 @@ subroutine print_budget(hstwr) write(iulog,*)"Suffix dy is dycore energy computed in CAM physics using" write(iulog,*)"CAM physics state variables" write(iulog,*)" " - write(iulog,*)"Energy stages in dynamics" - write(iulog,*)"-------------------------" + write(iulog,*)"Energy stages in dynamics (specific to the SE dycore)" + write(iulog,*)"-----------------------------------------------------" write(iulog,*)" " - write(iulog,*)"suffix (dynamics)" + write(iulog,*)"suffix (d)" write(iulog,*)"dED: state from end of previous dynamics (= pBF + time sampling)" write(iulog,*)" loop over vertical remapping and physics dribbling -------- (nsplit) -------" write(iulog,*)" (dribbling and remapping always done together) |" @@ -182,7 +181,7 @@ subroutine print_budget(hstwr) end do if (diff>eps) then write(iulog,*)"FAIL" - call endrun(subname//"dE/dts in physics inconsistent") + call endrun(subname//"dE/dt's in physics inconsistent") end if write(iulog,*)" " write(iulog,*)" " @@ -193,16 +192,10 @@ subroutine print_budget(hstwr) write(iulog,*) " ----- ----- ----" do i=1,4 diff = ph_dmea(i)-dy_dmea(i) - write(iulog,fmt)"dE/dt dry mass adjustment (xxAM-xxAP) ",str(i)," ",ph_dmea(i)," ",dy_dmea(i)," ",diff - write(iulog,*) "" - write(iulog,*) str(i),":" - write(iulog,*) "======" - write(iulog,*)"dE/dt dry mass adjustment (phAM-phAP)"," ",ph_dmea(i) - write(iulog,*)"dE/dt dry mass adjustment (dyAM-dyAP)"," ",dy_dmea(i) - write(iulog,*) " " - write(iulog,*) " " + write(iulog,*)"dE/dt dry mass adjustment (xxAM-xxAP) ",str(i)," ",ph_dmea(i)," ",dy_dmea(i)," ",diff end do write(iulog,*)" " + write(iulog,*)" " ! ! these diagnostics only make sense time-step to time-step ! @@ -359,122 +352,26 @@ subroutine print_budget(hstwr) write(iulog,*)" SE dycore energy tendencies" write(iulog,*)"------------------------------------------------------------" write(iulog,*)" " - ! write(iulog,*)"dE/dt dyn total (dycore+phys tendency (dBF-dED) ",dyn_total," W/M^2" - write(iulog,'(a46,F6.2,a6)')"dE/dt adiabatic dynamics ",dADIA," W/M^2" + write(iulog,'(a46,F6.2,a6)')"dE/dt dycore ",dADIA," W/M^2" write(iulog,*)" " write(iulog,*)"Adiabatic dynamics can be divided into quasi-horizontal and vertical remapping: " write(iulog,*)" " - write(iulog,'(a40,F6.2,a6)') "dE/dt 2D dynamics (dAD-dBD) ",rate_of_change_2D_dyn," W/M^2" + write(iulog,'(a40,F6.2,a6)') "dE/dt floating dynamics (dAD-dBD) ",rate_of_change_2D_dyn," W/M^2" write(iulog,'(a40,F6.2,a6)') "dE/dt vertical remapping (dAR-dAD) ",rate_of_change_vertical_remapping," W/M^2" write(iulog,*) " " write(iulog,*) "Breakdown of 2D dynamics:" write(iulog,*) " " - write(iulog,'(a45,F6.2,a6)')" dE/dt hypervis del4 (dCH-dBH) ",diffusion_del4," W/M^2" - write(iulog,'(a45,F6.2,a6)')" dE/dt hypervis frictional heating (dAH-dCH) ",diffusion_fric," W/M^2" - write(iulog,'(a45,F6.2,a6)')" dE/dt hypervis del4 total (dAH-dBH) ",diffusion_del4_tot," W/M^2" - write(iulog,'(a45,F6.2,a6)')" dE/dt hypervis sponge total (dAS-dBS) ",diffusion_sponge," W/M^2" - write(iulog,'(a45,F6.2,a6)')" dE/dt explicit diffusion total ",diffusion_total," W/M^2" + write(iulog,'(a46,F6.2,a6)')" dE/dt hypervis del4 (dCH-dBH) ",diffusion_del4," W/M^2" + write(iulog,'(a46,F6.2,a6)')" dE/dt hypervis frictional heating (dAH-dCH) ",diffusion_fric," W/M^2" + write(iulog,'(a46,F6.2,a6)')" dE/dt hypervis del4 total (dAH-dBH) ",diffusion_del4_tot," W/M^2" + write(iulog,'(a46,F6.2,a6)')" dE/dt hypervis sponge del2 (dAS-dBS) ",diffusion_sponge," W/M^2" + write(iulog,'(a46,F6.2,a6)')" dE/dt explicit diffusion total ",diffusion_total," W/M^2" twoDresidual = rate_of_change_2D_dyn-diffusion_total - write(iulog,'(a45,F6.2,a6)')" dE/dt residual (time-truncation errors) ",twoDresidual," W/M^2" - write(iulog,*)" " + write(iulog,'(a46,F6.2,a6)')" dE/dt residual (time-truncation errors) ",twoDresidual," W/M^2" write(iulog,*)" " -#ifdef xxx write(iulog,*)" " - write(iulog,*)"------------------------------------------------------------" - write(iulog,*)" CAM physics energy tendencies (using pressure coordinate)" - write(iulog,*)"------------------------------------------------------------" - write(iulog,*)" " - write(iulog,'(a40,F6.2,a6)')"dE/dt energy fixer (phBP-phBF) ",ph_EFIX," W/M^2" - write(iulog,'(a40,F6.2,a6)')"dE/dt all parameterizations (phAP-phBP) ",ph_param," W/M^2" - write(iulog,'(a40,F6.2,a6)')"dE/dt dry mass adjustment (phAM-phAP) ",ph_DMEA," W/M^2" - write(iulog,'(a40,F6.2,a6)')"dE/dt physics total (phAM-phBF) ",ph_phys_total," W/M^2" - write(iulog,*)" " - write(iulog,*) " " - write(iulog,*) "-dE/dt energy fixer = dE/dt dry mass adjustment +" - write(iulog,*) " dE/dt dycore +" - write(iulog,*) " dE/dt physics-dynamics coupling errors +" - write(iulog,*) " dE/dt energy formula differences " - write(iulog,*) " " - write(iulog,*) "(equation 23 in Lauritzen and Williamson (2019))" - write(iulog,*) " " - dycore = -ph_EFIX-ph_DMEA - dycore = -ph_EFIX-previous_dEdt_dry_mass_adjust - write(iulog,*) "" - write(iulog,*) "Dycore TE dissipation estimated from physics in pressure coordinate:" - write(iulog,*) "(note: to avoid sampling error we need dE/dt from previous time-step)" - write(iulog,*) "" - write(iulog,*) "dE/dt adiabatic dycore estimated from physics (t=n-1) = " - write(iulog,'(a58,F6.2,a6)') "-dE/dt energy fixer(t=n)-dE/dt dry-mass adjust(t=n-1) = ",dycore," W/M^2" - write(iulog,*) "" - write(iulog,'(a58,F6.2,a6)') "dE/dt adiabatic dycore computed in dycore (t=n-1) = ",& - previous_dEdt_adiabatic_dycore," W/M^2" - write(iulog,'(a58,F6.2,a6)') "dE/dt dry-mass adjust (t=n-1) = ",& - previous_dEdt_dry_mass_adjust," W/M^2" - write(iulog,*) "" - if (abs(previous_dEdt_adiabatic_dycore)>eps) then - diff = abs((dycore-previous_dEdt_adiabatic_dycore)/previous_dEdt_adiabatic_dycore) - if (diff>eps) then - write(iulog,*) "energy budget not closed: previous_dEdt_adiabatic_dycore <> dycore" - write(iulog,*) "normalized difference is:",diff - ! call endrun(subname//"physics energy budget consistency error 2") - end if - end if - write(iulog,*)"------------------------------------------------------------" - write(iulog,*)" Physics dynamics coupling errors" - write(iulog,*)"------------------------------------------------------------" - write(iulog,*)" " - write(iulog,'(a46,F6.2,a6)')"dE/dt physics tendency in dynamics (dBD-dAF) ",se_phys_total_te," W/M^2" - write(iulog,'(a46,F6.2,a6)')"dE/dt physics tendency in physics (pAM-pBF) ",ph_phys_total," W/M^2" - write(iulog,*)" " - write(iulog,'(a46,F6.2,a6)')"dE/dt physics-dynamics coupling errors ",ph_phys_total-se_phys_total_te," W/M^2" - write(iulog,*)"------------------------------------------------------------" - write(iulog,*)" Consistency checks" - write(iulog,*)"------------------------------------------------------------" - write(iulog,*)" " - ! - ! consistency check - ! - if (abs(ph_param+ph_EFIX+ph_DMEA-ph_phys_total)>eps) then - write(iulog,*) "Physics energy budget not adding up:" - write(iulog,*) "(phBP-pBF)+(phAP-pBP)+(pAM-pAP) does not add up to (pAM-pBF)",\ - abs(ph_param+ph_EFIX+ph_DMEA-ph_phys_total) - call endrun(subname//"physics energy budget consistency error") - endif - write(iulog,*) "" - write(iulog,*) "Is globally integrated total energy of state at the end of dynamics (dBF)" - write(iulog,*) "and beginning of physics (phBF) the same?" - write(iulog,*) "" - call budget_get_global('dBF' ,teidx,E_dBF(1)) !state passed to physics - call budget_get_global('phBF',teidx,E_phBF)!state beginning physics - ! if (abs(E_phBF)>eps) then - diff = abs_diff(E_dBF(1),E_phBF) - if (abs(diff)0) - - call e_m_budget('rate_2d_dyn','dAD','dBD','dyn','dif',longname="rate_of_change_2d_dyn (dAD-dBD)",cslam=ntrac>0) - - call e_m_budget('rate_vert_remap','dAR','dAD','dyn','dif',longname="rate_of_change_2d_dyn (dAR-dAD)",cslam=ntrac>0) - - call e_m_budget('BD_dyn_adai','rate_2d_dyn','rate_vert_remap','dyn','sum',longname="dE/dt total adiabatic dynamics (adiab=rate2ddyn+vremap) ",cslam=ntrac>0) - - call e_m_budget('BD_dyn_2D','dAD','dBD','dyn','dif',longname="dE/dt 2D dynamics (dAD-dBD)",cslam=ntrac>0) - - call e_m_budget('BD_dyn_remap','dAR','dAD','dyn','dif',longname="dE/dt vertical remapping (dAR-dAD)",cslam=ntrac>0) - - call e_m_budget('BD_dyn_ptend','dBD','dAF','dyn','dif',longname="dE/dt physics tendency in dynamics (dBD-dAF)",cslam=ntrac>0) - - call e_m_budget('BD_dyn_hvis','dCH','dBH','dyn','dif',longname="dE/dt hypervis del4 (dCH-dBH)",cslam=ntrac>0) - - call e_m_budget('BD_dyn_fric','dAH','dCH','dyn','dif',longname="dE/dt hypervis frictional heating del4 (dAH-dCH)",cslam=ntrac>0) - - call e_m_budget('BD_dyn_difdel4tot','dAH','dBH','dyn','dif',longname="dE/dt hypervis del4 total (dAH-dBH)",cslam=ntrac>0) - - call e_m_budget('BD_dyn_sponge','dAS','dBS','dyn','dif',longname="dE/dt hypervis sponge total (dAS-dBS)",cslam=ntrac>0) - - call e_m_budget('BD_dyn_difftot','BD_dyn_difdel4tot','BD_dyn_sponge','dyn','sum',longname="dE/dt explicit diffusion total (hvisdel4tot+hvisspngtot)",cslam=ntrac>0) - - call e_m_budget('BD_dyn_res','BD_dyn_2D','BD_dyn_difftot','dyn','dif',longname="dE/dt residual (2ddyn-expdifftot)",cslam=ntrac>0) - - call e_m_budget('hrate','dAH','dCH','dyn','dif',longname="rate of change heating term put back in (dAH-dCH)",cslam=ntrac>0) +!xxx call e_m_budget('dEdt_total_dyn' ,'dBF','dED','dyn','dif',longname="dE/dt dynamics total (dycore+phys tendency: dBF-dED)",cslam=ntrac>0)!xxx used? + call e_m_budget('dEdt_floating_dyn' ,'dAD','dBD','dyn','dif',longname="dE/dt floating dynamics (dAD-dBD)" ,cslam=ntrac>0) + call e_m_budget('dEdt_vert_remap' ,'dAR','dAD','dyn','dif',longname="dE/dt vertical remapping (dAR-dAD)" ,cslam=ntrac>0) + call e_m_budget('dEdt_phys_tend_in_dyn' ,'dBD','dAF','dyn','dif',longname="dE/dt physics tendency in dynamics (dBD-dAF)" ,cslam=ntrac>0) + + call e_m_budget('dEdt_del4' ,'dCH','dBH','dyn','dif',longname="dE/dt dycore hypervis del4 (dCH-dBH)" ,cslam=ntrac>0) + call e_m_budget('dEdt_del4_fric_heat','dAH','dCH','dyn','dif',longname="dE/dt hypervis frictional heating del4 (dAH-dCH)",cslam=ntrac>0) + call e_m_budget('dEdt_del4_tot' ,'dAH','dBH','dyn','dif',longname="dE/dt hypervis del4 total (dAH-dBH)",cslam=ntrac>0) + call e_m_budget('dEdt_del2_sponge' ,'dAS','dBS','dyn','dif',longname="dE/dt hypervis sponge del2 (dAS-dBS)",cslam=ntrac>0) + ! + ! Register derived budgets + ! + call e_m_budget('dEdt_dycore' ,'dEdt_floating_dyn' ,'dEdt_vert_remap','dyn','sum',longname="dE/dt adiabatic dynamics",cslam=ntrac>0) + call e_m_budget('dEdt_del2_del4_tot' ,'dEdt_del4_tot','dEdt_del2_sponge','dyn','sum',longname="dE/dt explicit diffusion total",cslam=ntrac>0) + call e_m_budget('dEdt_residual' ,'dEdt_floating_dyn','dEdt_del2_del4_tot','dyn','dif',longname="dE/dt residual (dEdt_floating_dyn-dEdt_del2_del4_tot)",cslam=ntrac>0) end if ! ! add dynamical core tracer tendency output From fd16ddb1bcc1614802b1ba6035460049181f0af7 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Wed, 22 Mar 2023 12:05:39 -0600 Subject: [PATCH 077/140] remove outcommented code --- src/dynamics/se/dyn_comp.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 43f4b1ed97..425398f614 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -909,8 +909,6 @@ subroutine dyn_init(dyn_in, dyn_out) ! ! Register tendency (difference) budgets ! -!xxx call e_m_budget('dEdt_total_dyn' ,'dBF','dED','dyn','dif',longname="dE/dt dynamics total (dycore+phys tendency: dBF-dED)",cslam=ntrac>0)!xxx used? - call e_m_budget('dEdt_floating_dyn' ,'dAD','dBD','dyn','dif',longname="dE/dt floating dynamics (dAD-dBD)" ,cslam=ntrac>0) call e_m_budget('dEdt_vert_remap' ,'dAR','dAD','dyn','dif',longname="dE/dt vertical remapping (dAR-dAD)" ,cslam=ntrac>0) call e_m_budget('dEdt_phys_tend_in_dyn' ,'dBD','dAF','dyn','dif',longname="dE/dt physics tendency in dynamics (dBD-dAF)" ,cslam=ntrac>0) From d7297e3e744acc90e807547a7c9501a5a09fecf2 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Wed, 22 Mar 2023 16:19:20 -0600 Subject: [PATCH 078/140] beautify log file energy output --- src/dynamics/se/dycore_budget.F90 | 102 ++++++++++++++++++------------ 1 file changed, 61 insertions(+), 41 deletions(-) diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index a9c9115f28..91663876a4 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -52,7 +52,8 @@ subroutine print_budget(hstwr) real(r8) :: E_dyBF(4) integer :: m_cnst, i character(LEN=*), parameter :: fmt = "(a40,a15,a1,F6.2,a1,F6.2,a1,E10.2,a5)" - character(LEN=*), parameter :: fmt2 = "(a40,F6.2,a3)" + character(LEN=*), parameter :: fmtf = "(a48,F8.4,a6)" + character(LEN=*), parameter :: fmtm = "(a48,E8.2,a7)" character(LEN=15) :: str(4) character(LEN=5) :: pf! pass or fail identifier !-------------------------------------------------------------------------------------- @@ -192,7 +193,8 @@ subroutine print_budget(hstwr) write(iulog,*) " ----- ----- ----" do i=1,4 diff = ph_dmea(i)-dy_dmea(i) - write(iulog,*)"dE/dt dry mass adjustment (xxAM-xxAP) ",str(i)," ",ph_dmea(i)," ",dy_dmea(i)," ",diff +!'(a41,a15,a1,F6.2,a1,F6.2,a1,E6.2)' + write(iulog,fmt)"dE/dt dry mass adjustment (xxAM-xxAP) ",str(i)," ",ph_dmea(i)," ",dy_dmea(i)," ",diff end do write(iulog,*)" " write(iulog,*)" " @@ -246,8 +248,8 @@ subroutine print_budget(hstwr) write(iulog,*) "" if (ntrac==0) then dycore = -dy_EFIX(1)-previous_dEdt_phys_dyn_coupl_err-previous_dEdt_dry_mass_adjust - write(iulog,*) "Hence the dycore E dissipation estimated from energy fixer " - write(iulog,*) "based on previous time-step values is ",dycore," W/M^2" + write(iulog,*) "Hence the dycore E dissipation estimated from energy fixer " + write(iulog,'(A39,F6.2,A6)') "based on previous time-step values is ",dycore," W/M^2" write(iulog,*) " " end if write(iulog,*) " " @@ -262,7 +264,7 @@ subroutine print_budget(hstwr) if (abs(E_dyBF(1))>eps) then diff = abs_diff(E_dBF(1),E_dyBF(1)) if (abs(diff)eps) then ! ! if errors print details @@ -330,12 +331,7 @@ subroutine print_budget(hstwr) write(iulog,*) "Break-down below:" write(iulog,*) "" end if -! else -! write(iulog,*)" " -! write(iulog,*)"Since you are using a separate physics grid, the physics tendencies" -! write(iulog,*)"in the dynamical core will not match due to the tendencies being" -! write(iulog,*)"interpolated from the physics to the dynamics grid:" -! write(iulog,*)" " + do i=1,4 write(iulog,*) str(i),":" write(iulog,*) "======" @@ -352,53 +348,68 @@ subroutine print_budget(hstwr) write(iulog,*)" SE dycore energy tendencies" write(iulog,*)"------------------------------------------------------------" write(iulog,*)" " - write(iulog,'(a46,F6.2,a6)')"dE/dt dycore ",dADIA," W/M^2" + write(iulog,fmtf)" dE/dt dycore ",dADIA," W/M^2" write(iulog,*)" " write(iulog,*)"Adiabatic dynamics can be divided into quasi-horizontal and vertical remapping: " write(iulog,*)" " - write(iulog,'(a40,F6.2,a6)') "dE/dt floating dynamics (dAD-dBD) ",rate_of_change_2D_dyn," W/M^2" - write(iulog,'(a40,F6.2,a6)') "dE/dt vertical remapping (dAR-dAD) ",rate_of_change_vertical_remapping," W/M^2" + write(iulog,fmtf)" dE/dt floating dynamics (dAD-dBD) ",rate_of_change_2D_dyn," W/M^2" + write(iulog,fmtf)" dE/dt vertical remapping (dAR-dAD) ",rate_of_change_vertical_remapping," W/M^2" write(iulog,*) " " - write(iulog,*) "Breakdown of 2D dynamics:" + write(iulog,*) "Breakdown of floating dynamics:" write(iulog,*) " " - write(iulog,'(a46,F6.2,a6)')" dE/dt hypervis del4 (dCH-dBH) ",diffusion_del4," W/M^2" - write(iulog,'(a46,F6.2,a6)')" dE/dt hypervis frictional heating (dAH-dCH) ",diffusion_fric," W/M^2" - write(iulog,'(a46,F6.2,a6)')" dE/dt hypervis del4 total (dAH-dBH) ",diffusion_del4_tot," W/M^2" - write(iulog,'(a46,F6.2,a6)')" dE/dt hypervis sponge del2 (dAS-dBS) ",diffusion_sponge," W/M^2" - write(iulog,'(a46,F6.2,a6)')" dE/dt explicit diffusion total ",diffusion_total," W/M^2" + write(iulog,fmtf)" dE/dt hypervis del4 (dCH-dBH) ",diffusion_del4, " W/M^2" + write(iulog,fmtf)" dE/dt hypervis frictional heating (dAH-dCH) ",diffusion_fric, " W/M^2" + write(iulog,fmtf)" dE/dt hypervis del4 total (dAH-dBH) ",diffusion_del4_tot," W/M^2" + write(iulog,fmtf)" dE/dt hypervis sponge del2 (dAS-dBS) ",diffusion_sponge, " W/M^2" + write(iulog,fmtf)" dE/dt explicit diffusion total ",diffusion_total, " W/M^2" twoDresidual = rate_of_change_2D_dyn-diffusion_total - write(iulog,'(a46,F6.2,a6)')" dE/dt residual (time-truncation errors) ",twoDresidual," W/M^2" + write(iulog,*) " " + write(iulog,fmtf)" dE/dt residual (time-truncation errors,...) ",twoDresidual, " W/M^2" + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)"Tracer mass budgets" + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" " + write(iulog,*)"Below the physics-dynamics coupling error is computed as " + write(iulog,*)"dMASS/dt physics tendency in dycore (dBD-dAF) minus" + write(iulog,*)"dMASS/dt total physics (pAM-pBF)" write(iulog,*)" " write(iulog,*)" " - do m_cnst=1,thermo_budget_num_vars if (thermo_budget_vars_massv(m_cnst)) then - write(iulog,*)"------------------------------------------------------------" - write(iulog,*)thermo_budget_vars_descriptor(m_cnst)//" budget" - write(iulog,*)"------------------------------------------------------------" + write(iulog,*)thermo_budget_vars_descriptor(m_cnst) + write(iulog,*)"------------------------------" call budget_get_global('phBP-phBF',m_cnst,pEFIX) call budget_get_global('phAM-phAP',m_cnst,pDMEA) call budget_get_global('phAP-phBP',m_cnst,param) call budget_get_global('phAM-phBF',m_cnst,phys_total) + ! + ! total energy fixer should not affect mass - checking + ! if (abs(pEFIX)>eps_mass) then - write(iulog,*) "dMASS/dt energy fixer (pBP-pBF) ",pEFIX," Pa" + write(iulog,*) "dMASS/dt energy fixer (pBP-pBF) ",pEFIX," Pa/m^2" write(iulog,*) "ERROR: Mass not conserved in energy fixer. ABORT" call endrun(subname//"Mass not conserved in energy fixer. See atm.log") endif + ! + ! dry-mass adjustmnt should not affect mass - checking + ! if (abs(pDMEA)>eps_mass) then write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",pDMEA," Pa" write(iulog,*) "ERROR: Mass not conserved in dry mass adjustment. ABORT" call endrun(subname//"Mass not conserved in dry mass adjustment. See atm.log") end if + ! + ! all of the mass-tendency should come from parameterization - checking + ! if (abs(param-phys_total)>eps_mass) then write(iulog,*) "Error: dMASS/dt parameterizations (pAP-pBP) .ne. dMASS/dt physics total (pAM-pBF)" write(iulog,*) "dMASS/dt parameterizations (pAP-pBP) ",param," Pa" write(iulog,*) "dMASS/dt physics total (pAM-pBF) ",phys_total," Pa" call endrun(subname//"mass change not only due to parameterizations. See atm.log") end if - write(iulog,*)"dMASS/dt parameterizations (pAP-pBP) ",param," Pa" - write(iulog,*)"dMASS/dt physics total (pAM-pBF) ",phys_total," Pa" write(iulog,*)" " ! ! detailed mass budget in dynamical core @@ -406,13 +417,18 @@ subroutine print_budget(hstwr) if (is_budget('dAD').and.is_budget('dBD').and.is_budget('dAR').and.is_budget('dCH')) then call budget_get_global('dAD-dBD',m_cnst,mass_change__2D_dyn) call budget_get_global('dAR-dAD',m_cnst,mass_change__vertical_remapping) - diff = mass_change__2D_dyn+mass_change__vertical_remapping - write(iulog,*)"dMASS/dt total adiabatic dynamics ",diff," Pa" + tmp = mass_change__2D_dyn+mass_change__vertical_remapping + diff = abs_diff(tmp,0.0_r8,pf=pf) + write(iulog,fmtm)" dMASS/dt total adiabatic dynamics ",diff,pf + ! + ! check for mass-conservation in the adiabatic dynamical core - + ! if not conserved provide detailed break-down + ! if (abs(diff)>eps_mass) then write(iulog,*) "Error: mass non-conservation in dynamical core" write(iulog,*) "(detailed budget below)" write(iulog,*) " " - write(iulog,*)"dMASS/dt 2D dynamics (dAD-dBD) ",mass_change__2D_dyn," Pa" + write(iulog,*)"dMASS/dt 2D dynamics (dAD-dBD) ",mass_change__2D_dyn," Pa/m^2" if (is_budget('dAR').and.is_budget('dAD')) then call budget_get_global('dAR',m_cnst,dar) call budget_get_global('dAD',m_cnst,dad) @@ -424,23 +440,27 @@ subroutine print_budget(hstwr) write(iulog,*)" " call budget_get_global('dAH-dCH',m_cnst,mass_change__heating_term_put_back_in) call budget_get_global('dAH-dBH',m_cnst,mass_change__hypervis_total) - write(iulog,*)"dMASS/dt hypervis (dAH-dBH) ",mass_change__hypervis_total," Pa" - write(iulog,*)"dMASS/dt frictional heating (dAH-dCH) ",mass_change__heating_term_put_back_in," Pa" + write(iulog,*)"dMASS/dt hypervis (dAH-dBH) ",mass_change__hypervis_total," Pa/m^2" + write(iulog,*)"dMASS/dt frictional heating (dAH-dCH) ",mass_change__heating_term_put_back_in," Pa/m^2" error = mass_change__2D_dyn-mass_change__hypervis_total - write(iulog,*)"dMASS/dt residual (time truncation errors)",error," Pa" + write(iulog,*)"dMASS/dt residual (time truncation errors)",error," Pa/m^2" end if end if - write(iulog,*)" " if (is_budget('dBD').and.is_budget('dAF')) then + ! + ! check if mass change in physics is the same as dynamical core + ! call budget_get_global('dBD',m_cnst,dbd) call budget_get_global('dAF',m_cnst,daf) call budget_get_global('dBD-dAF',m_cnst,mass_change__physics) - write(iulog,*)"dMASS/dt physics tendency in dynamics (dBD-dAF) ",mass_change__physics," Pa" val = phys_total-mass_change__physics - write(iulog,*) " " - write(iulog,*) "Mass physics dynamics coupling error:",val + write(iulog,fmtm)" Mass physics-dynamics coupling error ",val," Pa/m^2" + write(iulog,*)" " + if (abs(val)>eps_mass) then + write(iulog,fmtm)" dMASS/dt physics tendency in dycore (dBD-dAF) ",mass_change__physics," Pa/m^2" + write(iulog,fmtm)" dMASS/dt total physics ",phys_total," Pa/m^2" + end if end if - write(iulog,*)"" end if end do ! From 66ce3c82ca2bd51582a044407d76bad480d1793c Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 24 Mar 2023 14:23:20 -0600 Subject: [PATCH 079/140] hack to get bit-for-bit for FV, FV3, EUL --- src/physics/cam/geopotential.F90 | 161 +++++++++++++++--------------- src/physics/cam/physics_types.F90 | 62 ++++++++---- 2 files changed, 125 insertions(+), 98 deletions(-) diff --git a/src/physics/cam/geopotential.F90 b/src/physics/cam/geopotential.F90 index f75f352ba3..72d5aa4b5c 100644 --- a/src/physics/cam/geopotential.F90 +++ b/src/physics/cam/geopotential.F90 @@ -84,102 +84,105 @@ subroutine geopotential_t( & do i = 1,ncol zi(i,pverp) = 0.0_r8 end do -#ifdef phl_cam_development -! Compute zi, zm from bottom up. -! Note, zi(i,k) is the interface above zm(i,k) - do k = pver, 1, -1 + ! Compute zi, zm from bottom up. + ! Note, zi(i,k) is the interface above zm(i,k) -! First set hydrostatic elements consistent with dynamics - - if ((dycore_is('LR') .or. dycore_is('FV3'))) then - do i = 1,ncol - hkl(i) = piln(i,k+1) - piln(i,k) - hkk(i) = 1._r8 - pint(i,k) * hkl(i) * rpdel(i,k) - end do - else!MPAS, SE or EUL - ! - ! For EUL and SE: pmid = 0.5*(pint(k+1)+pint(k)) - ! For MPAS : pmid is computed from theta_m, rhodry, etc. - ! + ! + ! original code for backwards compatability with FV and EUL + ! + if (.not.(dycore_is('MPAS') .or. dycore_is('SE'))) then + do k = pver, 1, -1 + + ! First set hydrostatic elements consistent with dynamics + + if ((dycore_is('LR') .or. dycore_is('FV3'))) then + do i = 1,ncol + hkl(i) = piln(i,k+1) - piln(i,k) + hkk(i) = 1._r8 - pint(i,k) * hkl(i) * rpdel(i,k) + end do + else!MPAS, SE or EUL + ! + ! For EUL and SE: pmid = 0.5*(pint(k+1)+pint(k)) + ! For MPAS : pmid is computed from theta_m, rhodry, etc. + ! + do i = 1,ncol + hkl(i) = pdel(i,k) / pmid(i,k) + hkk(i) = 0.5_r8 * hkl(i) + end do + end if + + ! Now compute tv, zm, zi + do i = 1,ncol - hkl(i) = pdel(i,k) / pmid(i,k) - hkk(i) = 0.5_r8 * hkl(i) - end do - end if - -! Now compute tv, zm, zi - - do i = 1,ncol tvfac = 1._r8 + zvir(i,k) * q(i,k,1) tv = t(i,k) * tvfac - + zm(i,k) = zi(i,k+1) + rog(i,k) * tv * hkk(i) zi(i,k) = zi(i,k+1) + rog(i,k) * tv * hkl(i) - end do - end do -#else - ! - ! For the computation of generalized virtual temperature (equation 16 - ! in Lauritzen et al. (2018); https://doi.org/10.1029/2017MS001257) - ! - - ! Compute factor for converting wet to dry mixing ratio (eq.7) - qfac = 1.0_r8 - do idx = 1,thermodynamic_active_species_num - do k = 1,pver - do i = 1,ncol - qfac(i,k) = qfac(i,k)-q(i,k,thermodynamic_active_species_idx(idx)) end do end do - end do - qfac = 1.0_r8/qfac - - ! Compute sum of dry water mixing ratios - sum_dry_mixing_ratio = 1.0_r8 - do idx = 1,thermodynamic_active_species_num - do k = 1,pver - do i = 1,ncol - sum_dry_mixing_ratio(i,k) = sum_dry_mixing_ratio(i,k)& - +q(i,k,thermodynamic_active_species_idx(idx))*qfac(i,k) + else + ! + ! For the computation of generalized virtual temperature (equation 16 + ! in Lauritzen et al. (2018); https://doi.org/10.1029/2017MS001257) + ! + ! Compute factor for converting wet to dry mixing ratio (eq.7) + ! + qfac = 1.0_r8 + do idx = 1,thermodynamic_active_species_num + do k = 1,pver + do i = 1,ncol + qfac(i,k) = qfac(i,k)-q(i,k,thermodynamic_active_species_idx(idx)) + end do end do end do - end do - sum_dry_mixing_ratio(:,:) = 1.0_r8/sum_dry_mixing_ratio(:,:) - -! Compute zi, zm from bottom up. -! Note, zi(i,k) is the interface above zm(i,k) - do k = pver, 1, -1 - -! First set hydrostatic elements consistent with dynamics - - if ((dycore_is('LR') .or. dycore_is('FV3'))) then - do i = 1,ncol - hkl(i) = piln(i,k+1) - piln(i,k) - hkk(i) = 1._r8 - pint(i,k) * hkl(i) * rpdel(i,k) + qfac = 1.0_r8/qfac + + ! Compute sum of dry water mixing ratios + sum_dry_mixing_ratio = 1.0_r8 + do idx = 1,thermodynamic_active_species_num + do k = 1,pver + do i = 1,ncol + sum_dry_mixing_ratio(i,k) = sum_dry_mixing_ratio(i,k)& + +q(i,k,thermodynamic_active_species_idx(idx))*qfac(i,k) + end do end do - else!MPAS, SE or EUL - ! - ! For EUL and SE: pmid = 0.5*(pint(k+1)+pint(k)) - ! For MPAS : pmid is computed from theta_m, rhodry, etc. - ! + end do + sum_dry_mixing_ratio(:,:) = 1.0_r8/sum_dry_mixing_ratio(:,:) + ! Compute zi, zm from bottom up. + ! Note, zi(i,k) is the interface above zm(i,k) + do k = pver, 1, -1 + + ! First set hydrostatic elements consistent with dynamics + + if ((dycore_is('LR') .or. dycore_is('FV3'))) then + do i = 1,ncol + hkl(i) = piln(i,k+1) - piln(i,k) + hkk(i) = 1._r8 - pint(i,k) * hkl(i) * rpdel(i,k) + end do + else!MPAS, SE or EUL + ! + ! For EUL and SE: pmid = 0.5*(pint(k+1)+pint(k)) + ! For MPAS : pmid is computed from theta_m, rhodry, etc. + ! + do i = 1,ncol + hkl(i) = pdel(i,k) / pmid(i,k) + hkk(i) = 0.5_r8 * hkl(i) + end do + end if + + ! Now compute tv, zm, zi + do i = 1,ncol - hkl(i) = pdel(i,k) / pmid(i,k) - hkk(i) = 0.5_r8 * hkl(i) - end do - end if - -! Now compute tv, zm, zi - - do i = 1,ncol tvfac = (1._r8 + (zvir(i,k)+1.0_r8) * q(i,k,1)*qfac(i,k))*sum_dry_mixing_ratio(i,k) tv = t(i,k) * tvfac - + zm(i,k) = zi(i,k+1) + rog(i,k) * tv * hkk(i) zi(i,k) = zi(i,k+1) + rog(i,k) * tv * hkl(i) - end do - end do -#endif + end do + end do + end if return end subroutine geopotential_t end module geopotential diff --git a/src/physics/cam/physics_types.F90 b/src/physics/cam/physics_types.F90 index dc083c2590..9b0c23d2ff 100644 --- a/src/physics/cam/physics_types.F90 +++ b/src/physics/cam/physics_types.F90 @@ -1193,6 +1193,7 @@ end subroutine physics_cnst_limit subroutine physics_dme_adjust(state, tend, qini, liqini, iceini, dt) use air_composition, only: dry_air_species_num,thermodynamic_active_species_num use air_composition, only: thermodynamic_active_species_idx + use dycore, only: dycore_is !----------------------------------------------------------------------- ! ! Purpose: Adjust the dry mass in each layer back to the value of physics input state @@ -1259,27 +1260,49 @@ subroutine physics_dme_adjust(state, tend, qini, liqini, iceini, dt) ! adjust dry mass in each layer back to input value, while conserving ! constituents, momentum, and total energy state%ps(:ncol) = state%pint(:ncol,1) - do k = 1, pver - tot_water(:ncol,1) = qini(:ncol,k)+liqini(:ncol,k)+iceini(:ncol,k) !initial total H2O - tot_water(:ncol,2) = 0.0_r8 - do m_cnst=dry_air_species_num+1,thermodynamic_active_species_num - m = thermodynamic_active_species_idx(m_cnst) - tot_water(:ncol,2) = tot_water(:ncol,2)+state%q(:ncol,k,m) + + ! + ! original code for backwards compatability with FV and EUL + ! + if (.not.(dycore_is('MPAS') .or. dycore_is('SE'))) then + do k = 1, pver + + ! adjusment factor is just change in water vapor + fdq(:ncol) = 1._r8 + state%q(:ncol,k,1) - qini(:ncol,k) + + ! adjust constituents to conserve mass in each layer + do m = 1, pcnst + state%q(:ncol,k,m) = state%q(:ncol,k,m) / fdq(:ncol) + end do + ! compute new total pressure variables + state%pdel (:ncol,k ) = state%pdel(:ncol,k ) * fdq(:ncol) + state%ps(:ncol) = state%ps(:ncol) + state%pdel(:ncol,k) + state%pint (:ncol,k+1) = state%pint(:ncol,k ) + state%pdel(:ncol,k) + state%lnpint(:ncol,k+1) = log(state%pint(:ncol,k+1)) + state%rpdel (:ncol,k ) = 1._r8/ state%pdel(:ncol,k ) end do - fdq(:ncol) = 1._r8 + tot_water(:ncol,2) - tot_water(:ncol,1) - ! adjust constituents to conserve mass in each layer - do m = 1, pcnst - state%q(:ncol,k,m) = state%q(:ncol,k,m) / fdq(:ncol) + else + do k = 1, pver + tot_water(:ncol,1) = qini(:ncol,k) +liqini(:ncol,k)+iceini(:ncol,k) !initial total H2O + tot_water(:ncol,2) = 0.0_r8 + do m_cnst=dry_air_species_num+1,thermodynamic_active_species_num + m = thermodynamic_active_species_idx(m_cnst) + tot_water(:ncol,2) = tot_water(:ncol,2)+state%q(:ncol,k,m) + end do + fdq(:ncol) = 1._r8 + tot_water(:ncol,2) - tot_water(:ncol,1) + ! adjust constituents to conserve mass in each layer + do m = 1, pcnst + state%q(:ncol,k,m) = state%q(:ncol,k,m) / fdq(:ncol) + end do + ! compute new total pressure variables + state%pdel (:ncol,k ) = state%pdel(:ncol,k ) * fdq(:ncol) + state%ps(:ncol) = state%ps(:ncol) + state%pdel(:ncol,k) + state%pint (:ncol,k+1) = state%pint(:ncol,k ) + state%pdel(:ncol,k) + state%lnpint(:ncol,k+1) = log(state%pint(:ncol,k+1)) + state%rpdel (:ncol,k ) = 1._r8/ state%pdel(:ncol,k ) + !note that mid-level variables (e.g. pmid) are not recomputed end do - ! compute new total pressure variables - state%pdel (:ncol,k ) = state%pdel(:ncol,k ) * fdq(:ncol) - state%ps(:ncol) = state%ps(:ncol) + state%pdel(:ncol,k) - state%pint (:ncol,k+1) = state%pint(:ncol,k ) + state%pdel(:ncol,k) - state%lnpint(:ncol,k+1) = log(state%pint(:ncol,k+1)) - state%rpdel (:ncol,k ) = 1._r8/ state%pdel(:ncol,k ) - !note that mid-level variables (e.g. pmid) are not recomputed - end do - + endif if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then zvirv(:,:) = shr_const_rwv / rairv(:,:,state%lchnk) - 1._r8 else @@ -1287,6 +1310,7 @@ subroutine physics_dme_adjust(state, tend, qini, liqini, iceini, dt) endif end subroutine physics_dme_adjust + !----------------------------------------------------------------------- !=============================================================================== From 50f847d74a8e8f7729e10a1d44bc8ad8ccda2dfc Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 24 Mar 2023 14:24:11 -0600 Subject: [PATCH 080/140] some code clean-up --- src/physics/cam/physpkg.F90 | 18 +++++++++++------- src/physics/cam_dev/physpkg.F90 | 16 ++++++++++------ 2 files changed, 21 insertions(+), 13 deletions(-) diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 4770a5c63b..f4b3f07361 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -1392,6 +1392,7 @@ subroutine tphysac (ztodt, cam_in, & use cam_snapshot_common,only: cam_snapshot_ptend_outfld use lunar_tides, only: lunar_tides_tend use cam_thermo, only: cam_thermo_water_update + use budgets, only: thermo_budget_history ! ! Arguments ! @@ -1869,13 +1870,10 @@ subroutine tphysac (ztodt, cam_in, & end if moist_mixing_ratio_dycore = dycore_is('LR').or. dycore_is('FV3') ! - ! FV: convert dry-type mixing ratios to moist here because physics_dme_adjust - ! assumes moist. This is done in p_d_coupling for other dynamics. Bundy, Feb 2004. - if (moist_mixing_ratio_dycore) call set_dry_to_wet(state) ! Physics had dry, dynamics wants moist - ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. ! So, save off tracers - if (.not.moist_mixing_ratio_dycore) then + ! + if (.not.moist_mixing_ratio_dycore.and.thermo_budget_history) then tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver) tmp_ps(:ncol) = state%ps(:ncol) @@ -1894,14 +1892,20 @@ subroutine tphysac (ztodt, cam_in, & end if if (moist_mixing_ratio_dycore) then - + ! + ! FV: convert dry-type mixing ratios to moist here because physics_dme_adjust + ! assumes moist. This is done in p_d_coupling for other dynamics. Bundy, Feb 2004. + call set_dry_to_wet(state) ! Physics had dry, dynamics wants moist if (trim(cam_take_snapshot_before) == "physics_dme_adjust") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat) end if call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) - + if (thermo_budget_history) then + call cam_thermo_water_update(state%q(:ncol,:,:), lchnk, ncol, vc_dycore, & + to_dry_factor=state%pdel(:ncol,:)/state%pdeldry(:ncol,:)) + end if if (trim(cam_take_snapshot_after) == "physics_dme_adjust") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat) diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index 62a717d568..c8c348afb8 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -1361,6 +1361,7 @@ subroutine tphysac (ztodt, cam_in, & use carma_flags_mod, only: carma_do_cldice, carma_do_cldliq, carma_do_wetdep use dyn_tests_utils, only: vc_dycore use cam_thermo, only: cam_thermo_water_update + use budgets, only: thermo_budget_history ! ! Arguments ! @@ -2310,13 +2311,9 @@ subroutine tphysac (ztodt, cam_in, & ! FV: convert dry-type mixing ratios to moist here because physics_dme_adjust ! assumes moist. This is done in p_d_coupling for other dynamics. Bundy, Feb 2004. moist_mixing_ratio_dycore = dycore_is('LR').or. dycore_is('FV3') - ! Physics had dry, dynamics wants moist - ! Note: this operation will NOT be reverted with set_wet_to_dry after set_dry_to_wet call - if (moist_mixing_ratio_dycore) call set_dry_to_wet(state) - ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. ! So, save off tracers - if (.not.moist_mixing_ratio_dycore) then + if (.not.moist_mixing_ratio_dycore.and.thermo_budget_history) then tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver) tmp_ps(:ncol) = state%ps(:ncol) @@ -2336,13 +2333,20 @@ subroutine tphysac (ztodt, cam_in, & end if if (moist_mixing_ratio_dycore) then + ! Physics had dry, dynamics wants moist + ! Note: this operation will NOT be reverted with set_wet_to_dry after set_dry_to_wet call + call set_dry_to_wet(state) + if (trim(cam_take_snapshot_before) == "physics_dme_adjust") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) end if call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) - + if (thermo_budget_history) then + call cam_thermo_water_update(state%q(:ncol,:,:), lchnk, ncol, vc_dycore, & + to_dry_factor=state%pdel(:ncol,:)/state%pdeldry(:ncol,:)) + end if if (trim(cam_take_snapshot_after) == "physics_dme_adjust") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) From 93f251393f68da6df18ea2a15de20b5869a299ee Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 24 Mar 2023 16:39:19 -0600 Subject: [PATCH 081/140] beautiful physics energy names --- src/dynamics/se/dycore_budget.F90 | 44 ++++++++++++++--------------- src/dynamics/se/dyn_comp.F90 | 3 +- src/physics/cam/cam_diagnostics.F90 | 24 ++++++++-------- 3 files changed, 36 insertions(+), 35 deletions(-) diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index 91663876a4..085b3696af 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -34,8 +34,8 @@ subroutine print_budget(hstwr) character(len=*), parameter :: subname = 'check_energy:print_budgets' integer, dimension(4) :: idx - real(r8), dimension(4) :: ph_param,ph_EFIX,ph_DMEA,ph_PARAM_AND_EFIX,ph_phys_total - real(r8), dimension(4) :: dy_param,dy_EFIX,dy_DMEA,dy_param_and_efix,dy_phys_total + real(r8), dimension(4) :: dEdt_param_physE,dEdt_efix_physE,dEdt_dme_adjust_physE,dEdt_param_efix_physE,ph_phys_total + real(r8), dimension(4) :: dEdt_param_dynE, dEdt_efix_dynE ,dEdt_dme_adjust_dynE ,dEdt_param_efix_dynE ,dy_phys_total real(r8), dimension(4) :: se_phys_total real(r8) :: dycore, err, param, pefix, & pdmea, phys_total, dyn_phys_total, & @@ -71,19 +71,19 @@ subroutine print_budget(hstwr) ! ! CAM physics energy tendencies ! - call budget_get_global('phAP-phBP',idx(i),ph_param(i)) - call budget_get_global('phBP-phBF',idx(i),ph_EFIX(i)) - call budget_get_global('phAM-phAP',idx(i),ph_dmea(i)) - call budget_get_global('phAP-phBF',idx(i),ph_param_and_efix(i)) + call budget_get_global('phAP-phBP',idx(i),dEdt_param_physE(i)) + call budget_get_global('phBP-phBF',idx(i),dEdt_efix_physE(i)) + call budget_get_global('phAM-phAP',idx(i),dEdt_dme_adjust_physE(i)) + call budget_get_global('phAP-phBF',idx(i),dEdt_param_efix_physE(i)) call budget_get_global('phAM-phBF',idx(i),ph_phys_total(i)) ! ! CAM physics energy tendencies using dycore energy formula scaling ! temperature tendencies for consistency with CAM physics ! - call budget_get_global('dyAP-dyBP',idx(i),dy_param(i)) - call budget_get_global('dyBP-dyBF',idx(i),dy_EFIX(i)) - call budget_get_global('dyAM-dyAP',idx(i),dy_dmea(i)) - call budget_get_global('dyAP-dyBF',idx(i),dy_param_and_efix(i)) + call budget_get_global('dyAP-dyBP',idx(i),dEdt_param_dynE(i)) + call budget_get_global('dyBP-dyBF',idx(i),dEdt_efix_dynE(i)) + call budget_get_global('dyAM-dyAP',idx(i),dEdt_dme_adjust_dynE(i)) + call budget_get_global('dyAP-dyBF',idx(i),dEdt_param_efix_dynE(i)) call budget_get_global('dyAM-dyBF',idx(i),dy_phys_total(i)) call budget_get_global('dyBF' ,idx(i),E_dyBF(i))!state beginning physics ! @@ -174,10 +174,10 @@ subroutine print_budget(hstwr) write(iulog,*) " xx=ph xx=dy norm. diff." write(iulog,*) " ----- ----- -----------" do i=1,4 - diff = abs_diff(ph_EFIX(i),dy_EFIX(i),pf=pf) - write(iulog,fmt)"dE/dt energy fixer (xxBP-xxBF) ",str(i)," ",ph_EFIX(i), " ",dy_EFIX(i)," ",diff,pf - diff = abs_diff(ph_param(i),dy_param(i),pf=pf) - write(iulog,fmt)"dE/dt all parameterizations (xxAP-xxBP) ",str(i)," ",ph_param(i)," ",dy_param(i)," ",diff,pf + diff = abs_diff(dEdt_efix_physE(i),dEdt_efix_dynE(i),pf=pf) + write(iulog,fmt)"dE/dt energy fixer (xxBP-xxBF) ",str(i)," ",dEdt_efix_physE(i), " ",dEdt_efix_dynE(i)," ",diff,pf + diff = abs_diff(dEdt_param_physE(i),dEdt_param_dynE(i),pf=pf) + write(iulog,fmt)"dE/dt all parameterizations (xxAP-xxBP) ",str(i)," ",dEdt_param_physE(i)," ",dEdt_param_dynE(i)," ",diff,pf write(iulog,*) " " end do if (diff>eps) then @@ -192,9 +192,9 @@ subroutine print_budget(hstwr) write(iulog,*) " xx=ph xx=dy diff" write(iulog,*) " ----- ----- ----" do i=1,4 - diff = ph_dmea(i)-dy_dmea(i) + diff = dEdt_dme_adjust_physE(i)-dEdt_dme_adjust_dynE(i) !'(a41,a15,a1,F6.2,a1,F6.2,a1,E6.2)' - write(iulog,fmt)"dE/dt dry mass adjustment (xxAM-xxAP) ",str(i)," ",ph_dmea(i)," ",dy_dmea(i)," ",diff + write(iulog,fmt)"dE/dt dry mass adjustment (xxAM-xxAP) ",str(i)," ",dEdt_dme_adjust_physE(i)," ",dEdt_dme_adjust_dynE(i)," ",diff end do write(iulog,*)" " write(iulog,*)" " @@ -215,20 +215,20 @@ subroutine print_budget(hstwr) write(iulog,*) " " tmp = previous_dEdt_phys_dyn_coupl_err+previous_dEdt_adiabatic_dycore+previous_dEdt_dry_mass_adjust - diff = abs_diff(-dy_EFIX(1),tmp,pf) + diff = abs_diff(-dEdt_efix_dynE(1),tmp,pf) if (ntrac==0) then write(iulog,*) "Check if that is the case:", pf, diff write(iulog,*) " " if (abs(diff)>eps) then - write(iulog,*) "dE/dt energy fixer(t=n) = ",dy_EFIX(1) + write(iulog,*) "dE/dt energy fixer(t=n) = ",dEdt_efix_dynE(1) write(iulog,*) "dE/dt dry mass adjustment (t=n-1) = ",previous_dEdt_dry_mass_adjust write(iulog,*) "dE/dt adiabatic dycore (t=n-1) = ",previous_dEdt_adiabatic_dycore write(iulog,*) "dE/dt physics-dynamics coupling errors (t=n-1) = ",previous_dEdt_phys_dyn_coupl_err ! call endrun(subname//"Error in energy fixer budget") end if else - previous_dEdt_phys_dyn_coupl_err = dy_EFIX(1)+previous_dEdt_dry_mass_adjust+previous_dEdt_adiabatic_dycore - write(iulog,*) "dE/dt energy fixer(t=n) = ",dy_EFIX(1) + previous_dEdt_phys_dyn_coupl_err = dEdt_efix_dynE(1)+previous_dEdt_dry_mass_adjust+previous_dEdt_adiabatic_dycore + write(iulog,*) "dE/dt energy fixer(t=n) = ",dEdt_efix_dynE(1) write(iulog,*) "dE/dt dry mass adjustment (t=n-1) = ",previous_dEdt_dry_mass_adjust write(iulog,*) "dE/dt adiabatic dycore (t=n-1) = ",previous_dEdt_adiabatic_dycore write(iulog,*) "dE/dt physics-dynamics coupling errors (t=n-1) = ",previous_dEdt_phys_dyn_coupl_err @@ -247,7 +247,7 @@ subroutine print_budget(hstwr) end if write(iulog,*) "" if (ntrac==0) then - dycore = -dy_EFIX(1)-previous_dEdt_phys_dyn_coupl_err-previous_dEdt_dry_mass_adjust + dycore = -dEdt_efix_dynE(1)-previous_dEdt_phys_dyn_coupl_err-previous_dEdt_dry_mass_adjust write(iulog,*) "Hence the dycore E dissipation estimated from energy fixer " write(iulog,'(A39,F6.2,A6)') "based on previous time-step values is ",dycore," W/M^2" write(iulog,*) " " @@ -467,7 +467,7 @@ subroutine print_budget(hstwr) ! save adiabatic dycore dE/dt and dry-mass adjustment to avoid samping error ! previous_dEdt_adiabatic_dycore = dADIA - previous_dEdt_dry_mass_adjust = dy_DMEA(1) + previous_dEdt_dry_mass_adjust = dEdt_dme_adjust_dynE(1) end if end subroutine print_budget !========================================================================================= diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 425398f614..04fa0d8937 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -922,7 +922,8 @@ subroutine dyn_init(dyn_in, dyn_out) ! call e_m_budget('dEdt_dycore' ,'dEdt_floating_dyn' ,'dEdt_vert_remap','dyn','sum',longname="dE/dt adiabatic dynamics",cslam=ntrac>0) call e_m_budget('dEdt_del2_del4_tot' ,'dEdt_del4_tot','dEdt_del2_sponge','dyn','sum',longname="dE/dt explicit diffusion total",cslam=ntrac>0) - call e_m_budget('dEdt_residual' ,'dEdt_floating_dyn','dEdt_del2_del4_tot','dyn','dif',longname="dE/dt residual (dEdt_floating_dyn-dEdt_del2_del4_tot)",cslam=ntrac>0) + call e_m_budget('dEdt_residual' ,'dEdt_floating_dyn','dEdt_del2_del4_tot','dyn','dif',& + longname="dE/dt residual (dEdt_floating_dyn-dEdt_del2_del4_tot)",cslam=ntrac>0) end if ! ! add dynamical core tracer tendency output diff --git a/src/physics/cam/cam_diagnostics.F90 b/src/physics/cam/cam_diagnostics.F90 index 4b5db6ce76..96c3ae0f0c 100644 --- a/src/physics/cam/cam_diagnostics.F90 +++ b/src/physics/cam/cam_diagnostics.F90 @@ -401,19 +401,19 @@ subroutine diag_init_dry(pbuf2d) do istage = 1, num_stages call e_m_snapshot(TRIM(ADJUSTL(stage(istage))),'phy',longname=TRIM(ADJUSTL(stage_txt(istage)))) end do - + ! Create budgets that are a sum/dif of 2 stages - - call e_m_budget('BP_param_and_efix','phAP','phBF','phy','dif',longname='dE/dt CAM physics parameterizations + efix dycore E (phAP-phBF)') - call e_m_budget('BD_param_and_efix','dyAP','dyBF','phy','dif',longname='dE/dt CAM physics parameterizations + efix dycore E (dyAP-dyBF)') - call e_m_budget('BP_phy_params','phAP','phBP','phy','dif',longname='dE/dt CAM physics parameterizations (phAP-phBP)') - call e_m_budget('BD_phy_params','dyAP','dyBP','phy','dif',longname='dE/dt CAM physics parameterizations using dycore E (dyAP-dyBP)') - call e_m_budget('BP_pwork','phAM','phAP','phy','dif',longname='dE/dt dry mass adjustment (phAM-phAP)') - call e_m_budget('BD_pwork','dyAM','dyAP','phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)') - call e_m_budget('BP_efix','phBP','phBF','phy','dif',longname='dE/dt energy fixer (phBP-phBF)') - call e_m_budget('BD_efix','dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E (dyBP-dyBF)') - call e_m_budget('BP_phys_tot','phAM','phBF','phy','dif',longname='dE/dt physics total (phAM-phBF)') - call e_m_budget('BD_phys_tot','dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)') + + call e_m_budget('dEdt_param_efix_physE','phAP','phBF','phy','dif',longname='dE/dt CAM physics + energy fixer using physics E formula (phAP-phBF)') + call e_m_budget('dEdt_param_efix_dynE' ,'dyAP','dyBF','phy','dif',longname='dE/dt CAM physics + energy fixer using dycore E formula (dyAP-dyBF)') + call e_m_budget('dEdt_param_physE' ,'phAP','phBP','phy','dif',longname='dE/dt CAM physics using physics E formula (phAP-phBP)') + call e_m_budget('dEdt_param_dynE' ,'dyAP','dyBP','phy','dif',longname='dE/dt CAM physics using dycore E (dyAP-dyBP)') + call e_m_budget('dEdt_dme_adjust_physE','phAM','phAP','phy','dif',longname='dE/dt dry mass adjustment using physics E formula (phAM-phAP)') + call e_m_budget('dEdt_dme_adjust_dynE' ,'dyAM','dyAP','phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)') + call e_m_budget('dEdt_efix_physE' ,'phBP','phBF','phy','dif',longname='dE/dt energy fixer using physics E formula (phBP-phBF)') + call e_m_budget('dEdt_efix_dynE' ,'dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E formula (dyBP-dyBF)') + call e_m_budget('dEdt_phys_tot_physE' ,'phAM','phBF','phy','dif',longname='dE/dt physics total using physics E formula (phAM-phBF)') + call e_m_budget('dEdt_phys_tot_dynE' ,'dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)') endif end subroutine diag_init_dry From 25394dccdc7c123451ba41f5f2af300d4bc156c1 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Mon, 27 Mar 2023 13:49:01 -0600 Subject: [PATCH 082/140] some refactor and fix bug with area weights for MPAS - normalized to 1 by dividing by 4*pi --- src/control/budgets.F90 | 67 +++++---------------- src/dynamics/mpas/dyn_grid.F90 | 3 +- src/dynamics/se/dycore/prim_advance_mod.F90 | 3 +- 3 files changed, 19 insertions(+), 54 deletions(-) diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index 04ff081186..e5e589ad32 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -10,7 +10,6 @@ module budgets ! e_m_budget ! budget_ind_byname ! budget_get_global - ! budget_put_global ! budget_readnl ! is_budget !----------------------------------------------------------------------- @@ -35,7 +34,6 @@ module budgets e_m_budget, &! define a budget and add to history buffer budget_ind_byname, &! return budget index given name budget_get_global, &! return budget global - budget_put_global, &! put budget global budget_readnl, &! budget_readnl: read cam thermo namelist is_budget ! return logical if budget_defined @@ -53,7 +51,7 @@ module budgets integer, public :: thermo_budget_histfile_num = 1 logical, public :: thermo_budget_history = .false. - integer, private :: stepsize + real(r8), private :: dstepsize ! ! Constants for each budget @@ -232,7 +230,7 @@ end subroutine e_m_budget subroutine budget_init() use time_manager, only: get_step_size - stepsize=get_step_size() + dstepsize=get_step_size() end subroutine budget_init !============================================================================== @@ -295,7 +293,12 @@ subroutine budget_get_global (name, me_idx, global) if (found.and.f(thermo_budget_histfile_num)>0) then call tape(thermo_budget_histfile_num)%hlist(f(thermo_budget_histfile_num))%get_global(global) - if (.not. thermo_budget_vars_massv(me_idx)) global=global/stepsize + if (.not. thermo_budget_vars_massv(me_idx)) then + write(iulog,*)'scaling ',trim(adjustl(str1)),' by ',dstepsize,' old/new global',global,'/',global/dstepsize + global=global/dstepsize + else + write(iulog,*)'returning ',trim(adjustl(str1)),' global ',global + end if else write(errmsg,*) sub//': FATAL: name not found: ', trim(name) call endrun(errmsg) @@ -303,47 +306,6 @@ subroutine budget_get_global (name, me_idx, global) end subroutine budget_get_global !============================================================================== - subroutine budget_put_global (name, me_idx, global) - - use cam_history, only: get_field_properties - use cam_history_support, only: active_entry - use cam_thermo, only: thermo_budget_vars_massv - - ! Get the global integral of a budget. Optional abort argument allows returning - ! control to caller when budget name is not found. Default behavior is - ! to call endrun when name is not found. - - !-----------------------------Arguments--------------------------------- - character(len=*), intent(in) :: name ! budget name - integer, intent(in) :: me_idx ! mass energy variable index - real(r8), intent(in) :: global ! global budget index (in q array) - - !---------------------------Local workspace----------------------------- - type (active_entry), pointer :: tape(:) => null() ! history tapes - integer :: m ! budget index - integer :: f(ptapes),ff ! hentry index - character(len=*), parameter :: sub='budget_put_global' - character(len=128) :: errmsg - character (len=128) :: str1 - logical :: found ! true if global integral found - real(r8) :: global_normalized - !----------------------------------------------------------------------- - - ! append thermo field to stage name - write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(me_idx))),"_",TRIM(ADJUSTL(name)) - - ! Find budget name in list and push global value to hentry - call get_field_properties(trim(str1), found, tape_out=tape, ff_out=ff, f_out=f) - if (found.and.f(thermo_budget_histfile_num)>0) then - if (.not. thermo_budget_vars_massv(me_idx)) global_normalized=global/stepsize - call tape(thermo_budget_histfile_num)%hlist(f(thermo_budget_histfile_num))%put_global(global_normalized) - else - write(errmsg,*) sub//': FATAL: name not found: ', trim(name) - call endrun(errmsg) - end if - - end subroutine budget_put_global - !============================================================================== function budget_ind_byname (name) ! ! Get the index of a budget. Ret -1 for not found @@ -396,20 +358,17 @@ end function is_budget !=========================================================================== ! Read namelist variables. subroutine budget_readnl(nlfile) + use dycore, only: dycore_is use namelist_utils, only: find_group_name use spmd_utils, only: mpi_character, mpi_logical, mpi_integer - use shr_string_mod, only: shr_string_toUpper + use shr_string_mod, only: shr_string_toUpper ! Dummy argument: filepath for file containing namelist input character(len=*), intent(in) :: nlfile ! Local variables integer :: unitn, ierr - integer, parameter :: lsize = 76 - integer, parameter :: fsize = 23 character(len=*), parameter :: subname = 'budget_readnl :: ' - character(len=8) :: period - logical :: thermo_budgeting namelist /thermo_budget_nl/ thermo_budget_history, thermo_budget_histfile_num !----------------------------------------------------------------------- @@ -435,8 +394,12 @@ subroutine budget_readnl(nlfile) ! Write out thermo_budget options if (masterproc) then if (thermo_budget_history) then - write(iulog,*)'Thermo budgets will be written to the log file and diagnostics saved to history file:',& + if (dycore_is('EUL').or.dycore_is('FV').or.dycore_is('FV3')) then + call endrun(subname//'ERROR thermodynamic budgets not implemented for this dycore') + else + write(iulog,*)'Thermo budgets will be written to the log file and diagnostics saved to history file:',& thermo_budget_histfile_num + end if end if end if end subroutine budget_readnl diff --git a/src/dynamics/mpas/dyn_grid.F90 b/src/dynamics/mpas/dyn_grid.F90 index b9685d306a..104524a3c9 100644 --- a/src/dynamics/mpas/dyn_grid.F90 +++ b/src/dynamics/mpas/dyn_grid.F90 @@ -530,6 +530,7 @@ subroutine define_cam_grids() use cam_grid_support, only: horiz_coord_t, horiz_coord_create, iMap use cam_grid_support, only: cam_grid_register, cam_grid_attribute_register + use shr_const_mod, only: PI => SHR_CONST_PI ! Local variables integer :: i, j @@ -599,7 +600,7 @@ subroutine define_cam_grids() grid_map(1, i) = i grid_map(2, i) = 1 grid_map(3, i) = gidx(i) - areaWeight(i) = dyn_cols(i)%weight + areaWeight(i) = dyn_cols(i)%weight/(4.0_r8*PI) end do ! cell center grid for I/O using MPAS names diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index 71ee739ab3..3e5d5e873e 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -1453,7 +1453,7 @@ subroutine tot_energy_dyn(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suffix) use hycoef, only: hyai, ps0 use fvm_control_volume_mod, only: fvm_struct use cam_thermo, only: get_dp, MASS_MIXING_RATIO,wvidx,wlidx,wiidx,seidx,keidx,moidx,mridx,ttidx,teidx, & - thermo_budget_num_vars,thermo_budget_vars + poidx,thermo_budget_num_vars,thermo_budget_vars use cam_thermo, only: get_hydrostatic_energy use air_composition, only: thermodynamic_active_species_idx_dycore, get_cp use air_composition, only: thermodynamic_active_species_num, thermodynamic_active_species_idx_dycore @@ -1552,6 +1552,7 @@ subroutine tot_energy_dyn(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suffix) ! ! Output energy diagnostics on GLL grid ! + call outfld(name_out(poidx) ,po ,npsq,ie) call outfld(name_out(seidx) ,se ,npsq,ie) call outfld(name_out(keidx) ,ke ,npsq,ie) call outfld(name_out(teidx) ,ke+se+po ,npsq,ie) From da42b8d2531964122dd3fb463a2980608e56d543 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 27 Mar 2023 16:35:38 -0600 Subject: [PATCH 083/140] clearer naming convention in SE dycore_budget.F90 code --- src/dynamics/se/dycore_budget.F90 | 206 +++++++++++++++++------------- src/dynamics/se/dyn_comp.F90 | 10 +- 2 files changed, 125 insertions(+), 91 deletions(-) diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index 085b3696af..9f2d9c5b44 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -32,32 +32,73 @@ subroutine print_budget(hstwr) ! Local variables character(len=*), parameter :: subname = 'check_energy:print_budgets' + ! + ! physics energy tendencies + ! + integer :: idx(4) + real(r8) :: dEdt_param_physE(4) ! dE/dt CAM physics using physics E formula (phAP-phBP) + real(r8) :: dEdt_param_dynE(4) ! dE/dt CAM physics using dycore E (dyAP-dyBP) - integer, dimension(4) :: idx - real(r8), dimension(4) :: dEdt_param_physE,dEdt_efix_physE,dEdt_dme_adjust_physE,dEdt_param_efix_physE,ph_phys_total - real(r8), dimension(4) :: dEdt_param_dynE, dEdt_efix_dynE ,dEdt_dme_adjust_dynE ,dEdt_param_efix_dynE ,dy_phys_total - real(r8), dimension(4) :: se_phys_total - real(r8) :: dycore, err, param, pefix, & - pdmea, phys_total, dyn_phys_total, & - rate_of_change_2D_dyn, rate_of_change_vertical_remapping, & - diffusion_del4, diffusion_fric, diffusion_del4_tot, diffusion_sponge, & - diffusion_total, twoDresidual, & - rate_of_change_heating_term_put_back_in, rate_of_change_hvis_sponge, & - dADIA, & - mass_change__2D_dyn,mass_change__vertical_remapping, & - mass_change__heating_term_put_back_in,mass_change__hypervis_total, & - error, mass_change__physics, dbd, daf, dar, dad, val + real(r8) :: dEdt_efix_physE(4) ! dE/dt energy fixer using physics E formula (phBP-phBF) + real(r8) :: dEdt_efix_dynE(4) ! dE/dt energy fixer using dycore E formula (dyBP-dyBF) - real(r8) :: E_dBF(4), E_phBF, diff, tmp - real(r8) :: E_dyBF(4) + real(r8) :: dEdt_dme_adjust_physE(4) ! dE/dt dry mass adjustment using physics E formula (phAM-phAP) + real(r8) :: dEdt_dme_adjust_dynE(4) ! dE/dt dry mass adjustment using dycore E (dyAM-dyAP) + + real(r8) :: dEdt_param_efix_physE(4) ! dE/dt CAM physics + energy fixer using physics E formula (phAP-phBF) + real(r8) :: dEdt_param_efix_dynE(4) ! dE/dt CAM physics + energy fixer using dycore E formula (dyAP-dyBF) + + real(r8) :: dEdt_phys_total_dynE(4) ! dE/dt physics total using dycore E (dyAM-dyBF) + ! + ! SE dycore specific energy tendencies + ! + real(r8) :: dEdt_phys_total_in_dyn(4) ! dEdt of physics total in dynamical core + real(r8) :: dEdt_dycore_phys ! dEdt dycore (estimated in physics) + ! + ! mass budgets physics + ! + real(r8) :: dMdt_efix ! mass tendency energy fixer + real(r8) :: dMdt_parameterizations ! mass tendency physics paramterizations + real(r8) :: dMdt_dme_adjust ! mass tendency dry-mass adjustment + real(r8) :: dMdt_phys_total ! mass tendency physics total (energy fixer + parameterizations + dry-mass adjustment) + ! + ! mass budgets dynamics + ! + real(r8) :: dMdt_floating_dyn ! mass tendency floating dynamics (dAD-dBD) + real(r8) :: dMdt_vert_remap ! mass tendency vertical remapping (dAR-dAD) + real(r8) :: dMdt_del4_fric_heat ! mass tendency del4 frictional heating (dAH-dCH) + real(r8) :: dMdt_del4_tot ! mass tendency del4 + del4 frictional heating (dAH-dBH) + real(r8) :: dMdt_residual ! mass tendency residual (time truncation errors) + real(r8) :: dMdt_phys_total_in_dyn ! mass tendency physics total in dycore + real(r8) :: dMdt_PDC ! mass tendency physics-dynamics coupling + ! + ! energy budgets dynamics + ! + real(r8) :: dEdt_floating_dyn ! dE/dt floating dynamics (dAD-dBD) + real(r8) :: dEdt_vert_remap ! dE/dt vertical remapping (dAR-dAD) + real(r8) :: dEdt_del4 ! dE/dt del4 (dCH-dBH) + real(r8) :: dEdt_del4_fric_heat ! dE/dt del4 frictional heating (dAH-dCH) + real(r8) :: dEdt_del4_tot ! dE/dt del4 + del4 fricitional heating (dAH-dBH) + real(r8) :: dEdt_del2_sponge ! dE/dt del2 sponge (dAS-dBS) + real(r8) :: dEdt_del2_del4_tot ! dE/dt explicit diffusion total + real(r8) :: dEdt_residual ! dE/dt residual (dEdt_floating_dyn-dEdt_del2_del4_tot) + real(r8) :: dEdt_dycore_dyn ! dE/dt adiabatic dynamical core (calculated in dycore) + ! + ! physics-dynamics coupling variables + ! + real(r8) :: E_dBF(4) ! E of dynamics state at the end of dycore integration (on dycore deomposition) + real(r8) :: E_dyBF(4) ! E of physics state using dycore E + + + real(r8) :: diff, tmp ! dummy variables integer :: m_cnst, i character(LEN=*), parameter :: fmt = "(a40,a15,a1,F6.2,a1,F6.2,a1,E10.2,a5)" character(LEN=*), parameter :: fmtf = "(a48,F8.4,a6)" - character(LEN=*), parameter :: fmtm = "(a48,E8.2,a7)" + character(LEN=*), parameter :: fmtm = "(a48,E8.2,a9)" character(LEN=15) :: str(4) - character(LEN=5) :: pf! pass or fail identifier + character(LEN=5) :: pf ! pass or fail identifier !-------------------------------------------------------------------------------------- - + if (masterproc .and. thermo_budget_history .and. hstwr(thermo_budget_histfile_num)) then idx(1) = teidx !total energy index idx(2) = seidx !enthaly index @@ -75,7 +116,6 @@ subroutine print_budget(hstwr) call budget_get_global('phBP-phBF',idx(i),dEdt_efix_physE(i)) call budget_get_global('phAM-phAP',idx(i),dEdt_dme_adjust_physE(i)) call budget_get_global('phAP-phBF',idx(i),dEdt_param_efix_physE(i)) - call budget_get_global('phAM-phBF',idx(i),ph_phys_total(i)) ! ! CAM physics energy tendencies using dycore energy formula scaling ! temperature tendencies for consistency with CAM physics @@ -84,27 +124,25 @@ subroutine print_budget(hstwr) call budget_get_global('dyBP-dyBF',idx(i),dEdt_efix_dynE(i)) call budget_get_global('dyAM-dyAP',idx(i),dEdt_dme_adjust_dynE(i)) call budget_get_global('dyAP-dyBF',idx(i),dEdt_param_efix_dynE(i)) - call budget_get_global('dyAM-dyBF',idx(i),dy_phys_total(i)) + call budget_get_global('dyAM-dyBF',idx(i),dEdt_phys_total_dynE(i)) call budget_get_global('dyBF' ,idx(i),E_dyBF(i))!state beginning physics ! ! CAM physics energy tendencies in dynamical core ! - call budget_get_global('dBD-dAF',idx(i),se_phys_total(i)) + call budget_get_global('dBD-dAF',idx(i),dEdt_phys_total_in_dyn(i)) call budget_get_global('dBF' ,idx(i),E_dBF(i)) !state passed to physics end do - call budget_get_global('dAD-dBD',teidx,rate_of_change_2D_dyn) - call budget_get_global('dAR-dAD',teidx,rate_of_change_vertical_remapping) - dADIA = rate_of_change_2D_dyn+rate_of_change_vertical_remapping - - call budget_get_global('dCH-dBH',teidx,diffusion_del4) - call budget_get_global('dAH-dCH',teidx,diffusion_fric) - call budget_get_global('dAH-dBH',teidx,diffusion_del4_tot) - call budget_get_global('dAS-dBS',teidx,diffusion_sponge) - diffusion_total = diffusion_del4_tot+diffusion_sponge + call budget_get_global('dAD-dBD',teidx,dEdt_floating_dyn) + call budget_get_global('dAR-dAD',teidx,dEdt_vert_remap) + dEdt_dycore_dyn = dEdt_floating_dyn+dEdt_vert_remap - rate_of_change_heating_term_put_back_in = diffusion_fric - rate_of_change_hvis_sponge = diffusion_sponge + call budget_get_global('dCH-dBH',teidx,dEdt_del4) + call budget_get_global('dAH-dCH',teidx,dEdt_del4_fric_heat) + call budget_get_global('dAH-dBH',teidx,dEdt_del4_tot) + call budget_get_global('dAS-dBS',teidx,dEdt_del2_sponge) + dEdt_del2_del4_tot = dEdt_del4_tot+dEdt_del2_sponge + dEdt_residual = dEdt_floating_dyn-dEdt_del2_del4_tot write(iulog,*)" " write(iulog,*)"======================================================================" @@ -137,6 +175,7 @@ subroutine print_budget(hstwr) write(iulog,*)"Suffix dy is dycore energy computed in CAM physics using" write(iulog,*)"CAM physics state variables" write(iulog,*)" " + write(iulog,*)" " write(iulog,*)"Energy stages in dynamics (specific to the SE dycore)" write(iulog,*)"-----------------------------------------------------" write(iulog,*)" " @@ -247,9 +286,9 @@ subroutine print_budget(hstwr) end if write(iulog,*) "" if (ntrac==0) then - dycore = -dEdt_efix_dynE(1)-previous_dEdt_phys_dyn_coupl_err-previous_dEdt_dry_mass_adjust + dEdt_dycore_phys = -dEdt_efix_dynE(1)-previous_dEdt_phys_dyn_coupl_err-previous_dEdt_dry_mass_adjust write(iulog,*) "Hence the dycore E dissipation estimated from energy fixer " - write(iulog,'(A39,F6.2,A6)') "based on previous time-step values is ",dycore," W/M^2" + write(iulog,'(A39,F6.2,A6)') "based on previous time-step values is ",dEdt_dycore_phys," W/M^2" write(iulog,*) " " end if write(iulog,*) " " @@ -299,8 +338,8 @@ subroutine print_budget(hstwr) write(iulog,*)"-------------------------------------------------------------------------" write(iulog,*)" " if (ntrac>0) then - write(iulog,'(a46,F6.2,a6)')"dE/dt physics tendency in dynamics (dBD-dAF) ",se_phys_total(1)," W/M^2" - write(iulog,'(a46,F6.2,a6)')"dE/dt physics tendency in physics (dyAM-dyBF) ",dy_phys_total(1)," W/M^2" + write(iulog,'(a46,F6.2,a6)')"dE/dt physics tendency in dynamics (dBD-dAF) ",dEdt_phys_total_in_dyn(1)," W/M^2" + write(iulog,'(a46,F6.2,a6)')"dE/dt physics tendency in physics (dyAM-dyBF) ",dEdt_phys_total_dynE(1)," W/M^2" write(iulog,*)" " write(iulog,*) " When runnig with a physics grid this consistency check does not make sense" write(iulog,*) " since it is computed on the GLL grid whereas we enforce energy conservation" @@ -311,8 +350,8 @@ subroutine print_budget(hstwr) write(iulog,*) " dE/dt physics-dynamics coupling errors (t=n-1) =",previous_dEdt_phys_dyn_coupl_err write(iulog,*) "" else - previous_dEdt_phys_dyn_coupl_err = se_phys_total(1)-dy_phys_total(1) - diff = abs_diff(dy_phys_total(1),se_phys_total(1),pf=pf) + previous_dEdt_phys_dyn_coupl_err = dEdt_phys_total_in_dyn(1)-dEdt_phys_total_dynE(1) + diff = abs_diff(dEdt_phys_total_dynE(1),dEdt_phys_total_in_dyn(1),pf=pf) write(iulog,'(A40,E8.2,A7,A4)')"dE/dt physics-dynamics coupling errors ",diff," W/M^2 ",pf if (abs(diff)>eps) then ! @@ -335,10 +374,10 @@ subroutine print_budget(hstwr) do i=1,4 write(iulog,*) str(i),":" write(iulog,*) "======" - diff = abs_diff(dy_phys_total(i),se_phys_total(i),pf=pf) + diff = abs_diff(dEdt_phys_total_dynE(i),dEdt_phys_total_in_dyn(i),pf=pf) write(iulog,*) "dE/dt physics-dynamics coupling errors (diff) ",diff - write(iulog,*) "dE/dt physics tendency in dynamics (dBD-dAF) ",se_phys_total(i) - write(iulog,*) "dE/dt physics tendency in physics (pAM-pBF) ",dy_phys_total(i) + write(iulog,*) "dE/dt physics tendency in dynamics (dBD-dAF) ",dEdt_phys_total_in_dyn(i) + write(iulog,*) "dE/dt physics tendency in physics (pAM-pBF) ",dEdt_phys_total_dynE(i) write(iulog,*) " " end do end if @@ -348,24 +387,23 @@ subroutine print_budget(hstwr) write(iulog,*)" SE dycore energy tendencies" write(iulog,*)"------------------------------------------------------------" write(iulog,*)" " - write(iulog,fmtf)" dE/dt dycore ",dADIA," W/M^2" + write(iulog,fmtf)" dE/dt dycore ",dEdt_dycore_dyn," W/M^2" write(iulog,*)" " write(iulog,*)"Adiabatic dynamics can be divided into quasi-horizontal and vertical remapping: " write(iulog,*)" " - write(iulog,fmtf)" dE/dt floating dynamics (dAD-dBD) ",rate_of_change_2D_dyn," W/M^2" - write(iulog,fmtf)" dE/dt vertical remapping (dAR-dAD) ",rate_of_change_vertical_remapping," W/M^2" + write(iulog,fmtf)" dE/dt floating dynamics (dAD-dBD) ",dEdt_floating_dyn," W/M^2" + write(iulog,fmtf)" dE/dt vertical remapping (dAR-dAD) ",dEdt_vert_remap," W/M^2" write(iulog,*) " " write(iulog,*) "Breakdown of floating dynamics:" write(iulog,*) " " - write(iulog,fmtf)" dE/dt hypervis del4 (dCH-dBH) ",diffusion_del4, " W/M^2" - write(iulog,fmtf)" dE/dt hypervis frictional heating (dAH-dCH) ",diffusion_fric, " W/M^2" - write(iulog,fmtf)" dE/dt hypervis del4 total (dAH-dBH) ",diffusion_del4_tot," W/M^2" - write(iulog,fmtf)" dE/dt hypervis sponge del2 (dAS-dBS) ",diffusion_sponge, " W/M^2" - write(iulog,fmtf)" dE/dt explicit diffusion total ",diffusion_total, " W/M^2" - twoDresidual = rate_of_change_2D_dyn-diffusion_total + write(iulog,fmtf)" dE/dt hypervis del4 (dCH-dBH) ",dEdt_del4, " W/M^2" + write(iulog,fmtf)" dE/dt hypervis frictional heating (dAH-dCH) ",dEdt_del4_fric_heat," W/M^2" + write(iulog,fmtf)" dE/dt hypervis del4 total (dAH-dBH) ",dEdt_del4_tot, " W/M^2" + write(iulog,fmtf)" dE/dt hypervis sponge del2 (dAS-dBS) ",dEdt_del2_sponge, " W/M^2" + write(iulog,fmtf)" dE/dt explicit diffusion total ",dEdt_del2_del4_tot, " W/M^2" write(iulog,*) " " - write(iulog,fmtf)" dE/dt residual (time-truncation errors,...) ",twoDresidual, " W/M^2" + write(iulog,fmtf)" dE/dt residual (time-truncation errors,...) ",dEdt_residual, " W/M^2" write(iulog,*)" " write(iulog,*)" " write(iulog,*)"------------------------------------------------------------" @@ -381,33 +419,33 @@ subroutine print_budget(hstwr) if (thermo_budget_vars_massv(m_cnst)) then write(iulog,*)thermo_budget_vars_descriptor(m_cnst) write(iulog,*)"------------------------------" - call budget_get_global('phBP-phBF',m_cnst,pEFIX) - call budget_get_global('phAM-phAP',m_cnst,pDMEA) - call budget_get_global('phAP-phBP',m_cnst,param) - call budget_get_global('phAM-phBF',m_cnst,phys_total) + call budget_get_global('phBP-phBF',m_cnst,dMdt_efix) + call budget_get_global('phAM-phAP',m_cnst,dMdt_dme_adjust) + call budget_get_global('phAP-phBP',m_cnst,dMdt_parameterizations) + call budget_get_global('phAM-phBF',m_cnst,dMdt_phys_total) ! ! total energy fixer should not affect mass - checking ! - if (abs(pEFIX)>eps_mass) then - write(iulog,*) "dMASS/dt energy fixer (pBP-pBF) ",pEFIX," Pa/m^2" + if (abs(dMdt_efix)>eps_mass) then + write(iulog,*) "dMASS/dt energy fixer (pBP-pBF) ",dMdt_efix," Pa/m^2/s" write(iulog,*) "ERROR: Mass not conserved in energy fixer. ABORT" call endrun(subname//"Mass not conserved in energy fixer. See atm.log") endif ! ! dry-mass adjustmnt should not affect mass - checking ! - if (abs(pDMEA)>eps_mass) then - write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",pDMEA," Pa" + if (abs(dMdt_dme_adjust)>eps_mass) then + write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",dMdt_dme_adjust," Pa/m^2/s" write(iulog,*) "ERROR: Mass not conserved in dry mass adjustment. ABORT" call endrun(subname//"Mass not conserved in dry mass adjustment. See atm.log") end if ! ! all of the mass-tendency should come from parameterization - checking ! - if (abs(param-phys_total)>eps_mass) then + if (abs(dMdt_parameterizations-dMdt_phys_total)>eps_mass) then write(iulog,*) "Error: dMASS/dt parameterizations (pAP-pBP) .ne. dMASS/dt physics total (pAM-pBF)" - write(iulog,*) "dMASS/dt parameterizations (pAP-pBP) ",param," Pa" - write(iulog,*) "dMASS/dt physics total (pAM-pBF) ",phys_total," Pa" + write(iulog,*) "dMASS/dt parameterizations (pAP-pBP) ",dMdt_parameterizations," Pa/m^2/s" + write(iulog,*) "dMASS/dt physics total (pAM-pBF) ",dMdt_phys_total," Pa/m^2/s" call endrun(subname//"mass change not only due to parameterizations. See atm.log") end if write(iulog,*)" " @@ -415,9 +453,9 @@ subroutine print_budget(hstwr) ! detailed mass budget in dynamical core ! if (is_budget('dAD').and.is_budget('dBD').and.is_budget('dAR').and.is_budget('dCH')) then - call budget_get_global('dAD-dBD',m_cnst,mass_change__2D_dyn) - call budget_get_global('dAR-dAD',m_cnst,mass_change__vertical_remapping) - tmp = mass_change__2D_dyn+mass_change__vertical_remapping + call budget_get_global('dAD-dBD',m_cnst,dMdt_floating_dyn) + call budget_get_global('dAR-dAD',m_cnst,dMdt_vert_remap) + tmp = dMdt_floating_dyn+dMdt_vert_remap diff = abs_diff(tmp,0.0_r8,pf=pf) write(iulog,fmtm)" dMASS/dt total adiabatic dynamics ",diff,pf ! @@ -428,37 +466,33 @@ subroutine print_budget(hstwr) write(iulog,*) "Error: mass non-conservation in dynamical core" write(iulog,*) "(detailed budget below)" write(iulog,*) " " - write(iulog,*)"dMASS/dt 2D dynamics (dAD-dBD) ",mass_change__2D_dyn," Pa/m^2" + write(iulog,*)"dMASS/dt 2D dynamics (dAD-dBD) ",dMdt_floating_dyn," Pa/m^2/s" if (is_budget('dAR').and.is_budget('dAD')) then - call budget_get_global('dAR',m_cnst,dar) - call budget_get_global('dAD',m_cnst,dad) - call budget_get_global('dAR-dAD',m_cnst,mass_change__vertical_remapping) - write(iulog,*)"dE/dt vertical remapping (dAR-dAD) ",mass_change__vertical_remapping + call budget_get_global('dAR-dAD',m_cnst,dMdt_vert_remap) + write(iulog,*)"dE/dt vertical remapping (dAR-dAD) ",dMdt_vert_remap end if write(iulog,*)" " write(iulog,*)"Breakdown of 2D dynamics:" write(iulog,*)" " - call budget_get_global('dAH-dCH',m_cnst,mass_change__heating_term_put_back_in) - call budget_get_global('dAH-dBH',m_cnst,mass_change__hypervis_total) - write(iulog,*)"dMASS/dt hypervis (dAH-dBH) ",mass_change__hypervis_total," Pa/m^2" - write(iulog,*)"dMASS/dt frictional heating (dAH-dCH) ",mass_change__heating_term_put_back_in," Pa/m^2" - error = mass_change__2D_dyn-mass_change__hypervis_total - write(iulog,*)"dMASS/dt residual (time truncation errors)",error," Pa/m^2" + call budget_get_global('dAH-dCH',m_cnst,dMdt_del4_fric_heat) + call budget_get_global('dAH-dBH',m_cnst,dMdt_del4_tot) + write(iulog,*)"dMASS/dt hypervis (dAH-dBH) ",dMdt_del4_tot," Pa/m^2/s" + write(iulog,*)"dMASS/dt frictional heating (dAH-dCH) ",dMdt_del4_fric_heat," Pa/m^2/s" + dMdt_residual = dMdt_floating_dyn-dMdt_del4_tot + write(iulog,*)"dMASS/dt residual (time truncation errors)",dMdt_residual," Pa/m^2/s" end if end if if (is_budget('dBD').and.is_budget('dAF')) then ! ! check if mass change in physics is the same as dynamical core ! - call budget_get_global('dBD',m_cnst,dbd) - call budget_get_global('dAF',m_cnst,daf) - call budget_get_global('dBD-dAF',m_cnst,mass_change__physics) - val = phys_total-mass_change__physics - write(iulog,fmtm)" Mass physics-dynamics coupling error ",val," Pa/m^2" + call budget_get_global('dBD-dAF',m_cnst,dMdt_phys_total_in_dyn) + dMdt_PDC = dMdt_phys_total-dMdt_phys_total_in_dyn + write(iulog,fmtm)" Mass physics-dynamics coupling error ",dMdt_PDC," Pa/m^2/s" write(iulog,*)" " - if (abs(val)>eps_mass) then - write(iulog,fmtm)" dMASS/dt physics tendency in dycore (dBD-dAF) ",mass_change__physics," Pa/m^2" - write(iulog,fmtm)" dMASS/dt total physics ",phys_total," Pa/m^2" + if (abs(dMdt_PDC)>eps_mass) then + write(iulog,fmtm)" dMASS/dt physics tendency in dycore (dBD-dAF) ",dMdt_phys_total_in_dyn," Pa/m^2/s" + write(iulog,fmtm)" dMASS/dt total physics ",dMdt_phys_total," Pa/m^2/s" end if end if end if @@ -466,7 +500,7 @@ subroutine print_budget(hstwr) ! ! save adiabatic dycore dE/dt and dry-mass adjustment to avoid samping error ! - previous_dEdt_adiabatic_dycore = dADIA + previous_dEdt_adiabatic_dycore = dEdt_dycore_dyn previous_dEdt_dry_mass_adjust = dEdt_dme_adjust_dynE(1) end if end subroutine print_budget diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 04fa0d8937..db1ba4b9a2 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -911,12 +911,12 @@ subroutine dyn_init(dyn_in, dyn_out) ! call e_m_budget('dEdt_floating_dyn' ,'dAD','dBD','dyn','dif',longname="dE/dt floating dynamics (dAD-dBD)" ,cslam=ntrac>0) call e_m_budget('dEdt_vert_remap' ,'dAR','dAD','dyn','dif',longname="dE/dt vertical remapping (dAR-dAD)" ,cslam=ntrac>0) - call e_m_budget('dEdt_phys_tend_in_dyn' ,'dBD','dAF','dyn','dif',longname="dE/dt physics tendency in dynamics (dBD-dAF)" ,cslam=ntrac>0) + call e_m_budget('dEdt_phys_tot_in_dyn' ,'dBD','dAF','dyn','dif',longname="dE/dt physics tendency in dynamics (dBD-dAF)" ,cslam=ntrac>0) - call e_m_budget('dEdt_del4' ,'dCH','dBH','dyn','dif',longname="dE/dt dycore hypervis del4 (dCH-dBH)" ,cslam=ntrac>0) - call e_m_budget('dEdt_del4_fric_heat','dAH','dCH','dyn','dif',longname="dE/dt hypervis frictional heating del4 (dAH-dCH)",cslam=ntrac>0) - call e_m_budget('dEdt_del4_tot' ,'dAH','dBH','dyn','dif',longname="dE/dt hypervis del4 total (dAH-dBH)",cslam=ntrac>0) - call e_m_budget('dEdt_del2_sponge' ,'dAS','dBS','dyn','dif',longname="dE/dt hypervis sponge del2 (dAS-dBS)",cslam=ntrac>0) + call e_m_budget('dEdt_del4' ,'dCH','dBH','dyn','dif',longname="dE/dt del4 (dCH-dBH)" ,cslam=ntrac>0) + call e_m_budget('dEdt_del4_fric_heat','dAH','dCH','dyn','dif',longname="dE/dt del4 frictional heating (dAH-dCH)",cslam=ntrac>0) + call e_m_budget('dEdt_del4_tot' ,'dAH','dBH','dyn','dif',longname="dE/dt del4 + del4 frictional heating (dAH-dBH)",cslam=ntrac>0) + call e_m_budget('dEdt_del2_sponge' ,'dAS','dBS','dyn','dif',longname="dE/dt del2 sponge (dAS-dBS)",cslam=ntrac>0) ! ! Register derived budgets ! From 8c8618bccf31a365dc4c1e92bd1c4b5380f5502c Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Mon, 27 Mar 2023 18:45:58 -0600 Subject: [PATCH 084/140] bug fix for budgets, need to normalize before creating a composed field --- src/control/cam_history.F90 | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index efe3dc9d1b..d67b608b25 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -5580,17 +5580,23 @@ subroutine wshist (rgnht_in) !$OMP PARALLEL DO PRIVATE (F) do f=1,nflds(t) - ! First compose field if needed - if (tape(t)%hlist(f)%field%is_composed()) then - call h_field_op (f, t) - end if if(.not. restart) then - ! Normalized averaged fields - if (tape(t)%hlist(f)%avgflag /= 'I') then + ! Normalize all non composed fields, composed fields are calculated next using the normalized components + if (tape(t)%hlist(f)%avgflag /= 'I'.and..not.tape(t)%hlist(f)%field%is_composed()) then call h_normalize (f, t) end if end if end do + + !$OMP PARALLEL DO PRIVATE (F) + do f=1,nflds(t) + if(.not. restart) then + ! calculate composed fields from normalized components + if (tape(t)%hlist(f)%field%is_composed()) then + call h_field_op (f, t) + end if + end if + end do ! ! Write field to history tape. Note that this is NOT threaded due to netcdf limitations ! From 9512833fb1a5b09541e6d001b344e3dedd3a86de Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 31 Mar 2023 14:25:28 -0600 Subject: [PATCH 085/140] fix energy diagnostic bug --- src/physics/cam/check_energy.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 1bd55b6545..65a66a985e 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -819,7 +819,7 @@ end subroutine check_tracers_chng subroutine tot_energy_phys(state, outfld_name_suffix,vc) use physconst, only: gravit,rearth,omega use cam_thermo, only: get_hydrostatic_energy,thermo_budget_num_vars,thermo_budget_vars, & - wvidx,wlidx,wiidx,seidx,keidx,moidx,mridx,ttidx,teidx + wvidx,wlidx,wiidx,seidx,poidx,keidx,moidx,mridx,ttidx,teidx use cam_history, only: outfld use dyn_tests_utils, only: vc_physics, vc_height, vc_dry_pressure @@ -927,13 +927,14 @@ subroutine tot_energy_phys(state, outfld_name_suffix,vc) end if end if - call outfld(name_out(seidx) ,se+po , pcols ,lchnk ) + call outfld(name_out(seidx) ,se , pcols ,lchnk ) + call outfld(name_out(poidx) ,po , pcols ,lchnk ) call outfld(name_out(keidx) ,ke , pcols ,lchnk ) call outfld(name_out(wvidx) ,wv , pcols ,lchnk ) call outfld(name_out(wlidx) ,liq , pcols ,lchnk ) call outfld(name_out(wiidx) ,ice , pcols ,lchnk ) call outfld(name_out(ttidx) ,tt , pcols ,lchnk ) - call outfld(name_out(teidx) ,se+ke+po , pcols ,lchnk ) + call outfld(name_out(teidx) ,se+ke+po, pcols ,lchnk ) ! ! Axial angular momentum diagnostics ! From e2a759d62a21218944d6e3522c55cf2c7bfbedf3 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 31 Mar 2023 14:25:41 -0600 Subject: [PATCH 086/140] further improvements and unification of logfile energy output --- src/dynamics/mpas/dycore_budget.F90 | 562 ++++++++++++++++++---------- src/dynamics/se/dycore_budget.F90 | 23 +- 2 files changed, 375 insertions(+), 210 deletions(-) diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index c1b3bce48d..7285726da8 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -3,222 +3,384 @@ module dycore_budget implicit none public :: print_budget -real(r8), parameter :: eps = 1.0E-11_r8 -real(r8), save :: previous_dEdt_adiabatic_dycore = 0.0_r8 +real(r8), parameter :: eps = 1.0E-9_r8 +real(r8), parameter :: eps_mass = 1.0E-12_r8 +real(r8), save :: previous_dEdt_adiabatic_dycore = 0.0_r8 +real(r8), save :: previous_dEdt_dry_mass_adjust = 0.0_r8 +real(r8), save :: previous_dEdt_phys_dyn_coupl_err = 0.0_r8 !========================================================================================= contains !========================================================================================= subroutine print_budget(hstwr) - use budgets, only: budget_get_global, thermo_budget_histfile_num, thermo_budget_history - use spmd_utils, only: masterproc - use cam_logfile, only: iulog - use cam_abortutils, only: endrun - use cam_thermo, only: teidx, thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv + use budgets, only: budget_get_global, thermo_budget_histfile_num, thermo_budget_history + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + use cam_abortutils, only: endrun + use cam_thermo, only: teidx, thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv + use cam_thermo, only: teidx, seidx, keidx, poidx ! arguments logical, intent(in) :: hstwr(:) ! Local variables - real(r8),allocatable :: tmp(:,:) - integer :: i character(len=*), parameter :: subname = 'check_energy:print_budgets' - real(r8) :: ph_param,ph_EFIX,ph_dmea,ph_param_and_efix,ph_phys_total - real(r8) :: dy_param,dy_EFIX,dy_dmea,dy_param_and_efix,dy_phys_total - real(r8) :: mpas_param,mpas_dmea,mpas_phys_total, dycore, err, param, pefix, pdmea, param_mpas, phys_total - real(r8) :: E_dBF, E_dyBF - real(r8) :: diff - integer :: m_cnst - character(LEN=*), parameter :: fmt = "(a40,F6.2,a1,F6.2,a1,E10.2,a4)" - character(LEN=*), parameter :: fmt2 = "(a40,F6.2,a3)" - character(LEN=5) :: pf! pass or fail identifier - !-------------------------------------------------------------------------------------- +!xxx real(r8) :: ph_param,ph_EFIX,ph_dmea,ph_param_and_efix,ph_phys_total +!xxx real(r8) :: dy_param,dy_EFIX,dy_dmea,dy_param_and_efix,dy_phys_total +!xxx real(r8) :: mpas_param,mpas_dmea,mpas_phys_total, dycore, err, param, pefix, pdmea, param_mpas, phys_total +!xxx character(LEN=*), parameter :: fmt2 = "(a40,F6.2,a3)" + + + ! + ! physics energy tendencies + ! + integer :: idx(4) + real(r8) :: dEdt_param_physE(4) ! dE/dt CAM physics using physics E formula (phAP-phBP) + real(r8) :: dEdt_param_dynE(4) ! dE/dt CAM physics using dycore E (dyAP-dyBP) + + real(r8) :: dEdt_efix_physE(4) ! dE/dt energy fixer using physics E formula (phBP-phBF) + real(r8) :: dEdt_efix_dynE(4) ! dE/dt energy fixer using dycore E formula (dyBP-dyBF) + + real(r8) :: dEdt_dme_adjust_physE(4) ! dE/dt dry mass adjustment using physics E formula (phAM-phAP) + real(r8) :: dEdt_dme_adjust_dynE(4) ! dE/dt dry mass adjustment using dycore E (dyAM-dyAP) + + real(r8) :: dEdt_param_efix_physE(4) ! dE/dt CAM physics + energy fixer using physics E formula (phAP-phBF) + real(r8) :: dEdt_param_efix_dynE(4) ! dE/dt CAM physics + energy fixer using dycore E formula (dyAP-dyBF) + real(r8) :: dEdt_phys_total_dynE(4) ! dE/dt physics total using dycore E (dyAM-dyBF) + ! physics total = parameterizations + efix + dry-mass adjustment + ! + ! SE dycore specific energy tendencies + ! + + + real(r8) :: dEdt_phys_total_in_dyn(4) ! dEdt of physics total in dynamical core + ! physics total = parameterizations + efix + dry-mass adjustment + real(r8) :: dEdt_param_efix_in_dyn(4) ! dEdt of physics total in dynamical core + real(r8) :: dEdt_dme_adjust_in_dyn(4) ! dEdt of dme adjust in dynamical core + real(r8) :: dEdt_dycore_phys ! dEdt dycore (estimated in physics) + ! + ! mass budgets physics + ! + real(r8) :: dMdt_efix ! mass tendency energy fixer + real(r8) :: dMdt_parameterizations ! mass tendency physics paramterizations + real(r8) :: dMdt_dme_adjust ! mass tendency dry-mass adjustment + real(r8) :: dMdt_phys_total ! mass tendency physics total (energy fixer + parameterizations + dry-mass adjustment) + ! + ! mass budgets dynamics + ! + real(r8) :: dMdt_phys_total_in_dyn ! mass tendency physics total in dycore + real(r8) :: dMdt_PDC ! mass tendency physics-dynamics coupling + ! + ! physics-dynamics coupling variables + ! + real(r8) :: E_dBF(4) ! E of dynamics state at the end of dycore integration (on dycore deomposition) + real(r8) :: E_dyBF(4) ! E of physics state using dycore E + + + real(r8) :: diff, tmp ! dummy variables + integer :: m_cnst, i + character(LEN=*), parameter :: fmt = "(a40,a15,a1,F6.2,a1,F6.2,a1,E10.2,a5)" + character(LEN=*), parameter :: fmtf = "(a48,F8.4,a6)" + character(LEN=*), parameter :: fmtm = "(a48,E8.2,a9)" + character(LEN=15) :: str(4) + character(LEN=5) :: pf ! pass or fail identifier + !-------------------------------------------------------------------------------------- + if (masterproc .and. thermo_budget_history .and. hstwr(thermo_budget_histfile_num)) then - call budget_get_global('phAP-phBP',teidx,ph_param) - call budget_get_global('phBP-phBF',teidx,ph_EFIX) - call budget_get_global('phAM-phAP',teidx,ph_dmea) - call budget_get_global('phAP-phBF',teidx,ph_param_and_efix) - call budget_get_global('phAM-phBF',teidx,ph_phys_total) - - call budget_get_global('dyAP-dyBP',teidx,dy_param) - call budget_get_global('dyBP-dyBF',teidx,dy_EFIX) - call budget_get_global('dyAM-dyAP',teidx,dy_dmea) - call budget_get_global('dyAP-dyBF',teidx,dy_param_and_efix) - call budget_get_global('dyAM-dyBF',teidx,dy_phys_total) - - call budget_get_global('dAP-dBF',teidx,mpas_param) - call budget_get_global('dAM-dAP',teidx,mpas_dmea) - call budget_get_global('dAM-dBF',teidx,mpas_phys_total) - - write(iulog,*)" " - write(iulog,*)"======================================================================" - write(iulog,*)"Total energy diagnostics introduced in Lauritzen and Williamson (2019)" - write(iulog,*)"(DOI:10.1029/2018MS001549)" - write(iulog,*)"======================================================================" - write(iulog,*)" " - write(iulog,*)"Globally and vertically integrated total energy (E) diagnostics are" - write(iulog,*)"computed at various points in the physics and dynamics loops to compute" - write(iulog,*)"energy tendencies (dE/dt) and check for consistency (e.g., is E of" - write(iulog,*)"state passed to physics computed using dycore state variables the same" - write(iulog,*)"E of the state in the beginning of physics computed using the physics" - write(iulog,*)"representation of the state)" - write(iulog,*)" " - write(iulog,*)"Energy stages in physics:" - write(iulog,*)"-------------------------" - write(iulog,*)" " - write(iulog,*)" xxBF: state passed to parameterizations, before energy fixer" - write(iulog,*)" xxBP: after energy fixer, before parameterizations" - write(iulog,*)" xxAP: after last phys_update in parameterizations and state " - write(iulog,*)" saved for energy fixer" - write(iulog,*)" xxAM: after dry mass adjustment" - write(iulog,*)" history files saved off here" - write(iulog,*)" " - write(iulog,*)"where xx='ph','dy' " - write(iulog,*)" " - write(iulog,*)"Suffix ph is CAM physics total energy" - write(iulog,*)"(eq. 111 in Lauritzen et al. 2022; 10.1029/2022MS003117)" - write(iulog,*)" " - write(iulog,*)"Suffix dy is dycore energy computed in CAM physics using" - write(iulog,*)"CAM physics state variables" - write(iulog,*)" " - write(iulog,*)"Energy stages in dynamics" - write(iulog,*)"-------------------------" - write(iulog,*)" " - write(iulog,*)" dBF: dynamics state before physics (d_p_coupling)" - write(iulog,*)" dAP: dynamics state with T,u,V increment but not incl water changes" - write(iulog,*)" dAM: dynamics state with full physics increment (incl. water)" - write(iulog,*)" " - write(iulog,*)"Note that these energies are computed using the dynamical core" - write(iulog,*)"state variables which may be different from the physics prognostic" - write(iulog,*)"variables." - write(iulog,*)" " - write(iulog,*)" " - write(iulog,*)"Consistency check 0:" - write(iulog,*)"--------------------" - write(iulog,*)" " - write(iulog,*)"For energetic consistency we require that dE/dt [W/m^2] from energy " - write(iulog,*)"fixer and all parameterizations computed using physics E and" - write(iulog,*)"dycore in physics E are the same! Checking:" - write(iulog,*)" " - write(iulog,*) " xx=ph xx=dy norm. diff." - write(iulog,*) " ----- ----- -----------" - diff = abs_diff(ph_EFIX,dy_EFIX,pf=pf) - write(iulog,fmt)"dE/dt energy fixer (xxBP-xxBF) ",ph_EFIX, " ",dy_EFIX," ",diff,pf - - diff = abs_diff(ph_param,dy_param,pf=pf) - write(iulog,fmt)"dE/dt all parameterizations (xxAP-xxBP) ",ph_param, " ",dy_param," ",diff,pf - if (diff>eps) write(iulog,*)"FAIL" - write(iulog,*)" " - write(iulog,*)" " - write(iulog,*)"dE/dt from dry-mass adjustment will differ if dynamics and physics use" - write(iulog,*)"different energy definitions! Checking:" - write(iulog,*)" " - diff = ph_dmea-dy_dmea - write(iulog,*) " xx=ph xx=dy difference" - write(iulog,*) " ----- ----- -----------" - write(iulog,fmt)"dE/dt dry mass adjustment (xxAM-xxAP) ",ph_dmea, " ",dy_dmea," ",diff - write(iulog,*)" " - write(iulog,*)" " - write(iulog,*)"Some energy budget observations:" - write(iulog,*)"--------------------------------" - write(iulog,*)" " - write(iulog,*)"Note that total energy fixer fixes:" - write(iulog,*) " " - write(iulog,*) "-dE/dt energy fixer = dE/dt dry mass adjustment +" - write(iulog,*) " dE/dt dycore +" - write(iulog,*) " dE/dt physics-dynamics coupling errors" - write(iulog,*) " " - write(iulog,*) "(equation 23 in Lauritzen and Williamson (2019))" - write(iulog,*) " " - dycore = -dy_EFIX-dy_dmea - write(iulog,*)"Hence the dycore E dissipation estimated from energy fixer is ",dycore," W/M^2" - write(iulog,*)"(assuming no physics-dynamics coupling errors)" - write(iulog,*)" " - -! dycore = -ph_EFIX-ph_dmea -! dycore = -ph_EFIX-previous_dEdt_dry_mass_adjust -! write(iulog,*) "" -! write(iulog,*) "Dycore TE dissipation estimated from physics in pressure coordinate:" -! write(iulog,*) "(note to avoid sampling error we need dE/dt from previous time-step)" -! write(iulog,*) "" -! write(iulog,*) "dE/dt adiabatic dycore estimated from physics (t=n-1) = " -! write(iulog,'(a58,F6.2,a6)') "-dE/dt energy fixer(t=n)-dE/dt dry-mass adjust(t=n-1) = ",dycore," W/M^2" -! write(iulog,*) "" -! write(iulog,'(a58,F6.2,a6)') "dE/dt adiabatic dycore computed in dycore (t=n-1) = ",& -! previous_dEdt_adiabatic_dycore," W/M^2" -! write(iulog,'(a58,F6.2,a6)') "dE/dt dry-mass adjust (t=n-1) = ",& -! previous_dEdt_dry_mass_adjust," W/M^2" -! write(iulog,*) "" -! if (abs(previous_dEdt_adiabatic_dycore)>eps) then -! diff = abs((dycore-previous_dEdt_adiabatic_dycore)/previous_dEdt_adiabatic_dycore) -! if (diff>eps) then -! write(iulog,*) "energy budget not closed: previous_dEdt_adiabatic_dycore <> dycore" -! write(iulog,*) "normalized difference is:",diff -! call endrun('dycore_budget module: physics energy budget consistency error 2') -! end if -! end if - write(iulog,*) " " - write(iulog,*) "-------------------------------------------------------------------" - write(iulog,*) " Consistency check 1: state passed to physics same as end dynamics?" - write(iulog,*) "-------------------------------------------------------------------" - write(iulog,*) " " - write(iulog,*) "Is globally integrated total energy of state at the end of dynamics (dBF)" - write(iulog,*) "and beginning of physics (dyBF) the same?" - write(iulog,*) "" - call budget_get_global('dBF',teidx,E_dBF) !state passed to physics - call budget_get_global('dyBF',teidx,E_dyBF)!state beginning physics - if (abs(E_dyBF)>eps) then - diff = abs_diff(E_dBF,E_dyBF) - if (abs(diff)eps) write(iulog,*)" MASS BUDGET ERROR" + idx(1) = teidx !total energy index + idx(2) = seidx !enthaly index + idx(3) = keidx !kinetic energy index + idx(4) = poidx !surface potential energy index + str(1) = "(total )" + str(2) = "(internal )" + str(3) = "(kinetic )" + str(4) = "(potential )" + do i=1,4 + ! + ! CAM physics energy tendencies + ! + call budget_get_global('phAP-phBP',idx(i),dEdt_param_physE(i)) + call budget_get_global('phBP-phBF',idx(i),dEdt_efix_physE(i)) + call budget_get_global('phAM-phAP',idx(i),dEdt_dme_adjust_physE(i)) + call budget_get_global('phAP-phBF',idx(i),dEdt_param_efix_physE(i)) + ! + ! CAM physics energy tendencies using dycore energy formula scaling + ! temperature tendencies for consistency with CAM physics + ! + call budget_get_global('dyAP-dyBP',idx(i),dEdt_param_dynE(i)) + call budget_get_global('dyBP-dyBF',idx(i),dEdt_efix_dynE(i)) + call budget_get_global('dyAM-dyAP',idx(i),dEdt_dme_adjust_dynE(i)) + call budget_get_global('dyAP-dyBF',idx(i),dEdt_param_efix_dynE(i)) + call budget_get_global('dyAM-dyBF',idx(i),dEdt_phys_total_dynE(i))!xxx + call budget_get_global('dyBF' ,idx(i),E_dyBF(i))!state beginning physics + ! + ! CAM physics energy tendencies in dynamical core + ! + call budget_get_global('dAP-dBF',teidx,dEdt_param_efix_in_dyn(i)) + call budget_get_global('dAM-dAP',teidx,dEdt_dme_adjust_in_dyn(i)) + call budget_get_global('dAM-dBF',teidx,dEdt_param_efix_in_dyn(i)) + + call budget_get_global('dAM-dBF',idx(i),dEdt_phys_total_in_dyn(i)) + call budget_get_global('dBF' ,idx(i),E_dBF(i)) !state passed to physics + end do + + write(iulog,*)" " + write(iulog,*)"======================================================================" + write(iulog,*)"Total energy diagnostics introduced in Lauritzen and Williamson (2019)" + write(iulog,*)"(DOI:10.1029/2018MS001549)" + write(iulog,*)"======================================================================" + write(iulog,*)" " + write(iulog,*)"Globally and vertically integrated total energy (E) diagnostics are" + write(iulog,*)"computed at various points in the physics and dynamics loops to compute" + write(iulog,*)"energy tendencies (dE/dt) and check for consistency (e.g., is E of" + write(iulog,*)"state passed to physics computed using dycore state variables the same" + write(iulog,*)"E of the state in the beginning of physics computed using the physics" + write(iulog,*)"representation of the state)" + write(iulog,*)" " + write(iulog,*)"Energy stages in physics:" + write(iulog,*)"-------------------------" + write(iulog,*)" " + write(iulog,*)" xxBF: state passed to parameterizations, before energy fixer" + write(iulog,*)" xxBP: after energy fixer, before parameterizations" + write(iulog,*)" xxAP: after last phys_update in parameterizations and state " + write(iulog,*)" saved for energy fixer" + write(iulog,*)" xxAM: after dry mass adjustment" + write(iulog,*)" history files saved off here" + write(iulog,*)" " + write(iulog,*)"where xx='ph','dy' " + write(iulog,*)" " + write(iulog,*)"Suffix ph is CAM physics total energy" + write(iulog,*)"(eq. 111 in Lauritzen et al. 2022; 10.1029/2022MS003117)" + write(iulog,*)" " + write(iulog,*)"Suffix dy is dycore energy computed in CAM physics using" + write(iulog,*)"CAM physics state variables" + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)"Energy stages in dynamics" + write(iulog,*)"-------------------------" + write(iulog,*)" " + write(iulog,*)" dBF: dynamics state before physics (d_p_coupling)" + write(iulog,*)" dAP: dynamics state with T,u,V increment but not incl water changes" + write(iulog,*)" dAM: dynamics state with full physics increment (incl. water)" + write(iulog,*)" " + write(iulog,*)"Note that these energies are computed using the dynamical core" + write(iulog,*)"state variables which may be different from the physics prognostic" + write(iulog,*)"variables." + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)"FYI: all difference (diff) below are absolute normalized differences" + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)"Consistency check 0:" + write(iulog,*)"--------------------" + write(iulog,*)" " + write(iulog,*)"For energetic consistency we require that dE/dt [W/m^2] from energy " + write(iulog,*)"fixer and all parameterizations computed using physics E and" + write(iulog,*)"dycore in physics E are the same! Checking:" + write(iulog,*)" " + write(iulog,*) " xx=ph xx=dy norm. diff." + write(iulog,*) " ----- ----- -----------" + do i=1,4 + diff = abs_diff(dEdt_efix_physE(i),dEdt_efix_dynE(i),pf=pf) + write(iulog,fmt)"dE/dt energy fixer (xxBP-xxBF) ",str(i)," ",dEdt_efix_physE(i), " ",dEdt_efix_dynE(i)," ",diff,pf + diff = abs_diff(dEdt_param_physE(i),dEdt_param_dynE(i),pf=pf) + write(iulog,fmt)"dE/dt all parameterizations (xxAP-xxBP) ",str(i)," ",dEdt_param_physE(i)," ",dEdt_param_dynE(i)," ",diff,pf + write(iulog,*) " " + end do + if (diff>eps) then + write(iulog,*)"FAIL" + call endrun(subname//"dE/dt's in physics inconsistent") + end if + write(iulog,*)" " + write(iulog,*)" " + write(iulog,*)"dE/dt from dry-mass adjustment will differ if dynamics and physics use" + write(iulog,*)"different energy definitions! Checking:" + write(iulog,*)" " + write(iulog,*) " xx=ph xx=dy diff" + write(iulog,*) " ----- ----- ----" + do i=1,4 + diff = dEdt_dme_adjust_physE(i)-dEdt_dme_adjust_dynE(i) + write(iulog,fmt)"dE/dt dry mass adjustment (xxAM-xxAP) ",str(i)," ",dEdt_dme_adjust_physE(i)," ",dEdt_dme_adjust_dynE(i)," ",diff + end do + write(iulog,*)" " + write(iulog,*)" " + ! + ! these diagnostics only make sense time-step to time-step + ! + write(iulog,*)" " + write(iulog,*)"Some energy budget observations:" + write(iulog,*)"--------------------------------" + write(iulog,*)" " + write(iulog,*)" Note that total energy fixer fixes:" + write(iulog,*)" " + write(iulog,*)" -dE/dt energy fixer(t=n) = dE/dt dry mass adjustment (t=n-1) +" + write(iulog,*)" dE/dt adiabatic dycore (t=n-1) +" + write(iulog,*)" dE/dt physics-dynamics coupling errors (t=n-1)" + write(iulog,*)" " + write(iulog,*)" (equation 23 in Lauritzen and Williamson (2019))" + write(iulog,*)" " + + tmp = previous_dEdt_phys_dyn_coupl_err+previous_dEdt_adiabatic_dycore+previous_dEdt_dry_mass_adjust + diff = abs_diff(-dEdt_efix_dynE(1),tmp,pf) + write(iulog,*) "" + write(iulog,*) "Check if that is the case:", pf, diff + write(iulog,*) " " + if (abs(diff)>eps) then + write(iulog,*) "dE/dt energy fixer(t=n) = ",dEdt_efix_dynE(1) + write(iulog,*) "dE/dt dry mass adjustment (t=n-1) = ",previous_dEdt_dry_mass_adjust + write(iulog,*) "dE/dt adiabatic dycore (t=n-1) = ",previous_dEdt_adiabatic_dycore + write(iulog,*) "dE/dt physics-dynamics coupling errors (t=n-1) = ",previous_dEdt_phys_dyn_coupl_err + ! call endrun(subname//"Error in energy fixer budget") + end if + dEdt_dycore_phys = -dEdt_efix_dynE(1)-previous_dEdt_phys_dyn_coupl_err-previous_dEdt_dry_mass_adjust + write(iulog,*) "Hence the dycore E dissipation estimated from energy fixer " + write(iulog,'(A39,F6.2,A6)') "based on previous time-step values is ",dEdt_dycore_phys," W/M^2" + write(iulog,*) " " + write(iulog,*) " " + write(iulog,*) "-------------------------------------------------------------------" + write(iulog,*) " Consistency check 1: state passed to physics same as end dynamics?" + write(iulog,*) "-------------------------------------------------------------------" + write(iulog,*) " " + write(iulog,*) "Is globally integrated total energy of state at the end of dynamics (dBF)" + write(iulog,*) "and beginning of physics (using dynamics in physics energy; dyBF) the same?" + write(iulog,*) "" + + if (abs(E_dyBF(1))>eps) then + diff = abs_diff(E_dBF(1),E_dyBF(1)) + if (abs(diff)eps) then + do i=1,4 + write(iulog,*) str(i),":" + write(iulog,*) "======" + diff = abs_diff(dEdt_phys_total_dynE(i),dEdt_phys_total_in_dyn(i),pf=pf) + write(iulog,*) "dE/dt physics-dynamics coupling errors (diff) ",diff + write(iulog,*) "dE/dt physics total in dynamics (dAM-dBF) ",dEdt_phys_total_in_dyn(i) + write(iulog,*) "dE/dt physics total in physics (pAM-pBF) ",dEdt_phys_total_dynE(i) + write(iulog,*) " " + write(iulog,*) " physics total = parameterizations + efix + dry-mass adjustment" + write(iulog,*) " " + end do + end if + write(iulog,*)" " + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" MPAS dycore energy tendencies" + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" " + write(iulog,*)" Energy diagnostics have not been implemented in the MPAS" + write(iulog,*)" dynamical core so a detailed budget is not available." + write(iulog,*)" " + write(iulog,*)" dE/dt adiabatic dynamical core must therefore be estiamted" + write(iulog,*)" from" + write(iulog,*)" " + write(iulog,*)" dE/dt adiabatic dycore (t=n-1) = " + write(iulog,*)" -dE/dt dry mass adjustment (t=n-1) +" + write(iulog,*)" -dE/dt energy fixer(t=n)" + write(iulog,*)" -dE/dt physics-dynamics coupling errors (t=n-1)" + write(iulog,*)" " + dEdt_dycore_phys = -dEdt_efix_dynE(1)-previous_dEdt_dry_mass_adjust + write(iulog,'(A34,F6.2,A6)') " = ",dEdt_dycore_phys," W/M^2" + write(iulog,*)" " + write(iulog,*)" assuming no physics-dynamics coupling errors, that is," + write(iulog,*)" dE/dt physics-dynamics coupling errors (t=n-1) = 0" + write(iulog,*)" " + write(iulog,*)" For MPAS the physics-dynamics coupling errors include:" + write(iulog,*)" - `dribbling' temperature and wind tendencies during the" + write(iulog,*)" dynamical core time-integration." + write(iulog,*)" - mapping wind tendencies from A to C grid" + write(iulog,*)" " + + write(iulog,*)" " + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)"Tracer mass budgets" + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" " + write(iulog,*)"Below the physics-dynamics coupling error is computed as " + write(iulog,*)"dMASS/dt physics tendency in dycore (dBD-dAF) minus" + write(iulog,*)"dMASS/dt total physics (pAM-pBF)" + write(iulog,*)" " + write(iulog,*)" " + do m_cnst=1,thermo_budget_num_vars + if (thermo_budget_vars_massv(m_cnst)) then + write(iulog,*)thermo_budget_vars_descriptor(m_cnst) + write(iulog,*)"------------------------------" + call budget_get_global('phBP-phBF',m_cnst,dMdt_efix) + call budget_get_global('phAM-phAP',m_cnst,dMdt_dme_adjust) + call budget_get_global('phAP-phBP',m_cnst,dMdt_parameterizations) + call budget_get_global('phAM-phBF',m_cnst,dMdt_phys_total) + ! + ! total energy fixer should not affect mass - checking + ! + if (abs(dMdt_efix)>eps_mass) then + write(iulog,*) "dMASS/dt energy fixer (pBP-pBF) ",dMdt_efix," Pa/m^2/s" + write(iulog,*) "ERROR: Mass not conserved in energy fixer. ABORT" + call endrun(subname//"Mass not conserved in energy fixer. See atm.log") + endif + ! + ! dry-mass adjustmnt should not affect mass - checking + ! + if (abs(dMdt_dme_adjust)>eps_mass) then + write(iulog,*)"dMASS/dt dry mass adjustment (pAM-pAP) ",dMdt_dme_adjust," Pa/m^2/s" + write(iulog,*) "ERROR: Mass not conserved in dry mass adjustment. ABORT" + call endrun(subname//"Mass not conserved in dry mass adjustment. See atm.log") + end if + ! + ! all of the mass-tendency should come from parameterization - checking + ! + if (abs(dMdt_parameterizations-dMdt_phys_total)>eps_mass) then + write(iulog,*) "Error: dMASS/dt parameterizations (pAP-pBP) .ne. dMASS/dt physics total (pAM-pBF)" + write(iulog,*) "dMASS/dt parameterizations (pAP-pBP) ",dMdt_parameterizations," Pa/m^2/s" + write(iulog,*) "dMASS/dt physics total (pAM-pBF) ",dMdt_phys_total," Pa/m^2/s" + call endrun(subname//"mass change not only due to parameterizations. See atm.log") + end if + write(iulog,*)" " + ! + ! check if mass change in physics is the same as dynamical core + ! + call budget_get_global('dAM-dBF',m_cnst,dMdt_phys_total_in_dyn) + dMdt_PDC = dMdt_phys_total-dMdt_phys_total_in_dyn + write(iulog,fmtm)" Mass physics-dynamics coupling error ",dMdt_PDC," Pa/m^2/s" + write(iulog,*)" " + if (abs(dMdt_PDC)>eps_mass) then + write(iulog,fmtm)" dMASS/dt physics tendency in dycore (dAM-dBF) ",dMdt_phys_total_in_dyn," Pa/m^2/s" + write(iulog,fmtm)" dMASS/dt total physics ",dMdt_phys_total," Pa/m^2/s" end if - end do - end if + end if + end do + + ! + ! save adiabatic dycore dE/dt and dry-mass adjustment to avoid samping error + ! + previous_dEdt_adiabatic_dycore = dEdt_dycore_phys + previous_dEdt_dry_mass_adjust = dEdt_dme_adjust_dynE(1) + end if end subroutine print_budget !========================================================================================= function abs_diff(a,b,pf) diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index 9f2d9c5b44..358b7a9169 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -49,11 +49,13 @@ subroutine print_budget(hstwr) real(r8) :: dEdt_param_efix_dynE(4) ! dE/dt CAM physics + energy fixer using dycore E formula (dyAP-dyBF) real(r8) :: dEdt_phys_total_dynE(4) ! dE/dt physics total using dycore E (dyAM-dyBF) + ! physics total = parameterizations + efix + dry-mass adjustment ! ! SE dycore specific energy tendencies ! real(r8) :: dEdt_phys_total_in_dyn(4) ! dEdt of physics total in dynamical core - real(r8) :: dEdt_dycore_phys ! dEdt dycore (estimated in physics) + ! physics total = parameterizations + efix + dry-mass adjustment + real(r8) :: dEdt_dycore_phys ! dEdt dycore (estimated in physics) ! ! mass budgets physics ! @@ -104,7 +106,7 @@ subroutine print_budget(hstwr) idx(2) = seidx !enthaly index idx(3) = keidx !kinetic energy index idx(4) = poidx !surface potential energy index - str(1) = "(total) )" + str(1) = "(total )" str(2) = "(enthalpy )" str(3) = "(kinetic )" str(4) = "(srf potential)" @@ -232,7 +234,6 @@ subroutine print_budget(hstwr) write(iulog,*) " ----- ----- ----" do i=1,4 diff = dEdt_dme_adjust_physE(i)-dEdt_dme_adjust_dynE(i) -!'(a41,a15,a1,F6.2,a1,F6.2,a1,E6.2)' write(iulog,fmt)"dE/dt dry mass adjustment (xxAM-xxAP) ",str(i)," ",dEdt_dme_adjust_physE(i)," ",dEdt_dme_adjust_dynE(i)," ",diff end do write(iulog,*)" " @@ -320,8 +321,8 @@ subroutine print_budget(hstwr) else write(iulog,*)" " write(iulog,*)"Since you are using a separate physics grid, the state in dynamics" - write(iulog,*)"will not be the same on the physics grid" - write(iulog,*)"interpolated from the physics to the dynamics " + write(iulog,*)"will not be the same on the physics grid since it is" + write(iulog,*)"interpolated from the dynamics to the physics grid" write(iulog,*)" " do i=1,4 write(iulog,*) str(i),":" @@ -352,16 +353,16 @@ subroutine print_budget(hstwr) else previous_dEdt_phys_dyn_coupl_err = dEdt_phys_total_in_dyn(1)-dEdt_phys_total_dynE(1) diff = abs_diff(dEdt_phys_total_dynE(1),dEdt_phys_total_in_dyn(1),pf=pf) - write(iulog,'(A40,E8.2,A7,A4)')"dE/dt physics-dynamics coupling errors ",diff," W/M^2 ",pf + write(iulog,'(A40,E8.2,A7,A5)')" dE/dt physics-dynamics coupling errors ",diff," W/M^2 ",pf if (abs(diff)>eps) then ! ! if errors print details ! if (ftype==1) then write(iulog,*) "" - write(iulog,*) "You are using ftype==1 so physics-dynamics coupling errors should be round-off!" + write(iulog,*) " You are using ftype==1 so physics-dynamics coupling errors should be round-off!" write(iulog,*) "" - write(iulog,*) "Because of failure provide detailed diagnostics below:" + write(iulog,*) " Because of failure provide detailed diagnostics below:" write(iulog,*) "" else write(iulog,*) "" @@ -376,8 +377,10 @@ subroutine print_budget(hstwr) write(iulog,*) "======" diff = abs_diff(dEdt_phys_total_dynE(i),dEdt_phys_total_in_dyn(i),pf=pf) write(iulog,*) "dE/dt physics-dynamics coupling errors (diff) ",diff - write(iulog,*) "dE/dt physics tendency in dynamics (dBD-dAF) ",dEdt_phys_total_in_dyn(i) - write(iulog,*) "dE/dt physics tendency in physics (pAM-pBF) ",dEdt_phys_total_dynE(i) + write(iulog,*) "dE/dt physics total in dynamics (dBD-dAF) ",dEdt_phys_total_in_dyn(i) + write(iulog,*) "dE/dt physics total in physics (dyAM-dyBF) ",dEdt_phys_total_dynE(i) + write(iulog,*) " " + write(iulog,*) " physics total = parameterizations + efix + dry-mass adjustment" write(iulog,*) " " end do end if From 1fdb5344ad09448a2d184cb47818961190c0c0ff Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 3 Apr 2023 09:58:24 -0600 Subject: [PATCH 087/140] clean-up --- src/dynamics/mpas/dycore_budget.F90 | 9 --------- src/dynamics/mpas/dyn_comp.F90 | 8 ++++---- src/dynamics/se/dyn_comp.F90 | 22 ++++++++++------------ 3 files changed, 14 insertions(+), 25 deletions(-) diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index 7285726da8..7838e96b09 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -26,13 +26,6 @@ subroutine print_budget(hstwr) ! Local variables character(len=*), parameter :: subname = 'check_energy:print_budgets' - -!xxx real(r8) :: ph_param,ph_EFIX,ph_dmea,ph_param_and_efix,ph_phys_total -!xxx real(r8) :: dy_param,dy_EFIX,dy_dmea,dy_param_and_efix,dy_phys_total -!xxx real(r8) :: mpas_param,mpas_dmea,mpas_phys_total, dycore, err, param, pefix, pdmea, param_mpas, phys_total -!xxx character(LEN=*), parameter :: fmt2 = "(a40,F6.2,a3)" - - ! ! physics energy tendencies ! @@ -54,8 +47,6 @@ subroutine print_budget(hstwr) ! ! SE dycore specific energy tendencies ! - - real(r8) :: dEdt_phys_total_in_dyn(4) ! dEdt of physics total in dynamical core ! physics total = parameterizations + efix + dry-mass adjustment real(r8) :: dEdt_param_efix_in_dyn(4) ! dEdt of physics total in dynamical core diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index 4ec329a7af..5c82978703 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -22,7 +22,7 @@ module dyn_comp use inic_analytic, only: analytic_ic_active, dyn_set_inic_col use dyn_tests_utils, only: vcoord=>vc_height -use cam_history, only: addfld, add_default, horiz_only, register_vector_field, & +use cam_history, only: add_default, horiz_only, register_vector_field, & outfld, hist_fld_active use cam_history_support, only: max_fieldname_len use string_utils, only: date2yyyymmdd, sec2hms, int2str @@ -547,9 +547,9 @@ subroutine dyn_init(dyn_in, dyn_out) ! initialize MPAS energy budgets ! add budgets that are derived from stages ! - call e_m_budget('mpas_param','dAP','dBF',pkgtype='dyn',optype='dif',longname="dE/dt parameterizations+efix in dycore (dparam)(dAP-dBF)") - call e_m_budget('mpas_dmea' ,'dAM','dAP',pkgtype='dyn',optype='dif',longname="dE/dt dry mass adjustment in dycore (dAM-dAP)") - call e_m_budget('mpas_phys_total' ,'dAM','dBF',pkgtype='dyn',optype='dif',longname="dE/dt physics total in dycore (phys) (dAM-dBF)") + call e_m_budget('dEdt_param_efix_in_dyn','dAP','dBF',pkgtype='dyn',optype='dif',longname="dE/dt parameterizations+efix in dycore (dparam)(dAP-dBF)") + call e_m_budget('dEdt_dme_adjust_in_dyn','dAM','dAP',pkgtype='dyn',optype='dif',longname="dE/dt dry mass adjustment in dycore (dAM-dAP)") + call e_m_budget('dEdt_phys_total_in_dyn','dAM','dBF',pkgtype='dyn',optype='dif',longname="dE/dt physics total in dycore (phys) (dAM-dBF)") end if ! diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index db1ba4b9a2..d28a4a2afe 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -901,27 +901,25 @@ subroutine dyn_init(dyn_in, dyn_out) if (thermo_budget_history) then ! Register stages for budgets - do istage = 1, num_stages call e_m_snapshot(TRIM(ADJUSTL(stage(istage))), 'dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), cslam=ntrac>0) end do - ! ! Register tendency (difference) budgets ! - call e_m_budget('dEdt_floating_dyn' ,'dAD','dBD','dyn','dif',longname="dE/dt floating dynamics (dAD-dBD)" ,cslam=ntrac>0) - call e_m_budget('dEdt_vert_remap' ,'dAR','dAD','dyn','dif',longname="dE/dt vertical remapping (dAR-dAD)" ,cslam=ntrac>0) - call e_m_budget('dEdt_phys_tot_in_dyn' ,'dBD','dAF','dyn','dif',longname="dE/dt physics tendency in dynamics (dBD-dAF)" ,cslam=ntrac>0) - - call e_m_budget('dEdt_del4' ,'dCH','dBH','dyn','dif',longname="dE/dt del4 (dCH-dBH)" ,cslam=ntrac>0) - call e_m_budget('dEdt_del4_fric_heat','dAH','dCH','dyn','dif',longname="dE/dt del4 frictional heating (dAH-dCH)",cslam=ntrac>0) - call e_m_budget('dEdt_del4_tot' ,'dAH','dBH','dyn','dif',longname="dE/dt del4 + del4 frictional heating (dAH-dBH)",cslam=ntrac>0) - call e_m_budget('dEdt_del2_sponge' ,'dAS','dBS','dyn','dif',longname="dE/dt del2 sponge (dAS-dBS)",cslam=ntrac>0) + call e_m_budget('dEdt_floating_dyn' ,'dAD','dBD','dyn','dif',longname="dE/dt floating dynamics (dAD-dBD)" ,cslam=ntrac>0) + call e_m_budget('dEdt_vert_remap' ,'dAR','dAD','dyn','dif',longname="dE/dt vertical remapping (dAR-dAD)" ,cslam=ntrac>0) + call e_m_budget('dEdt_phys_tot_in_dyn','dBD','dAF','dyn','dif',longname="dE/dt physics tendency in dynamics (dBD-dAF)" ,cslam=ntrac>0) + + call e_m_budget('dEdt_del4' ,'dCH','dBH','dyn','dif',longname="dE/dt del4 (dCH-dBH)" ,cslam=ntrac>0) + call e_m_budget('dEdt_del4_fric_heat','dAH','dCH','dyn','dif',longname="dE/dt del4 frictional heating (dAH-dCH)" ,cslam=ntrac>0) + call e_m_budget('dEdt_del4_tot' ,'dAH','dBH','dyn','dif',longname="dE/dt del4 + del4 frictional heating (dAH-dBH)",cslam=ntrac>0) + call e_m_budget('dEdt_del2_sponge' ,'dAS','dBS','dyn','dif',longname="dE/dt del2 sponge (dAS-dBS)" ,cslam=ntrac>0) ! ! Register derived budgets ! - call e_m_budget('dEdt_dycore' ,'dEdt_floating_dyn' ,'dEdt_vert_remap','dyn','sum',longname="dE/dt adiabatic dynamics",cslam=ntrac>0) - call e_m_budget('dEdt_del2_del4_tot' ,'dEdt_del4_tot','dEdt_del2_sponge','dyn','sum',longname="dE/dt explicit diffusion total",cslam=ntrac>0) + call e_m_budget('dEdt_dycore' ,'dEdt_floating_dyn','dEdt_vert_remap' ,'dyn','sum',longname="dE/dt adiabatic dynamics" ,cslam=ntrac>0) + call e_m_budget('dEdt_del2_del4_tot' ,'dEdt_del4_tot' ,'dEdt_del2_sponge' ,'dyn','sum',longname="dE/dt explicit diffusion total",cslam=ntrac>0) call e_m_budget('dEdt_residual' ,'dEdt_floating_dyn','dEdt_del2_del4_tot','dyn','dif',& longname="dE/dt residual (dEdt_floating_dyn-dEdt_del2_del4_tot)",cslam=ntrac>0) end if From 52f55d15132ccaac641709d59d6ce052ac929572 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Wed, 5 Apr 2023 10:14:02 -0600 Subject: [PATCH 088/140] remove old ifdef code --- src/dynamics/mpas/dp_coupling.F90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index 0e18271f04..293bc8ed54 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -387,16 +387,12 @@ subroutine derived_phys(phys_state, phys_tend, pbuf2d) do k = 1, pver ! To be consistent with total energy formula in physic's check_energy module only ! include water vapor in moist pdel. -#ifdef phl_cam_development - factor(:ncol,k) = 1._r8 + phys_state(lchnk)%q(:ncol,k,1) -#else factor(:ncol,k) = 1.0_r8 do m_cnst=1,thermodynamic_active_species_num m = thermodynamic_active_species_idx(m_cnst) ! at this point all q's are dry factor(:ncol,k) = factor(:ncol,k)+phys_state(lchnk)%q(:ncol,k,m) end do -#endif phys_state(lchnk)%pdel(:ncol,k) = phys_state(lchnk)%pdeldry(:ncol,k)*factor(:ncol,k) phys_state(lchnk)%rpdel(:ncol,k) = 1._r8 / phys_state(lchnk)%pdel(:ncol,k) end do From 33ef5e4b18c56a541d884312d5080ca6e89e6bd2 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Wed, 5 Apr 2023 10:54:16 -0600 Subject: [PATCH 089/140] clean-up --- src/dynamics/mpas/dp_coupling.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index 293bc8ed54..e854f8725a 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -598,7 +598,6 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn ! ! Compute q not updated by physics -!xxx clean-up this code do m=1,thermodynamic_active_species_num do iCell = 1, nCellsSolve do k = 1, pver @@ -625,7 +624,7 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn call get_R(qktmp,idx_thermo,Rold) Rold=Rold*cv/Rgas - qwv = tracers(index_qv,:,1:nCellsSolve)-dtime*q_tend(index_qv_phys,:,1:nCellsSolve)!xxx not needed + qwv = tracers(index_qv,:,1:nCellsSolve)-dtime*q_tend(index_qv_phys,:,1:nCellsSolve) do iCell = 1, nCellsSolve do k = 1, pver rhodk = zz(k,iCell) * rho_zz(k,iCell) From 6fa7e93caaf8493be6c84f0a17c36cc43ae4528a Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Thu, 6 Apr 2023 16:25:25 -0600 Subject: [PATCH 090/140] bug (identified by Jesse N.) --- src/control/cam_history.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index d67b608b25..622573fe86 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -5091,7 +5091,7 @@ subroutine h_field_op (f, t) tape(t)%hlist(f2)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) else if (trim(op) == 'sum') then tape(t)%hlist(f)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) = & - tape(t)%hlist(f1)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) - & + tape(t)%hlist(f1)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) + & tape(t)%hlist(f2)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) else call endrun('dyn_readnl: ERROR: budget_optype unknown:'//trim(op)) From 730a00503574a84c575d54f2b46c660478d68b3f Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Thu, 6 Apr 2023 16:58:07 -0600 Subject: [PATCH 091/140] scale temperature T and dtdt in physics rather than in dp_coupling so that dtcore and other diagnostics reflect the temperature increment in dynamics --- src/dynamics/mpas/dp_coupling.F90 | 85 ++++++++++++++++----------- src/dynamics/mpas/dycore_budget.F90 | 37 ++++++++++-- src/dynamics/se/dp_coupling.F90 | 37 ------------ src/dynamics/se/dycore_budget.F90 | 2 +- src/physics/cam/physpkg.F90 | 90 ++++++++++++++++++----------- src/physics/cam_dev/physpkg.F90 | 82 ++++++++++++++++---------- 6 files changed, 194 insertions(+), 139 deletions(-) diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index e854f8725a..ebc9493199 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -595,63 +595,78 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn zint => dyn_in % zint ux => dyn_in % ux uy => dyn_in % uy - ! - ! Compute q not updated by physics - do m=1,thermodynamic_active_species_num - do iCell = 1, nCellsSolve - do k = 1, pver - idx_thermo(m) = m - idx_dycore = thermodynamic_active_species_idx_dycore(m) - qktmp(iCell,k,m) = tracers(idx_dycore,k,iCell) + if (compute_energy_diags) then + ! + ! Rnew and Rold are only needed for diagnostics purposes + ! + do m=1,thermodynamic_active_species_num + do iCell = 1, nCellsSolve + do k = 1, pver + idx_thermo(m) = m + idx_dycore = thermodynamic_active_species_idx_dycore(m) + qktmp(iCell,k,m) = tracers(idx_dycore,k,iCell) + end do end do end do - end do - call get_R(qktmp,idx_thermo,Rnew) - Rnew = Rnew*cv/Rgas - + call get_R(qktmp,idx_thermo,Rnew) + Rnew = Rnew*cv/Rgas - do m=1,thermodynamic_active_species_num - do iCell = 1, nCellsSolve - do k = 1, pver - idx_thermo(m) = m - idx_dycore = thermodynamic_active_species_idx_dycore(m) - qktmp(iCell,k,m) = tracers(idx_dycore,k,iCell)-& - dtime*q_tend(m,k,iCell) + do m=1,thermodynamic_active_species_num + do iCell = 1, nCellsSolve + do k = 1, pver + idx_thermo(m) = m + idx_dycore = thermodynamic_active_species_idx_dycore(m) + qktmp(iCell,k,m) = tracers(idx_dycore,k,iCell)-& + dtime*q_tend(m,k,iCell) + end do end do end do - end do - call get_R(qktmp,idx_thermo,Rold) - Rold=Rold*cv/Rgas - + call get_R(qktmp,idx_thermo,Rold) + Rold=Rold*cv/Rgas + else + Rnew = 0.0_r8 + Rold = 0.0_r8 + end if + ! + ! Compute q not updated by physics + ! qwv = tracers(index_qv,:,1:nCellsSolve)-dtime*q_tend(index_qv_phys,:,1:nCellsSolve) + ! + ! for energy diagnostics compute state with physics tendency (no water change) first + ! and then add water changes (parameterizations + dme_adjust) + ! do iCell = 1, nCellsSolve do k = 1, pver rhodk = zz(k,iCell) * rho_zz(k,iCell) facold = 1.0_r8 + Rv_over_Rd *qwv(k,iCell) thetak = theta_m(k,iCell)/facold - exnerk = (rgas*rhodk*theta_m(k,iCell)/p0)**(rgas/cv) - tknew = exnerk*thetak+(cp/Rold(iCell,k))*dtime*t_tend(k,icell) - - thetaknew = (tknew**(cv/cp))*((rgas*rhodk*facold)/p0)**(-rgas/cp) + ! + ! for compute_energy_diags only + ! + tknew = exnerk*thetak+(cp/Rold(iCell,k))*(Rnew(iCell,k)/cp)*dtime*t_tend(k,icell)!for diags only + thetaknew = (tknew**(cv/cp))*((rgas*rhodk*facold)/p0)**(-rgas/cp) !for diags only ! ! calculate theta_m tendency due to parameterizations (but no water adjustment) + ! (for diagnostics only) ! - rtheta_param(k,iCell) = (thetaknew-thetak)/dtime - rtheta_param(k,iCell) = rtheta_param(k,iCell)*(1.0_r8 + Rv_over_Rd *qwv(k,iCell)) !convert to thetam - rtheta_param(k,iCell) = rtheta_param(k,iCell)*rho_zz(k,iCell) + rtheta_param(k,iCell) = (thetaknew-thetak)/dtime !for diags only + rtheta_param(k,iCell) = rtheta_param(k,iCell)*(1.0_r8 + Rv_over_Rd *qwv(k,iCell)) !for diags only + !convert to thetam + rtheta_param(k,iCell) = rtheta_param(k,iCell)*rho_zz(k,iCell) !for diags only ! ! include water change in theta_m ! facnew = 1.0_r8 + Rv_over_Rd *tracers(index_qv,k,iCell) - tknew = exnerk*thetak+(cp/Rnew(iCell,k))*dtime*t_tend(k,icell) + tknew = exnerk*thetak+dtime*t_tend(k,icell) thetaknew = (tknew**(cv/cp))*((rgas*rhodk*facnew)/p0)**(-rgas/cp) rtheta_tend(k,iCell) = (thetaknew*facnew-thetak*facold)/dtime rtheta_tend(k,iCell) = rtheta_tend(k,iCell) * rho_zz(k,iCell) end do end do + if (compute_energy_diags) then ! ! compute energy based on parameterization increment (excl. water change) @@ -686,6 +701,11 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn ux(:,1:nCellsSolve)+dtime*u_tend(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve), & uy(:,1:nCellsSolve)+dtime*v_tend(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve),'dAM') end if + ! + ! compute energy based on parameterization increment (excl. water change) + ! + theta_m_new = theta_m(:,1:nCellsSolve)+dtime*rtheta_param(:,1:nCellsSolve)/rho_zz(:,1:nCellsSolve) + ! ! Update halo for rtheta_m tendency ! @@ -799,9 +819,8 @@ subroutine tot_energy_dyn(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_z use air_composition, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_liq_num use air_composition, only: dry_air_species_num, thermodynamic_active_species_R use cam_thermo, only: wvidx,wlidx,wiidx,seidx,poidx,keidx,moidx,mridx,ttidx,teidx,thermo_budget_num_vars + use cam_thermo, only: get_hydrostatic_energy,moidx,mridx,ttidx, thermo_budget_vars use dyn_tests_utils, only: vcoord=>vc_height - use cam_thermo, only: get_hydrostatic_energy,wvidx,wlidx,wiidx,seidx,poidx,keidx,moidx,mridx,ttidx,teidx, & - thermo_budget_num_vars,thermo_budget_vars use cam_history_support, only: max_fieldname_len ! Arguments integer, intent(in) :: nCells diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index 7838e96b09..e84c0fc559 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -8,6 +8,8 @@ module dycore_budget real(r8), save :: previous_dEdt_adiabatic_dycore = 0.0_r8 real(r8), save :: previous_dEdt_dry_mass_adjust = 0.0_r8 real(r8), save :: previous_dEdt_phys_dyn_coupl_err = 0.0_r8 +real(r8), save :: previous_E_bf = 0.0_r8!xxx +real(r8), save :: previous_dEdt_phys_total_dynE = 0.0_r8!xxx !========================================================================================= contains !========================================================================================= @@ -105,7 +107,7 @@ subroutine print_budget(hstwr) call budget_get_global('dyBP-dyBF',idx(i),dEdt_efix_dynE(i)) call budget_get_global('dyAM-dyAP',idx(i),dEdt_dme_adjust_dynE(i)) call budget_get_global('dyAP-dyBF',idx(i),dEdt_param_efix_dynE(i)) - call budget_get_global('dyAM-dyBF',idx(i),dEdt_phys_total_dynE(i))!xxx + call budget_get_global('dyAM-dyBF',idx(i),dEdt_phys_total_dynE(i)) call budget_get_global('dyBF' ,idx(i),E_dyBF(i))!state beginning physics ! ! CAM physics energy tendencies in dynamical core @@ -117,7 +119,6 @@ subroutine print_budget(hstwr) call budget_get_global('dAM-dBF',idx(i),dEdt_phys_total_in_dyn(i)) call budget_get_global('dBF' ,idx(i),E_dBF(i)) !state passed to physics end do - write(iulog,*)" " write(iulog,*)"======================================================================" write(iulog,*)"Total energy diagnostics introduced in Lauritzen and Williamson (2019)" @@ -197,6 +198,15 @@ subroutine print_budget(hstwr) write(iulog,fmt)"dE/dt dry mass adjustment (xxAM-xxAP) ",str(i)," ",dEdt_dme_adjust_physE(i)," ",dEdt_dme_adjust_dynE(i)," ",diff end do write(iulog,*)" " + write(iulog,*)"Compare to dry mass adjustment in dynamics (xx=d,dy):" + write(iulog,*) " xx=d xx=dy diff" + write(iulog,*) " ----- ----- ----" + do i=1,4 + diff = abs_diff(dEdt_dme_adjust_in_dyn(i),dEdt_dme_adjust_dynE(i),pf=pf) + write(iulog,fmt)"dE/dt dry mass adjustment (xxAM-xxAP) ",str(i)," ",dEdt_dme_adjust_in_dyn(i),& + " ",dEdt_dme_adjust_dynE(i)," ",diff,pf + end do + write(iulog,*)" " write(iulog,*)" " ! ! these diagnostics only make sense time-step to time-step @@ -227,6 +237,20 @@ subroutine print_budget(hstwr) ! call endrun(subname//"Error in energy fixer budget") end if dEdt_dycore_phys = -dEdt_efix_dynE(1)-previous_dEdt_phys_dyn_coupl_err-previous_dEdt_dry_mass_adjust + + write(iulog,*) " " + write(iulog,*) "xxx " + write(iulog,*) " " + + tmp = (E_dyBF(1)-previous_E_bf)/1800.0_r8!-previous_dEdt_phys_total_dynE + write(iulog,*) "Dycore: ",tmp + write(iulog,*) "Phys total:" ,previous_dEdt_phys_total_dynE + write(iulog,*) "Residual: ",previous_dEdt_phys_total_dynE-tmp + write(iulog,*) " " + write(iulog,*) "xxx " + write(iulog,*) " " + + write(iulog,*) "Hence the dycore E dissipation estimated from energy fixer " write(iulog,'(A39,F6.2,A6)') "based on previous time-step values is ",dEdt_dycore_phys," W/M^2" write(iulog,*) " " @@ -259,13 +283,15 @@ subroutine print_budget(hstwr) write(iulog,*)" " write(iulog,*)"-------------------------------------------------------------------------" - write(iulog,*)" Consistency check 2: total energy increment in dynamics same as physics?" + write(iulog,*)" Consistency check 2: total energy increment on dynamics decomposition " + write(iulog,*)" on an A-grid (physics grid) the as physics increment (also on A-grid)?" + write(iulog,*)" (note that wind tendencies are mapped to C-grid in MPAS dycore" write(iulog,*)"-------------------------------------------------------------------------" write(iulog,*)" " previous_dEdt_phys_dyn_coupl_err = dEdt_phys_total_in_dyn(1)-dEdt_phys_total_dynE(1) diff = abs_diff(dEdt_phys_total_dynE(1),dEdt_phys_total_in_dyn(1),pf=pf) - write(iulog,'(A40,E8.2,A7,A4)')"dE/dt physics-dynamics coupling errors ",diff," W/M^2 ",pf + write(iulog,'(A41,E8.2,A7,A5)')" dE/dt physics-dynamics coupling errors ",diff," W/M^2 ",pf write(iulog,*)" " if (abs(diff)>eps) then do i=1,4 @@ -371,6 +397,9 @@ subroutine print_budget(hstwr) ! previous_dEdt_adiabatic_dycore = dEdt_dycore_phys previous_dEdt_dry_mass_adjust = dEdt_dme_adjust_dynE(1) + + previous_E_bf = E_dyBF(1) !xxx + previous_dEdt_phys_total_dynE = dEdt_phys_total_dynE(1)!xxx end if end subroutine print_budget !========================================================================================= diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index 08b8bd8098..6d0b05a510 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -379,7 +379,6 @@ subroutine p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_qdp) end do end do end do - call thermodynamic_consistency(phys_state(lchnk), phys_tend(lchnk), ncols, pver, lchnk) end do call t_startf('pd_copy') @@ -712,40 +711,4 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) end do ! lchnk end subroutine derived_phys_dry - -!========================================================================================= - -subroutine thermodynamic_consistency(phys_state, phys_tend, ncols, pver, lchnk) - ! - ! Adjust the physics temperature tendency for thermal energy consistency with the - ! dynamics. - ! Note: mixing ratios are assumed to be dry. - ! - use dimensions_mod, only: lcp_moist - use air_composition, only: get_cp - use control_mod, only: phys_dyn_cp - use air_composition, only: cpairv - - type(physics_state), intent(in) :: phys_state - type(physics_tend ), intent(inout) :: phys_tend - integer, intent(in) :: ncols, pver, lchnk - - real(r8):: inv_cp(ncols,pver) - !---------------------------------------------------------------------------- - - if (lcp_moist.and.phys_dyn_cp==1) then - ! - ! scale temperature tendency so that thermal energy increment from physics - ! matches SE (not taking into account dme adjust) - ! - ! note that if lcp_moist=.false. then there is thermal energy increment - ! consistency (not taking into account dme adjust) - ! - call get_cp(phys_state%q(1:ncols,1:pver,:), .true.,inv_cp, cpdry=cpairv(1:ncols,:,lchnk)) - phys_tend%dtdt(1:ncols,1:pver) = phys_tend%dtdt(1:ncols,1:pver) * cpairv(1:ncols,1:pver,lchnk) * inv_cp - end if -end subroutine thermodynamic_consistency - -!========================================================================================= - end module dp_coupling diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index 358b7a9169..296d7461c6 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -3,7 +3,7 @@ module dycore_budget implicit none public :: print_budget -real(r8), parameter :: eps = 1.0E-9_r8 +real(r8), parameter :: eps = 1.0E-7_r8 real(r8), parameter :: eps_mass = 1.0E-12_r8 real(r8), save :: previous_dEdt_adiabatic_dycore = 0.0_r8 diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index f4b3f07361..ae7ed24509 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -1393,6 +1393,8 @@ subroutine tphysac (ztodt, cam_in, & use lunar_tides, only: lunar_tides_tend use cam_thermo, only: cam_thermo_water_update use budgets, only: thermo_budget_history + use dyn_tests_utils, only: vc_dycore, vc_height, vc_dry_pressure + use air_composition, only: cpairv, cp_or_cv_dycore ! ! Arguments ! @@ -1429,6 +1431,7 @@ subroutine tphysac (ztodt, cam_in, & real(r8) :: tmp_trac (pcols,pver,pcnst) ! tmp space real(r8) :: tmp_pdel (pcols,pver) ! tmp space real(r8) :: tmp_ps (pcols) ! tmp space + real(r8) :: scaling(pcols,pver) logical :: moist_mixing_ratio_dycore ! physics buffer fields for total energy and mass adjustment @@ -1849,7 +1852,9 @@ subroutine tphysac (ztodt, cam_in, & !-------------- Energy budget checks vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv ! Save total energy for global fixer in next timestep - + ! + ! This call must be after the last parameterization and call to physics_update + ! call pbuf_set_field(pbuf, teout_idx, state%te_cur(:,dyn_te_idx), (/1,itim_old/),(/pcols,1/)) if (shallow_scheme .eq. 'UNICON') then @@ -1868,56 +1873,73 @@ subroutine tphysac (ztodt, cam_in, & call unicon_cam_org_diags(state, pbuf) end if + ! + ! FV: convert dry-type mixing ratios to moist here because physics_dme_adjust + ! assumes moist. This is done in p_d_coupling for other dynamics. Bundy, Feb 2004. moist_mixing_ratio_dycore = dycore_is('LR').or. dycore_is('FV3') ! - ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. - ! So, save off tracers + ! update cp/cv for energy computation based in updated water variables ! - if (.not.moist_mixing_ratio_dycore.and.thermo_budget_history) then - tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) - tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver) - tmp_ps(:ncol) = state%ps(:ncol) + call cam_thermo_water_update(state%q(:ncol,:,:), lchnk, ncol, vc_dycore,& + to_dry_factor=state%pdel(:ncol,:)/state%pdeldry(:ncol,:)) + ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. + ! So, save off tracers + if (.not.moist_mixing_ratio_dycore) then + ! + ! for dry-mixing ratio based dycores dme_adjust takes place in the dynamical core + ! + ! only compute dme_adjust for diagnostics purposes + ! + if (thermo_budget_history) then + tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) + tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver) + tmp_ps(:ncol) = state%ps(:ncol) + call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) + call tot_energy_phys(state, 'phAM') + call tot_energy_phys(state, 'dyAM', vc=vc_dycore) + ! Restore pre-"physics_dme_adjust" tracers + state%q(:ncol,:pver,:pcnst) = tmp_trac(:ncol,:pver,:pcnst) + state%pdel(:ncol,:pver) = tmp_pdel(:ncol,:pver) + state%ps(:ncol) = tmp_ps(:ncol) + end if + else + ! + ! for moist-mixing ratio based dycores + ! + ! Note: this operation will NOT be reverted with set_wet_to_dry after set_dry_to_wet call + ! call set_dry_to_wet(state) - call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) - ! update cp/cv for energy computation based in updated water variables - call cam_thermo_water_update(state%q(:ncol,:,:), lchnk, ncol, vc_dycore, & - to_dry_factor=state%pdel(:ncol,:)/state%pdeldry(:ncol,:)) - call tot_energy_phys(state, 'phAM') - call tot_energy_phys(state, 'dyAM', vc=vc_dycore) - ! Restore pre-"physics_dme_adjust" tracers - state%q(:ncol,:pver,:pcnst) = tmp_trac(:ncol,:pver,:pcnst) - state%pdel(:ncol,:pver) = tmp_pdel(:ncol,:pver) - state%ps(:ncol) = tmp_ps(:ncol) - end if - if (moist_mixing_ratio_dycore) then - ! - ! FV: convert dry-type mixing ratios to moist here because physics_dme_adjust - ! assumes moist. This is done in p_d_coupling for other dynamics. Bundy, Feb 2004. - call set_dry_to_wet(state) ! Physics had dry, dynamics wants moist if (trim(cam_take_snapshot_before) == "physics_dme_adjust") then - call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& + call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat) end if - call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) - if (thermo_budget_history) then - call cam_thermo_water_update(state%q(:ncol,:,:), lchnk, ncol, vc_dycore, & - to_dry_factor=state%pdel(:ncol,:)/state%pdeldry(:ncol,:)) - end if if (trim(cam_take_snapshot_after) == "physics_dme_adjust") then - call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& - fh2o, surfric, obklen, flx_heat) + call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat) end if call tot_energy_phys(state, 'phAM') call tot_energy_phys(state, 'dyAM', vc=vc_dycore) - endif -!!! REMOVE THIS CALL, SINCE ONLY Q IS BEING ADJUSTED. WON'T BALANCE ENERGY. TE IS SAVED BEFORE THIS -!!! call check_energy_chng(state, tend, "drymass", nstep, ztodt, zero, zero, zero, zero) + if (vc_dycore == vc_height.or.vc_dycore == vc_dry_pressure) then + ! + ! MPAS and SE specific scaling of temperature for enforcing energy consistency + ! (and to make sure that temperature dependent diagnostic tendencies + ! are computed correctly; e.g. dtcore) + ! + scaling(1:ncol,:) = cpairv(:ncol,:,lchnk)/cp_or_cv_dycore(:ncol,:,lchnk) + state%T(1:ncol,:) = state%temp_ini(1:ncol,:)+& + scaling(1:ncol,:)*(state%T(1:ncol,:)-state%temp_ini(1:ncol,:)) + tend%dtdt(:ncol,:) = scaling(:ncol,:)*tend%dtdt(:ncol,:) + ! + ! else: do nothing for dycores with energy consistent with CAM physics + ! + end if + ! store T, U, and V in buffer for use in computing dynamics T-tendency in next timestep do k = 1,pver diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index c8c348afb8..b6b17f85cf 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -1362,6 +1362,8 @@ subroutine tphysac (ztodt, cam_in, & use dyn_tests_utils, only: vc_dycore use cam_thermo, only: cam_thermo_water_update use budgets, only: thermo_budget_history + use dyn_tests_utils, only: vc_dycore, vc_height, vc_dry_pressure + use air_composition, only: cpairv, cp_or_cv_dycore ! ! Arguments ! @@ -1450,6 +1452,7 @@ subroutine tphysac (ztodt, cam_in, & real(r8) :: tmp_trac (pcols,pver,pcnst) ! tmp space real(r8) :: tmp_pdel (pcols,pver) ! tmp space real(r8) :: tmp_ps (pcols) ! tmp space + real(r8) :: scaling(pcols,pver) logical :: moist_mixing_ratio_dycore ! physics buffer fields for total energy and mass adjustment @@ -2306,58 +2309,77 @@ subroutine tphysac (ztodt, cam_in, & !-------------- Energy budget checks vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv ! Save total energy for global fixer in next timestep + ! + ! This call must be after the last parameterization and call to physics_update + ! call pbuf_set_field(pbuf, teout_idx, state%te_cur(:,dyn_te_idx), (/1,itim_old/),(/pcols,1/)) ! ! FV: convert dry-type mixing ratios to moist here because physics_dme_adjust ! assumes moist. This is done in p_d_coupling for other dynamics. Bundy, Feb 2004. moist_mixing_ratio_dycore = dycore_is('LR').or. dycore_is('FV3') + ! + ! update cp/cv for energy computation based in updated water variables + ! + call cam_thermo_water_update(state%q(:ncol,:,:), lchnk, ncol, vc_dycore,& + to_dry_factor=state%pdel(:ncol,:)/state%pdeldry(:ncol,:)) + ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. ! So, save off tracers - if (.not.moist_mixing_ratio_dycore.and.thermo_budget_history) then - tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) - tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver) - tmp_ps(:ncol) = state%ps(:ncol) - - call set_dry_to_wet(state) - call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) - ! update cp/cv for energy computation based in updated water variables - call cam_thermo_water_update(state%q(:ncol,:,:), lchnk, ncol, vc_dycore,& - to_dry_factor=state%pdel(:ncol,:)/state%pdeldry(:ncol,:)) - - call tot_energy_phys(state, 'phAM') - call tot_energy_phys(state, 'dyAM', vc=vc_dycore) - ! Restore pre-"physics_dme_adjust" tracers - state%q(:ncol,:pver,:pcnst) = tmp_trac(:ncol,:pver,:pcnst) - state%pdel(:ncol,:pver) = tmp_pdel(:ncol,:pver) - state%ps(:ncol) = tmp_ps(:ncol) - end if - - if (moist_mixing_ratio_dycore) then - ! Physics had dry, dynamics wants moist + if (.not.moist_mixing_ratio_dycore) then + ! + ! for dry-mixing ratio based dycores dme_adjust takes place in the dynamical core + ! + ! only compute dme_adjust for diagnostics purposes + ! + if (thermo_budget_history) then + tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) + tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver) + tmp_ps(:ncol) = state%ps(:ncol) + call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) + call tot_energy_phys(state, 'phAM') + call tot_energy_phys(state, 'dyAM', vc=vc_dycore) + ! Restore pre-"physics_dme_adjust" tracers + state%q(:ncol,:pver,:pcnst) = tmp_trac(:ncol,:pver,:pcnst) + state%pdel(:ncol,:pver) = tmp_pdel(:ncol,:pver) + state%ps(:ncol) = tmp_ps(:ncol) + end if + else + ! + ! for moist-mixing ratio based dycores + ! ! Note: this operation will NOT be reverted with set_wet_to_dry after set_dry_to_wet call + ! call set_dry_to_wet(state) - if (trim(cam_take_snapshot_before) == "physics_dme_adjust") then call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) end if call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) - if (thermo_budget_history) then - call cam_thermo_water_update(state%q(:ncol,:,:), lchnk, ncol, vc_dycore, & - to_dry_factor=state%pdel(:ncol,:)/state%pdeldry(:ncol,:)) - end if if (trim(cam_take_snapshot_after) == "physics_dme_adjust") then - call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& - fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) + call cam_snapshot_all_outfld_tphysac(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf,& + fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) end if call tot_energy_phys(state, 'phAM') call tot_energy_phys(state, 'dyAM', vc=vc_dycore) endif -!!! REMOVE THIS CALL, SINCE ONLY Q IS BEING ADJUSTED. WON'T BALANCE ENERGY. TE IS SAVED BEFORE THIS -!!! call check_energy_chng(state, tend, "drymass", nstep, ztodt, zero, zero, zero, zero) + if (vc_dycore == vc_height.or.vc_dycore == vc_dry_pressure) then + ! + ! MPAS and SE specific scaling of temperature for enforcing energy consistency + ! (and to make sure that temperature dependent diagnostic tendencies + ! are computed correctly; e.g. dtcore) + ! + scaling(1:ncol,:) = cpairv(:ncol,:,lchnk)/cp_or_cv_dycore(:ncol,:,lchnk) + state%T(1:ncol,:) = state%temp_ini(1:ncol,:)+& + scaling(1:ncol,:)*(state%T(1:ncol,:)-state%temp_ini(1:ncol,:)) + tend%dtdt(:ncol,:) = scaling(:ncol,:)*tend%dtdt(:ncol,:) + ! + ! else: do nothing for dycores with energy consistent with CAM physics + ! + end if + ! store T, U, and V in buffer for use in computing dynamics T-tendency in next timestep do k = 1,pver From ecba35f76dccd3fc14bc1904f720bbccabd1d96e Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 7 Apr 2023 13:11:41 -0600 Subject: [PATCH 092/140] simple physics support for previous commit: "scale temperature T and dtdt in physics rather than in dp_coupling so that dtcore and other diagnostics reflect the temperature increment in dynamics" --- src/physics/simple/physpkg.F90 | 74 ++++++++++++++++++++++------------ 1 file changed, 48 insertions(+), 26 deletions(-) diff --git a/src/physics/simple/physpkg.F90 b/src/physics/simple/physpkg.F90 index 93cb3c530a..f09a11a05f 100644 --- a/src/physics/simple/physpkg.F90 +++ b/src/physics/simple/physpkg.F90 @@ -476,6 +476,9 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) use check_energy, only: tot_energy_phys use cam_history, only: hist_fld_active use cam_thermo, only: cam_thermo_water_update + use budgets, only: thermo_budget_history + use dyn_tests_utils, only: vc_dycore, vc_height, vc_dry_pressure + use air_composition, only: cpairv, cp_or_cv_dycore ! Arguments ! real(r8), intent(in) :: ztodt ! Two times model timestep (2 delta-t) @@ -508,6 +511,7 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) real(r8) :: tmp_trac (pcols,pver,pcnst) ! tmp space real(r8) :: tmp_pdel (pcols,pver) ! tmp space real(r8) :: tmp_ps (pcols) ! tmp space + real(r8) :: scaling(pcols,pver) !-------------------------------------------------------------------------- ! number of active atmospheric columns @@ -555,9 +559,11 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) ! other dynamics. Bundy, Feb 2004. ! moist_mixing_ratio_dycore = dycore_is('LR').or. dycore_is('FV3') - if (moist_physics .and. moist_mixing_ratio_dycore) then - call set_dry_to_wet(state) ! Physics had dry, dynamics wants moist - end if + ! + ! update cp/cv for energy computation based in updated water variables + ! + call cam_thermo_water_update(state%q(:ncol,:,:), lchnk, ncol, vc_dycore,& + to_dry_factor=state%pdel(:ncol,:)/state%pdeldry(:ncol,:)) if (moist_physics) then ! Scale dry mass and energy (does nothing if dycore is EUL or SLD) @@ -574,37 +580,53 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) else tmp_cldice(:ncol,:pver) = 0.0_r8 end if - - ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. + ! + ! for dry mixing ratio dycore, physics_dme_adjust is called for energy diagnostic purposes only. ! So, save off tracers if (.not.moist_mixing_ratio_dycore) then - tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) - tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver) - tmp_ps(:ncol) = state%ps(:ncol) ! - ! pint, lnpint,rpdel are altered by dme_adjust but not used for tendencies in dynamics of SE - ! we do not reset them to pre-dme_adjust values + ! for dry-mixing ratio based dycores dme_adjust takes place in the dynamical core + ! + ! only compute dme_adjust for diagnostics purposes + ! + if (thermo_budget_history) then + tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) + tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver) + tmp_ps(:ncol) = state%ps(:ncol) + call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) + call tot_energy_phys(state, 'phAM') + call tot_energy_phys(state, 'dyAM', vc=vc_dycore) + ! Restore pre-"physics_dme_adjust" tracers + state%q(:ncol,:pver,:pcnst) = tmp_trac(:ncol,:pver,:pcnst) + state%pdel(:ncol,:pver) = tmp_pdel(:ncol,:pver) + state%ps(:ncol) = tmp_ps(:ncol) + end if + else + ! + ! for moist-mixing ratio based dycores + ! + ! Note: this operation will NOT be reverted with set_wet_to_dry after set_dry_to_wet call ! call set_dry_to_wet(state) - call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) - ! update cp/cv for energy computation based in updated water variables - call cam_thermo_water_update(state%q(:ncol,:,:), lchnk, ncol, vc_dycore, & - to_dry_factor=state%pdel(:ncol,:)/state%pdeldry(:ncol,:)) call tot_energy_phys(state, 'phAM') - call tot_energy_phys(state, 'dyAM',vc=vc_dycore) - ! Restore pre-"physics_dme_adjust" tracers - state%q(:ncol,:pver,:pcnst) = tmp_trac(:ncol,:pver,:pcnst) - state%pdel(:ncol,:pver) = tmp_pdel(:ncol,:pver) - state%ps(:ncol) = tmp_ps(:ncol) - end if - - if (moist_mixing_ratio_dycore) then - call physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) - call tot_energy_phys(state, 'phAM') - call tot_energy_phys(state, 'dyAM',vc=vc_dycore) + call tot_energy_phys(state, 'dyAM', vc=vc_dycore) + endif + if (vc_dycore == vc_height.or.vc_dycore == vc_dry_pressure) then + ! + ! MPAS and SE specific scaling of temperature for enforcing energy consistency + ! (and to make sure that temperature dependent diagnostic tendencies + ! are computed correctly; e.g. dtcore) + ! + scaling(1:ncol,:) = cpairv(:ncol,:,lchnk)/cp_or_cv_dycore(:ncol,:,lchnk) + state%T(1:ncol,:) = state%temp_ini(1:ncol,:)+& + scaling(1:ncol,:)*(state%T(1:ncol,:)-state%temp_ini(1:ncol,:)) + tend%dtdt(:ncol,:) = scaling(:ncol,:)*tend%dtdt(:ncol,:) + ! + ! else: do nothing for dycores with energy consistent with CAM physics + ! end if - + else tmp_q (:ncol,:pver) = 0.0_r8 tmp_cldliq(:ncol,:pver) = 0.0_r8 From 763a8ec8a28aecefdd2539172f9d6af6703dbf31 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 7 Apr 2023 14:17:06 -0600 Subject: [PATCH 093/140] remove se_phys_dyn_cp and se_cp_moist namelist vars and associated variables in code (no longer needed) --- bld/build-namelist | 2 - bld/namelist_files/namelist_defaults_cam.xml | 4 -- bld/namelist_files/namelist_definition.xml | 21 -------- src/dynamics/se/dycore/control_mod.F90 | 3 -- src/dynamics/se/dycore/dimensions_mod.F90 | 9 +--- src/dynamics/se/dycore/prim_advance_mod.F90 | 27 +++------- src/dynamics/se/dycore/prim_advection_mod.F90 | 54 ++++++++----------- src/dynamics/se/dyn_comp.F90 | 13 +---- 8 files changed, 33 insertions(+), 100 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 20cdfebe6c..3d5da9f0cc 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3858,7 +3858,6 @@ if ($dyn =~ /se/) { my @vars = qw( se_ftype se_horz_num_threads - se_lcp_moist se_large_Courant_incr se_hypervis_subcycle se_hypervis_subcycle_sponge @@ -3886,7 +3885,6 @@ if ($dyn =~ /se/) { se_fvm_supercycling_jet se_kmin_jet se_kmax_jet - se_phys_dyn_cp se_molecular_diff ); diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 8781b0c628..d780ba80b6 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2966,8 +2966,6 @@ 2 - .true. - .true. 3.22D0 @@ -2995,8 +2993,6 @@ 1.0e99 1.9 -1 - -1 5.e15 diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 31f5838fed..c97909810e 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -7685,16 +7685,6 @@ Number of dynamics steps per physics timestep. Default: Set by build-namelist. - -Scaling of temperature increment for different levels of -thermal energy consistency. -0: no scaling -1: scale increment for cp consistency between dynamics and physics -2: do 1 as well as take into account condensate effect on thermal energy -Default: Set by build-namelist. - - Hyperviscosity coefficient for u,v, T [m^4/s]. @@ -7760,17 +7750,6 @@ If < 0, se_sponge_del4_lev is automatically set based on model top location. Default: Set by build-namelist. - -If TRUE the continous equations the dynamical core is based on will conserve a -comprehensive moist total energy -If FALSE the continous equations the dynamical core is based on will conserve -a total energy based on cp for dry air and no condensates (same total energy as -CAM physics uses). -For more details see Lauritzen et al., (2018;DOI:10.1029/2017MS001257) -Default: TRUE - - If TRUE the CSLAM algorithm will work for Courant number larger than 1 with diff --git a/src/dynamics/se/dycore/control_mod.F90 b/src/dynamics/se/dycore/control_mod.F90 index 0ecc2079d5..4c1127c45b 100644 --- a/src/dynamics/se/dycore/control_mod.F90 +++ b/src/dynamics/se/dycore/control_mod.F90 @@ -23,9 +23,6 @@ module control_mod ! every rsplit tracer timesteps logical, public :: variable_nsplit=.false. - integer, public :: phys_dyn_cp = 1 !=0; no thermal energy scaling of T increment - !=1; scale increment for cp consistency between dynamics and physics - logical, public :: refined_mesh integer, public :: vert_remap_q_alg = 10 diff --git a/src/dynamics/se/dycore/dimensions_mod.F90 b/src/dynamics/se/dycore/dimensions_mod.F90 index 8a41ea30c3..5f528b47b2 100644 --- a/src/dynamics/se/dycore/dimensions_mod.F90 +++ b/src/dynamics/se/dycore/dimensions_mod.F90 @@ -31,14 +31,7 @@ module dimensions_mod ! character(len=16), allocatable, public :: cnst_name_gll(:) ! constituent names for SE tracers character(len=128), allocatable, public :: cnst_longname_gll(:) ! long name of SE tracers - ! - !moist cp in energy conversion term - ! - ! .false.: force dycore to use cpd (cp dry) instead of moist cp - ! .true. : use moist cp in dycore - ! - logical , public :: lcp_moist = .true. - + integer, parameter, public :: np = NP integer, parameter, public :: nc = 3 !cslam resolution integer , public :: fv_nphys !physics-grid resolution - the "MAX" is so that the code compiles with NC=0 diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index 3e5d5e873e..9a5977e6e1 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -54,7 +54,6 @@ subroutine prim_advance_exp(elem, fvm, deriv, hvcoord, hybrid,dt, tl, nets, net use hybvcoord_mod, only: hvcoord_t use hybrid_mod, only: hybrid_t use time_mod, only: TimeLevel_t, timelevel_qdp, tevolve - use dimensions_mod, only: lcp_moist use fvm_control_volume_mod, only: fvm_struct use cam_thermo, only: get_kappa_dry use air_composition, only: thermodynamic_active_species_num @@ -128,16 +127,10 @@ subroutine prim_advance_exp(elem, fvm, deriv, hvcoord, hybrid,dt, tl, nets, net ! ! compute Cp and kappa=Rdry/cpdry here and not in RK-stages since Q stays constant ! - if (lcp_moist) then - do ie=nets,nete - call get_cp(qwater(:,:,:,:,ie),.true.,& - inv_cp_full(:,:,:,ie), active_species_idx_dycore=qidx) - end do - else - do ie=nets,nete - inv_cp_full(:,:,:,ie) = 1.0_r8/cpair - end do - end if + do ie=nets,nete + call get_cp(qwater(:,:,:,:,ie),.true.,& + inv_cp_full(:,:,:,ie), active_species_idx_dycore=qidx) + end do do ie=nets,nete call get_kappa_dry(qwater(:,:,:,:,ie), qidx, kappa(:,:,:,ie)) end do @@ -1443,7 +1436,7 @@ subroutine distribute_flux_at_corners(cflux, corners, getmapP) end subroutine distribute_flux_at_corners subroutine tot_energy_dyn(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suffix) - use dimensions_mod, only: npsq,nlev,np,lcp_moist,nc,ntrac,qsize + use dimensions_mod, only: npsq,nlev,np,nc,ntrac,qsize use physconst, only: gravit, cpair, rearth, omega use element_mod, only: element_t use cam_history, only: outfld @@ -1527,13 +1520,9 @@ subroutine tot_energy_dyn(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suffix) qidx(nq) = nq end do do ie=nets,nete - if (lcp_moist) then - call get_cp(elem(ie)%state%Qdp(:,:,:,1:qsize,tl_qdp),& - .false., cp, factor=1.0_r8/elem(ie)%state%dp3d(:,:,:,tl),& - active_species_idx_dycore=thermodynamic_active_species_idx_dycore) - else - cp = cpair - end if + call get_cp(elem(ie)%state%Qdp(:,:,:,1:qsize,tl_qdp),& + .false., cp, factor=1.0_r8/elem(ie)%state%dp3d(:,:,:,tl),& + active_species_idx_dycore=thermodynamic_active_species_idx_dycore) ptop = hyai(1)*ps0 do j=1,np !get mixing ratio of thermodynamic active species only diff --git a/src/dynamics/se/dycore/prim_advection_mod.F90 b/src/dynamics/se/dycore/prim_advection_mod.F90 index 0391762cb5..7c54abc2cd 100644 --- a/src/dynamics/se/dycore/prim_advection_mod.F90 +++ b/src/dynamics/se/dycore/prim_advection_mod.F90 @@ -949,7 +949,7 @@ subroutine vertical_remap(hybrid,elem,fvm,hvcoord,np1,np1_qdp,nets,nete) use hybrid_mod, only: hybrid_t, config_thread_region,get_loop_ranges, PrintHybrid use fvm_control_volume_mod, only: fvm_struct use dimensions_mod, only: ntrac - use dimensions_mod, only: lcp_moist, kord_tr,kord_tr_cslam + use dimensions_mod, only: kord_tr,kord_tr_cslam use cam_logfile, only: iulog use physconst, only: pi use air_composition, only: thermodynamic_active_species_idx_dycore @@ -965,7 +965,7 @@ subroutine vertical_remap(hybrid,elem,fvm,hvcoord,np1,np1_qdp,nets,nete) type (hvcoord_t) :: hvcoord integer :: ie,i,j,k,np1,nets,nete,np1_qdp,q, m_cnst real (kind=r8), dimension(np,np,nlev) :: dp_moist,dp_star_moist, dp_dry,dp_star_dry - real (kind=r8), dimension(np,np,nlev) :: internal_energy_star + real (kind=r8), dimension(np,np,nlev) :: enthalpy_star real (kind=r8), dimension(np,np,nlev,2):: ttmp real(r8), parameter :: rad2deg = 180.0_r8/pi integer :: region_num_threads,qbeg,qend,kord_uvT(1) @@ -980,22 +980,20 @@ subroutine vertical_remap(hybrid,elem,fvm,hvcoord,np1,np1_qdp,nets,nete) ! prepare for mapping of temperature ! if (vert_remap_uvTq_alg>-20) then - if (lcp_moist) then - ! - ! compute internal energy on Lagrangian levels - ! (do it here since qdp is overwritten by remap1) - ! - call get_enthalpy(elem(ie)%state%qdp(:,:,:,1:qsize,np1_qdp), & - elem(ie)%state%t(:,:,:,np1), elem(ie)%state%dp3d(:,:,:,np1), internal_energy_star, & - active_species_idx_dycore=thermodynamic_active_species_idx_dycore) - end if + ! + ! compute enthalpy on Lagrangian levels + ! (do it here since qdp is overwritten by remap1) + ! + call get_enthalpy(elem(ie)%state%qdp(:,:,:,1:qsize,np1_qdp), & + elem(ie)%state%t(:,:,:,np1), elem(ie)%state%dp3d(:,:,:,np1), enthalpy_star, & + active_species_idx_dycore=thermodynamic_active_species_idx_dycore) else ! ! map Tv over log(p) following FV and FV3 ! - call get_virtual_temp(elem(ie)%state%qdp(:,:,:,1:qsize,np1_qdp), internal_energy_star, & + call get_virtual_temp(elem(ie)%state%qdp(:,:,:,1:qsize,np1_qdp), enthalpy_star, & dp_dry=elem(ie)%state%dp3d(:,:,:,np1), active_species_idx_dycore=thermodynamic_active_species_idx_dycore) - internal_energy_star = internal_energy_star*elem(ie)%state%t(:,:,:,np1) + enthalpy_star = enthalpy_star*elem(ie)%state%t(:,:,:,np1) end if ! ! update final psdry @@ -1048,34 +1046,28 @@ subroutine vertical_remap(hybrid,elem,fvm,hvcoord,np1,np1_qdp,nets,nete) ! if (vert_remap_uvTq_alg>-20) then ! - ! remap internal energy and back out temperature + ! remap enthalpy energy and back out temperature ! - if (lcp_moist) then - call remap1(internal_energy_star,np,1,1,1,dp_star_dry,dp_dry,ptop,1,.true.,kord_uvT) - ! - ! compute sum c^(l)_p*m^(l)*dp on arrival (Eulerian) grid - ! - ttmp(:,:,:,1) = 1.0_r8 - call get_enthalpy(elem(ie)%state%qdp(:,:,:,1:qsize,np1_qdp), & - ttmp(:,:,:,1), dp_dry,ttmp(:,:,:,2), & - active_species_idx_dycore=thermodynamic_active_species_idx_dycore) - elem(ie)%state%t(:,:,:,np1)=internal_energy_star/ttmp(:,:,:,2) - else - internal_energy_star(:,:,:)=elem(ie)%state%t(:,:,:,np1)*dp_star_moist - call remap1(internal_energy_star,np,1,1,1,dp_star_moist,dp_moist,ptop,1,.true.,kord_uvT) - elem(ie)%state%t(:,:,:,np1)=internal_energy_star/dp_moist - end if + call remap1(enthalpy_star,np,1,1,1,dp_star_dry,dp_dry,ptop,1,.true.,kord_uvT) + ! + ! compute sum c^(l)_p*m^(l)*dp on arrival (Eulerian) grid + ! + ttmp(:,:,:,1) = 1.0_r8 + call get_enthalpy(elem(ie)%state%qdp(:,:,:,1:qsize,np1_qdp), & + ttmp(:,:,:,1), dp_dry,ttmp(:,:,:,2), & + active_species_idx_dycore=thermodynamic_active_species_idx_dycore) + elem(ie)%state%t(:,:,:,np1)=enthalpy_star/ttmp(:,:,:,2) else ! ! map Tv over log(p); following FV and FV3 ! - call remap1(internal_energy_star,np,1,1,1,dp_star_moist,dp_moist,ptop,1,.false.,kord_uvT) + call remap1(enthalpy_star,np,1,1,1,dp_star_moist,dp_moist,ptop,1,.false.,kord_uvT) call get_virtual_temp(elem(ie)%state%qdp(:,:,:,1:qsize,np1_qdp), ttmp(:,:,:,1), & dp_dry=dp_dry, active_species_idx_dycore=thermodynamic_active_species_idx_dycore) ! ! convert new Tv to T ! - elem(ie)%state%t(:,:,:,np1)=internal_energy_star/ttmp(:,:,:,1) + elem(ie)%state%t(:,:,:,np1)=enthalpy_star/ttmp(:,:,:,1) end if ! ! remap velocity components diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index d28a4a2afe..77c2d8a6dd 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -106,13 +106,12 @@ subroutine dyn_readnl(NLFileName) use control_mod, only: vert_remap_uvTq_alg, vert_remap_tracer_alg use control_mod, only: tstep_type, rk_stage_user use control_mod, only: ftype, limiter_option, partmethod - use control_mod, only: topology, phys_dyn_cp, variable_nsplit + use control_mod, only: topology, variable_nsplit use control_mod, only: fine_ne, hypervis_power, hypervis_scaling use control_mod, only: max_hypervis_courant, statediag_numtrac,refined_mesh use control_mod, only: molecular_diff use control_mod, only: sponge_del4_nu_div_fac, sponge_del4_nu_fac, sponge_del4_lev use dimensions_mod, only: ne, npart - use dimensions_mod, only: lcp_moist use dimensions_mod, only: large_Courant_incr use dimensions_mod, only: fvm_supercycling, fvm_supercycling_jet use dimensions_mod, only: kmin_jet, kmax_jet @@ -160,14 +159,12 @@ subroutine dyn_readnl(NLFileName) integer :: se_horz_num_threads integer :: se_vert_num_threads integer :: se_tracer_num_threads - logical :: se_lcp_moist logical :: se_write_restart_unstruct logical :: se_large_Courant_incr integer :: se_fvm_supercycling integer :: se_fvm_supercycling_jet integer :: se_kmin_jet integer :: se_kmax_jet - integer :: se_phys_dyn_cp real(r8) :: se_molecular_diff namelist /dyn_se_inparm/ & @@ -207,14 +204,12 @@ subroutine dyn_readnl(NLFileName) se_horz_num_threads, & se_vert_num_threads, & se_tracer_num_threads, & - se_lcp_moist, & se_write_restart_unstruct, & se_large_Courant_incr, & se_fvm_supercycling, & se_fvm_supercycling_jet, & se_kmin_jet, & se_kmax_jet, & - se_phys_dyn_cp, & se_molecular_diff !-------------------------------------------------------------------------- @@ -282,14 +277,12 @@ subroutine dyn_readnl(NLFileName) call MPI_bcast(se_horz_num_threads, 1, MPI_integer, masterprocid, mpicom,ierr) call MPI_bcast(se_vert_num_threads, 1, MPI_integer, masterprocid, mpicom,ierr) call MPI_bcast(se_tracer_num_threads, 1, MPI_integer, masterprocid, mpicom,ierr) - call MPI_bcast(se_lcp_moist, 1, mpi_logical, masterprocid, mpicom, ierr) call MPI_bcast(se_write_restart_unstruct, 1, mpi_logical, masterprocid, mpicom, ierr) call MPI_bcast(se_large_Courant_incr, 1, mpi_logical, masterprocid, mpicom, ierr) call MPI_bcast(se_fvm_supercycling, 1, mpi_integer, masterprocid, mpicom, ierr) call MPI_bcast(se_fvm_supercycling_jet, 1, mpi_integer, masterprocid, mpicom, ierr) call MPI_bcast(se_kmin_jet, 1, mpi_integer, masterprocid, mpicom, ierr) call MPI_bcast(se_kmax_jet, 1, mpi_integer, masterprocid, mpicom, ierr) - call MPI_bcast(se_phys_dyn_cp, 1, mpi_integer, masterprocid, mpicom, ierr) call MPI_bcast(se_molecular_diff, 1, mpi_real8, masterprocid, mpicom, ierr) if (se_npes <= 0) then @@ -351,14 +344,12 @@ subroutine dyn_readnl(NLFileName) vert_remap_uvTq_alg = set_vert_remap(se_vert_remap_T, se_vert_remap_uvTq_alg) vert_remap_tracer_alg = set_vert_remap(se_vert_remap_T, se_vert_remap_tracer_alg) fv_nphys = se_fv_nphys - lcp_moist = se_lcp_moist large_Courant_incr = se_large_Courant_incr fvm_supercycling = se_fvm_supercycling fvm_supercycling_jet = se_fvm_supercycling_jet kmin_jet = se_kmin_jet kmax_jet = se_kmax_jet variable_nsplit = .false. - phys_dyn_cp = se_phys_dyn_cp molecular_diff = se_molecular_diff if (fv_nphys > 0) then @@ -429,7 +420,6 @@ subroutine dyn_readnl(NLFileName) end if write(iulog, '(a,i0)') 'dyn_readnl: se_npes = ',se_npes write(iulog, '(a,i0)') 'dyn_readnl: se_nsplit = ',se_nsplit - write(iulog, '(a,i0)') 'dyn_readnl: se_phys_dyn_cp = ',se_phys_dyn_cp ! ! se_nu<0 then coefficients are set automatically in module global_norms_mod ! @@ -449,7 +439,6 @@ subroutine dyn_readnl(NLFileName) write(iulog, '(a,a)') 'dyn_readnl: se_vert_remap_T = ',trim(se_vert_remap_T) write(iulog, '(a,a)') 'dyn_readnl: se_vert_remap_uvTq_alg = ',trim(se_vert_remap_uvTq_alg) write(iulog, '(a,a)') 'dyn_readnl: se_vert_remap_tracer_alg = ',trim(se_vert_remap_tracer_alg) - write(iulog, '(a,l4)') 'dyn_readnl: lcp_moist = ',lcp_moist write(iulog, '(a,i0)') 'dyn_readnl: se_fvm_supercycling = ',fvm_supercycling write(iulog, '(a,i0)') 'dyn_readnl: se_fvm_supercycling_jet = ',fvm_supercycling_jet write(iulog, '(a,i0)') 'dyn_readnl: se_kmin_jet = ',kmin_jet From c47eb47f7f466e9a2165a7bd77e42b0e08fc12cb Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 7 Apr 2023 14:18:56 -0600 Subject: [PATCH 094/140] fix initialization bug (from Truesdale) for simple physics energy budgets --- src/physics/simple/physpkg.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/physics/simple/physpkg.F90 b/src/physics/simple/physpkg.F90 index f09a11a05f..a461245a2a 100644 --- a/src/physics/simple/physpkg.F90 +++ b/src/physics/simple/physpkg.F90 @@ -202,6 +202,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use phys_debug_util, only: phys_debug_init use qneg_module, only: qneg_init use cam_snapshot, only: cam_snapshot_init + use budgets, only: budget_init ! Input/output arguments type(physics_state), pointer :: phys_state(:) @@ -271,6 +272,9 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! Initialize the snapshot capability call cam_snapshot_init(cam_in, cam_out, pbuf2d, begchunk) + ! Initialize energy budgets + call budget_init() + end subroutine phys_init !====================================================================================== From 7d2db5bb399fbd73c263822156e3614527e722d7 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 7 Apr 2023 14:23:49 -0600 Subject: [PATCH 095/140] clarify differences in MPAS log file messages --- src/dynamics/mpas/dycore_budget.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index e84c0fc559..f961495967 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -163,7 +163,8 @@ subroutine print_budget(hstwr) write(iulog,*)"variables." write(iulog,*)" " write(iulog,*)" " - write(iulog,*)"FYI: all difference (diff) below are absolute normalized differences" + write(iulog,*)"FYI : norm. diff = absolute normalized difference" + write(iulog,*)"FYI2: diff = difference (not normalized)" write(iulog,*)" " write(iulog,*)" " write(iulog,*)"Consistency check 0:" @@ -199,8 +200,8 @@ subroutine print_budget(hstwr) end do write(iulog,*)" " write(iulog,*)"Compare to dry mass adjustment in dynamics (xx=d,dy):" - write(iulog,*) " xx=d xx=dy diff" - write(iulog,*) " ----- ----- ----" + write(iulog,*) " xx=d xx=dy norm. diff" + write(iulog,*) " ----- ----- ----------" do i=1,4 diff = abs_diff(dEdt_dme_adjust_in_dyn(i),dEdt_dme_adjust_dynE(i),pf=pf) write(iulog,fmt)"dE/dt dry mass adjustment (xxAM-xxAP) ",str(i)," ",dEdt_dme_adjust_in_dyn(i),& From e39ca76851ea5d881308be13cab4bf091082d0dc Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Sun, 9 Apr 2023 23:59:30 -0600 Subject: [PATCH 096/140] update ChangeLog for PR, bug fix for MPAS, added thermo_budget_debug to put out all budget variables --- bld/namelist_files/namelist_definition.xml | 8 +++++++- doc/ChangeLog | 18 ++++++++++++++++ src/control/budgets.F90 | 24 +++++++++++++--------- src/dynamics/mpas/dp_coupling.F90 | 2 +- src/utils/cam_grid_support.F90 | 4 ++++ 5 files changed, 44 insertions(+), 12 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index c97909810e..7675c0d318 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -5072,7 +5072,13 @@ Default: 1 -Produce output for the AMWG diagnostic package. +Produce output for the thermo budget. +Default: .false. + + + +Produce full output for the diagnostic package. Default: .false. diff --git a/doc/ChangeLog b/doc/ChangeLog index fd3a1453ab..0575cc9cce 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -96,6 +96,9 @@ List all existing files that have been modified, and describe the changes: M Externals.cfg - update to include ctsm tag supporting MPAS defaults + M bld/build_namelist + - Add se_lcp_moist and se_phys_dyn_cp namelist flags + M namelist_defaults_cam.xml - new mpas initial data default for mpasa120 aquaplanet. - update cam_dev defaults to add Graupel constituent. @@ -170,11 +173,23 @@ List all existing files that have been modified, and describe the changes: M se/global_norms_mod.F90 - new interface for calculating both elem and fvm global integrals (fvm added) + M se/dycore/control_mod.F90 + - thermal energy scaling of T + + M se/dycore/dimensions_mod.F90 + - get rid of lcp_moist now namelist variable + M se/dycore/prim_advance_mod.F90 - science updates to close energy budget - refactor energy calc routine. - new hydrostatic energy routine with potential energy now split out from SE + M se/dycore/prim_advection_mod.F90 + - refactor for enthalpy ... internal energy to enthalpy + + M se/dycore/prim_driver_mod.F90 + - rename routine to calculate total energy + M se/dycore_budget.F90 - Routine for printing SE energy/mass budgets @@ -185,6 +200,9 @@ List all existing files that have been modified, and describe the changes: - register area weights for se grids - call budget_add for all SE energy/mass budget fields. + M se/dyn_grid.F90 + - consistent naming of routine that calculates total energy + M infrastructure/phys_grid.F90 - register area weights for physic grid - call budget_add for all SE energy/mass budget fields. diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index e5e589ad32..b4ecd8a2a6 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -19,7 +19,7 @@ module budgets use cam_history_support, only: max_fieldname_len,ptapes use cam_logfile, only: iulog use cam_thermo, only: thermo_budget_vars, thermo_budget_vars_descriptor, & - thermo_budget_vars_unit, thermo_budget_vars_massv, thermo_budget_num_vars + thermo_budget_vars_unit, thermo_budget_vars_massv, thermo_budget_num_vars,teidx,wvidx,wlidx,wiidx use shr_kind_mod, only: r8 => shr_kind_r8 use spmd_utils, only: masterproc, masterprocid, mpicom @@ -51,6 +51,7 @@ module budgets integer, public :: thermo_budget_histfile_num = 1 logical, public :: thermo_budget_history = .false. + logical, public :: thermo_budget_debug = .false. real(r8), private :: dstepsize ! ! Constants for each budget @@ -77,7 +78,6 @@ subroutine e_m_snapshot (name, pkgtype, longname, cslam) character (len=128) :: errmsg character (len=max_fieldname_len) :: str1 character (len=128) :: str2, str3 - logical :: thermo_budget_hist logical :: cslamtr ! using cslam transport for mass tracers integer :: ivars character(len=*), parameter :: sub='e_m_snapshot' @@ -90,7 +90,6 @@ subroutine e_m_snapshot (name, pkgtype, longname, cslam) cslamtr = .false. end if do ivars=1, thermo_budget_num_vars - write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(name)) write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & TRIM(ADJUSTL(longname)) @@ -120,12 +119,16 @@ subroutine e_m_snapshot (name, pkgtype, longname, cslam) end if else if (dycore_is('MPAS')) then call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='mpas_cell') + else if (dycore_is('EUL')) then + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='gauss_grid') + else if (dycore_is('FV')) then + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='fv_centers') else - call endrun(sub//'budget_add is only supported for MPAS and SE dycores') - call endrun(errmsg) + call endrun(sub//'unknown dycore type ') end if end if - call add_default(TRIM(ADJUSTL(str1)), thermo_budget_histfile_num, 'N') + if (thermo_budget_debug .or. ivars==teidx .or. ivars==wvidx.or. ivars==wlidx.or. ivars==wiidx) & + call add_default(TRIM(ADJUSTL(str1)), thermo_budget_histfile_num, 'N') end do end if end subroutine e_m_snapshot @@ -170,7 +173,6 @@ subroutine e_m_budget (name, stg1name, stg2name, pkgtype, optype, longname, csla ! register history budget variables do ivars=1, thermo_budget_num_vars - write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(name)) write(strstg1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stg1name)) write(strstg2,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stg2name)) @@ -178,7 +180,6 @@ subroutine e_m_budget (name, stg1name, stg2name, pkgtype, optype, longname, csla TRIM(ADJUSTL(longname)) write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) - budget_num = budget_num + 1 budget_pkgtype(budget_num)=pkgtype @@ -220,7 +221,8 @@ subroutine e_m_budget (name, stg1name, stg2name, pkgtype, optype, longname, csla call endrun(errmsg) end if end if - call add_default(TRIM(ADJUSTL(str1)), thermo_budget_histfile_num, 'N') + if (thermo_budget_debug .or. ivars==teidx .or. ivars==wvidx.or. ivars==wlidx.or. ivars==wiidx) & + call add_default(TRIM(ADJUSTL(str1)), thermo_budget_histfile_num, 'N') end do end if end subroutine e_m_budget @@ -370,7 +372,7 @@ subroutine budget_readnl(nlfile) integer :: unitn, ierr character(len=*), parameter :: subname = 'budget_readnl :: ' - namelist /thermo_budget_nl/ thermo_budget_history, thermo_budget_histfile_num + namelist /thermo_budget_nl/ thermo_budget_history, thermo_budget_histfile_num, thermo_budget_debug !----------------------------------------------------------------------- if (masterproc) then @@ -388,6 +390,8 @@ subroutine budget_readnl(nlfile) ! Broadcast namelist variables call mpi_bcast(thermo_budget_history , 1 , mpi_logical , masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_history") + call mpi_bcast(thermo_budget_debug , 1 , mpi_logical , masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_debug") call mpi_bcast(thermo_budget_histfile_num , 1 , mpi_integer , masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_histfile_num") diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index ebc9493199..90e3e7c9a4 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -626,7 +626,7 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn Rold=Rold*cv/Rgas else Rnew = 0.0_r8 - Rold = 0.0_r8 + Rold = 1.0_r8 end if ! ! Compute q not updated by physics diff --git a/src/utils/cam_grid_support.F90 b/src/utils/cam_grid_support.F90 index d3f8b0a12c..f56571a808 100644 --- a/src/utils/cam_grid_support.F90 +++ b/src/utils/cam_grid_support.F90 @@ -1636,6 +1636,10 @@ function cam_grid_get_areawt(id) result(wtvals) select case(cam_grids(gridind)%name) case('GLL') wtname='area_weight_gll' + case('EUL') + wtname='gw' + case('FV') + wtname='gw' case('INI') wtname='area_weight_ini' case('physgrid') From 623058ec6ef2c48674924ba7b0d6f9504ba4b2e9 Mon Sep 17 00:00:00 2001 From: PeterHjortLauritzen Date: Mon, 10 Apr 2023 15:05:29 -0600 Subject: [PATCH 097/140] fix failing sub-column test --- src/physics/cam/check_energy.F90 | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 65a66a985e..3ecf148cb8 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -366,16 +366,16 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & real(r8) :: scaling(state%psetcols,pver) ! scaling for conversion of temperature increment real(r8) :: temp(state%ncol,pver) ! temperature - real(r8) :: se(pcols) ! enthalpy or internal energy (J/m2) - real(r8) :: po(pcols) ! surface potential or potential energy (J/m2) - real(r8) :: ke(pcols) ! kinetic energy (J/m2) - real(r8) :: wv(pcols) ! column integrated vapor (kg/m2) - real(r8) :: liq(pcols) ! column integrated liquid (kg/m2) - real(r8) :: ice(pcols) ! column integrated ice (kg/m2) + real(r8) :: se(state%ncol) ! enthalpy or internal energy (J/m2) + real(r8) :: po(state%ncol) ! surface potential or potential energy (J/m2) + real(r8) :: ke(state%ncol) ! kinetic energy (J/m2) + real(r8) :: wv(state%ncol) ! column integrated vapor (kg/m2) + real(r8) :: liq(state%ncol) ! column integrated liquid (kg/m2) + real(r8) :: ice(state%ncol) ! column integrated ice (kg/m2) integer lchnk ! chunk identifier integer ncol ! number of atmospheric columns - integer i ! column + integer i ! column index !----------------------------------------------------------------------- lchnk = state%lchnk @@ -390,7 +390,8 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & cp_or_cv(:,:) = cpair else call endrun('check_energy_chng: cpairv is not allowed to vary when subcolumns are turned on') - end if + end if + call get_hydrostatic_energy(state%q(1:ncol,1:pver,1:pcnst),.true., & state%pdel(1:ncol,1:pver), cp_or_cv(1:ncol,1:pver), & state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), state%T(1:ncol,1:pver), & From d1a8ff3e362e9f65c0b0773c58f821bb5a932591 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Mon, 10 Apr 2023 17:18:41 -0600 Subject: [PATCH 098/140] new namelist defaults for water_species - based primarily on microphysics and then physics package --- bld/namelist_files/namelist_defaults_cam.xml | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 83e0a6cf34..2d98fcd35a 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2864,14 +2864,16 @@ '' 'O', 'O2', 'H', 'N2' -'Q' -'Q','CLDLIQ','RAINQM' -'Q','CLDLIQ','CLDICE' -'Q','CLDLIQ','CLDICE' -'Q','CLDLIQ','CLDICE' -'Q','CLDLIQ','CLDICE' -'Q','CLDLIQ','CLDICE','RAINQM','SNOWQM' -'Q','CLDLIQ','CLDICE','RAINQM','SNOWQM','GRAUQM' +'Q' +'Q' +'Q' +'Q','CLDLIQ','RAINQM' +'Q','CLDLIQ','CLDICE' +'Q','CLDLIQ','CLDICE' +'Q','CLDLIQ','CLDICE' +'Q','CLDLIQ','CLDICE' +'Q','CLDLIQ','CLDICE','RAINQM','SNOWQM' +'Q','CLDLIQ','CLDICE','RAINQM','SNOWQM','GRAUQM' From c56a5cab21746b5f0f29a53dca654a5d34d12688 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Tue, 11 Apr 2023 15:07:00 -0600 Subject: [PATCH 099/140] allow budgets to be written to files 0-10 --- bld/namelist_files/namelist_definition.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 7675c0d318..9c735c8a84 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -5065,7 +5065,7 @@ Default: 4 m/s + group="thermo_budget_nl" valid_values="1,2,3,4,5,6,7,8,9" > History tape number thermo budget output is written to. Default: 1 From d1c2a8ef7fcef36f0aa7fd0b324c8e0a3c4871c1 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Mon, 17 Apr 2023 17:54:29 -0600 Subject: [PATCH 100/140] PR review updates for Jesse --- bld/namelist_files/namelist_defaults_cam.xml | 1 - bld/namelist_files/namelist_definition.xml | 4 +- src/control/budgets.F90 | 249 +++++++++---------- 3 files changed, 124 insertions(+), 130 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 2d98fcd35a..3444771dae 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -46,7 +46,6 @@ atm/cam/inic/mpas/mpasa480_L32_notopo_coords_c201125.nc atm/cam/inic/mpas/mpasa120_L32_notopo_coords_c201216.nc -atm/cam/inic/mpas/mpasa120_L32_notopo_coords_c201216.nc atm/cam/inic/mpas/mpasa120_L32_topo_coords_c201022.nc atm/cam/inic/mpas/mpasa120_L32_topo_coords_c201022.nc diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 9c735c8a84..643831bf36 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -1741,7 +1741,7 @@ series. Valid values are: B ==> GMT 00:00:00 average I ==> Instantaneous M ==> Minimum - N ==> average over nsteps not nacs + N ==> average over nsteps X ==> Maximum L ==> Local-time S ==> Standard deviation @@ -5072,7 +5072,7 @@ Default: 1 -Produce output for the thermo budget. +Produce output for the energy budget diagnostic package. Default: .false. diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index b4ecd8a2a6..341cd42732 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -16,7 +16,7 @@ module budgets use cam_abortutils, only: endrun use cam_history, only: addfld, add_default, horiz_only - use cam_history_support, only: max_fieldname_len,ptapes + use cam_history_support, only: max_fieldname_len use cam_logfile, only: iulog use cam_thermo, only: thermo_budget_vars, thermo_budget_vars_descriptor, & thermo_budget_vars_unit, thermo_budget_vars_massv, thermo_budget_num_vars,teidx,wvidx,wlidx,wiidx @@ -33,8 +33,8 @@ module budgets e_m_snapshot, &! define a snapshot and add to history buffer e_m_budget, &! define a budget and add to history buffer budget_ind_byname, &! return budget index given name - budget_get_global, &! return budget global - budget_readnl, &! budget_readnl: read cam thermo namelist + budget_get_global, &! get global budget from history buffer + budget_readnl, &! read budget namelist setting is_budget ! return logical if budget_defined @@ -61,6 +61,68 @@ module budgets !============================================================================================== CONTAINS + !============================================================================================== + ! + ! Read namelist variables. + subroutine budget_readnl(nlfile) + use dycore, only: dycore_is + use namelist_utils, only: find_group_name + use spmd_utils, only: mpi_character, mpi_logical, mpi_integer + use shr_string_mod, only: shr_string_toUpper + use string_utils, only: inst2str + + ! Dummy argument: filepath for file containing namelist input + character(len=*), intent(in) :: nlfile + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'budget_readnl :: ' + + namelist /thermo_budget_nl/ thermo_budget_history, thermo_budget_histfile_num, thermo_budget_debug + !----------------------------------------------------------------------- + + if (masterproc) then + open(newunit=unitn, file=trim(nlfile), status='old') + call find_group_name(unitn, 'thermo_budget_nl', status=ierr) + if (ierr == 0) then + read(unitn, thermo_budget_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname//'ERROR reading namelist, thermo_budget_nl, errcode = '//int2str(ierr)) + end if + end if + close(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast(thermo_budget_history , 1 , mpi_logical , masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_history") + call mpi_bcast(thermo_budget_debug , 1 , mpi_logical , masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_debug") + call mpi_bcast(thermo_budget_histfile_num , 1 , mpi_integer , masterprocid, mpicom, ierr) + if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_histfile_num") + + ! Write out thermo_budget options + if (masterproc) then + if (thermo_budget_history) then + if (dycore_is('EUL').or.dycore_is('FV').or.dycore_is('FV3')) then + call endrun(subname//'ERROR thermodynamic budgets not implemented for this dycore') + else + write(iulog,*)'Thermo budgets will be written to the log file and diagnostics saved to history file:',& + thermo_budget_histfile_num + end if + end if + end if + end subroutine budget_readnl + + !============================================================================================== + + subroutine budget_init() + use time_manager, only: get_step_size + + dstepsize=get_step_size() + + end subroutine budget_init + !============================================================================================== subroutine e_m_snapshot (name, pkgtype, longname, cslam) @@ -76,8 +138,8 @@ subroutine e_m_snapshot (name, pkgtype, longname, cslam) cslam ! true => CSLAM used to transport mass tracers character (len=128) :: errmsg - character (len=max_fieldname_len) :: str1 - character (len=128) :: str2, str3 + character (len=max_fieldname_len) :: name_str + character (len=128) :: desc_str, unit_str logical :: cslamtr ! using cslam transport for mass tracers integer :: ivars character(len=*), parameter :: sub='e_m_snapshot' @@ -90,18 +152,18 @@ subroutine e_m_snapshot (name, pkgtype, longname, cslam) cslamtr = .false. end if do ivars=1, thermo_budget_num_vars - write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(name)) - write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & + write(name_str,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(name)) + write(desc_str,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & TRIM(ADJUSTL(longname)) - write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) + write(units_str,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) budget_num = budget_num+1 ! set budget name and constants - budget_name(budget_num) = trim(str1) + budget_name(budget_num) = trim(name_str) if (present(longname)) then - budget_longname(budget_num) = trim(str2) + budget_longname(budget_num) = trim(name_str) else - budget_longname(budget_num) = trim(str1) + budget_longname(budget_num) = trim(desc_str) end if budget_optype(budget_num)='stg' @@ -109,31 +171,30 @@ subroutine e_m_snapshot (name, pkgtype, longname, cslam) budget_stagename(budget_num)= trim(name) if (pkgtype=='phy') then - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='physgrid') + gridname='physgrid' else if (dycore_is('SE')) then if (cslamtr .and. thermo_budget_vars_massv(ivars)) then - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='FVM') + gridname='FVM' else - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='GLL') + gridname='GLL' end if else if (dycore_is('MPAS')) then - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='mpas_cell') - else if (dycore_is('EUL')) then - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='gauss_grid') - else if (dycore_is('FV')) then - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='fv_centers') + gridname='mpas_cell' else - call endrun(sub//'unknown dycore type ') + write(errmsg, *) sub, ': budget_add is only supported for MPAS and SE dycores' + call endrun(errmsg) end if end if + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname=gridname) + if (thermo_budget_debug .or. ivars==teidx .or. ivars==wvidx.or. ivars==wlidx.or. ivars==wiidx) & - call add_default(TRIM(ADJUSTL(str1)), thermo_budget_histfile_num, 'N') + call add_default(TRIM(ADJUSTL(name_str)), thermo_budget_histfile_num, 'N') end do end if end subroutine e_m_snapshot -!!$!============================================================================== + !============================================================================== subroutine e_m_budget (name, stg1name, stg2name, pkgtype, optype, longname, cslam) use dycore, only: dycore_is @@ -148,7 +209,7 @@ subroutine e_m_budget (name, stg1name, stg2name, pkgtype, optype, longname, csla pkgtype ! budget type either phy or dyn character(len=*), intent(in) :: & - optype ! dif (difference) or sum or stg (stage) + optype ! dif (difference) or sum character(len=*), intent(in), optional :: & longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) @@ -159,7 +220,7 @@ subroutine e_m_budget (name, stg1name, stg2name, pkgtype, optype, longname, csla character(len=*), parameter :: sub='e_m_budget' character(len=128) :: errmsg character(len=1) :: opchar - character (len=256) :: str1, str2, str3, strstg1, strstg2 + character (len=256) :: name_str, desc_str, units_str, strstg1, strstg2 integer :: ivars logical :: cslamtr ! using cslam transport for mass tracers !----------------------------------------------------------------------- @@ -173,27 +234,27 @@ subroutine e_m_budget (name, stg1name, stg2name, pkgtype, optype, longname, csla ! register history budget variables do ivars=1, thermo_budget_num_vars - write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(name)) + write(name_str,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(name)) write(strstg1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stg1name)) write(strstg2,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stg2name)) - write(str2,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & + write(desc_str,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & TRIM(ADJUSTL(longname)) - write(str3,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) + write(units_str,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) budget_num = budget_num + 1 budget_pkgtype(budget_num)=pkgtype ! set budget name and constants - budget_name(budget_num) = trim(str1) + budget_name(budget_num) = trim(name_str) if (present(longname)) then - budget_longname(budget_num) = trim(str2) + budget_longname(budget_num) = trim(desc_str) else - budget_longname(budget_num) = trim(str1) + budget_longname(budget_num) = trim(name_str) end if if (optype=='dif') opchar='-' if (optype=='sum') opchar='+' if (optype=='stg') then - write(errmsg,*) sub//': FATAL: bad value optype should be sum of dif:', optype + write(errmsg,*) sub, ': FATAL: bad value optype should be sum of dif:', optype call endrun(errmsg) end if budget_stg1name(budget_num) = trim(adjustl(strstg1)) @@ -202,45 +263,36 @@ subroutine e_m_budget (name, stg1name, stg2name, pkgtype, optype, longname, csla budget_optype(budget_num)=optype if (pkgtype=='phy') then - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & - gridname='physgrid',op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) + gridname='physgrid' else if (dycore_is('SE')) then if (cslamtr .and. thermo_budget_vars_massv(ivars)) then - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & - gridname='FVM',op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) + gridname='FVM' else - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & - gridname='GLL',op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) + gridname='GLL' end if else if (dycore_is('MPAS')) then - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & - gridname='mpas_cell',op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) + gridname='mpas_cell' else - call endrun(sub//'budget_add is only supported for MPAS and SE dycores') + write(errmsg, *) sub, ': budget_add is only supported for MPAS and SE dycores' call endrun(errmsg) end if end if + call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & + gridname=gridname,op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) + if (thermo_budget_debug .or. ivars==teidx .or. ivars==wvidx.or. ivars==wlidx.or. ivars==wiidx) & - call add_default(TRIM(ADJUSTL(str1)), thermo_budget_histfile_num, 'N') + call add_default(TRIM(ADJUSTL(name_str)), thermo_budget_histfile_num, 'N') end do end if end subroutine e_m_budget - !============================================================================================== - - subroutine budget_init() - use time_manager, only: get_step_size - - dstepsize=get_step_size() - - end subroutine budget_init !============================================================================== subroutine budget_get_global (name, me_idx, global) use cam_history, only: get_field_properties - use cam_history_support, only: active_entry + use cam_history_support, only: active_entry,ptapes use cam_thermo, only: thermo_budget_vars_massv ! Get the global integral of a budget. Optional abort argument allows returning @@ -250,11 +302,11 @@ subroutine budget_get_global (name, me_idx, global) !-----------------------------Arguments--------------------------------- character(len=*), intent(in) :: name ! budget name integer, intent(in) :: me_idx ! mass energy variable index - real(r8), intent(out) :: global ! global budget index (in q array) + real(r8), intent(out) :: global ! global integral of the budget field !---------------------------Local workspace----------------------------- type (active_entry), pointer :: tape(:) => null() ! history tapes - character (len=max_fieldname_len) :: str1 + character (len=max_fieldname_len) :: name_str character(len=128) :: errmsg integer :: b_ind ! hentry index integer :: f(ptapes),ff ! hentry index @@ -265,44 +317,40 @@ subroutine budget_get_global (name, me_idx, global) character(len=*), parameter :: sub='budget_get_global' !----------------------------------------------------------------------- - str1='' - write(str1,*) TRIM(ADJUSTL(name)) + name_str='' + write(name_str,*) TRIM(ADJUSTL(name)) - midx=index(str1, '-') - pidx=index(str1, '+') + midx=index(name_str, '-') + pidx=index(name_str, '+') idx=midx+pidx - ! check for budget using stagename short format (stg1//op/stg2) where stg1 is name without thermo string appended + ! check for budget using stagename short format (stg1//op//stg2) where stg1 is name without thermo string appended if (idx /= 0 .and. (midx==0 .or. pidx==0)) then - write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//trim(adjustl(str1(1:idx)))// & - TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//TRIM(ADJUSTL(str1(idx+1:))) + write(name_str,*) TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//trim(adjustl(name_str(1:idx)))// & + TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//TRIM(ADJUSTL(name_str(idx+1:))) end if - uidx=index(str1, '_') + uidx=index(name_str, '_') if (uidx == 0) then !This is a stage name need to append the type of thermo variable using input index - write(str1,*) TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//trim(adjustl(str1(1:))) + write(name_str,*) TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//trim(adjustl(name_str(1:))) end if - b_ind=budget_ind_byname(trim(adjustl(str1))) + b_ind=budget_ind_byname(trim(adjustl(name_str))) - if (b_ind < 0) call endrun(sub//'FATAL field name '//name//' not found'//' looked for '//trim(adjustl(str1))) + if (b_ind < 0) call endrun(sub//': FATAL field name '//name//' not found'//' looked for '//trim(adjustl(name_str))) - write(str1,*) TRIM(ADJUSTL(budget_name(b_ind))) + write(name_str,*) TRIM(ADJUSTL(budget_name(b_ind))) ! Find budget name in list and return global value - call get_field_properties(trim(adjustl(str1)), found, tape_out=tape, ff_out=ff, f_out=f) + call get_field_properties(trim(adjustl(name_str)), found, tape_out=tape, ff_out=ff, f_out=f) if (found.and.f(thermo_budget_histfile_num)>0) then call tape(thermo_budget_histfile_num)%hlist(f(thermo_budget_histfile_num))%get_global(global) - if (.not. thermo_budget_vars_massv(me_idx)) then - write(iulog,*)'scaling ',trim(adjustl(str1)),' by ',dstepsize,' old/new global',global,'/',global/dstepsize - global=global/dstepsize - else - write(iulog,*)'returning ',trim(adjustl(str1)),' global ',global - end if + if (.not. thermo_budget_vars_massv(me_idx)) & + global=global/dstepsize else - write(errmsg,*) sub//': FATAL: name not found: ', trim(name) + write(errmsg,*) sub, ': FATAL: name not found: ', trim(name) call endrun(errmsg) end if @@ -317,7 +365,6 @@ function budget_ind_byname (name) !---------------------------Local workspace----------------------------- integer :: budget_ind_byname ! function return integer :: m ! budget index - character(len=*), parameter :: sub='budget_ind_byname' !----------------------------------------------------------------------- ! Find budget name in list budget_ind_byname = -1 @@ -333,9 +380,7 @@ end function budget_ind_byname function is_budget(name) - ! Get the index of a budget. Optional abort argument allows returning - ! control to caller when budget name is not found. Default behavior is - ! to call endrun when name is not found. + ! Get the index of a budget. !-----------------------------Arguments--------------------------------- character(len=*), intent(in) :: name ! budget name @@ -343,14 +388,13 @@ function is_budget(name) !---------------------------Local workspace----------------------------- logical :: is_budget ! function return integer :: m ! budget index - character(len=*), parameter :: sub='is_budget' !----------------------------------------------------------------------- ! Find budget name in list of defined budgets is_budget = .false. do m = 1, budget_array_max - if (trim(name) == trim(budget_name(m)).or.trim(name) == trim(budget_stagename(m))) then + if (trim(adjustl(name)) == trim(adjustl(budget_name(m))).or.trim(adjustl(name)) == trim(adjustl(budget_stagename(m)))) then is_budget = .true. return end if @@ -358,54 +402,5 @@ function is_budget(name) end function is_budget !=========================================================================== - ! Read namelist variables. - subroutine budget_readnl(nlfile) - use dycore, only: dycore_is - use namelist_utils, only: find_group_name - use spmd_utils, only: mpi_character, mpi_logical, mpi_integer - use shr_string_mod, only: shr_string_toUpper - - ! Dummy argument: filepath for file containing namelist input - character(len=*), intent(in) :: nlfile - - ! Local variables - integer :: unitn, ierr - character(len=*), parameter :: subname = 'budget_readnl :: ' - - namelist /thermo_budget_nl/ thermo_budget_history, thermo_budget_histfile_num, thermo_budget_debug - !----------------------------------------------------------------------- - - if (masterproc) then - open(newunit=unitn, file=trim(nlfile), status='old') - call find_group_name(unitn, 'thermo_budget_nl', status=ierr) - if (ierr == 0) then - read(unitn, thermo_budget_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(subname//'ERROR reading namelist, thermo_budget_nl') - end if - end if - close(unitn) - end if - - ! Broadcast namelist variables - call mpi_bcast(thermo_budget_history , 1 , mpi_logical , masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_history") - call mpi_bcast(thermo_budget_debug , 1 , mpi_logical , masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_debug") - call mpi_bcast(thermo_budget_histfile_num , 1 , mpi_integer , masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_histfile_num") - - ! Write out thermo_budget options - if (masterproc) then - if (thermo_budget_history) then - if (dycore_is('EUL').or.dycore_is('FV').or.dycore_is('FV3')) then - call endrun(subname//'ERROR thermodynamic budgets not implemented for this dycore') - else - write(iulog,*)'Thermo budgets will be written to the log file and diagnostics saved to history file:',& - thermo_budget_histfile_num - end if - end if - end if - end subroutine budget_readnl end module budgets From e9c05293a1f11a375e27b08bbf259a2bf2edb7ed Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Mon, 17 Apr 2023 18:35:01 -0600 Subject: [PATCH 101/140] PR updates for Jesse, continued ... --- src/control/budgets.F90 | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index 341cd42732..ea7406a89f 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -69,7 +69,7 @@ subroutine budget_readnl(nlfile) use namelist_utils, only: find_group_name use spmd_utils, only: mpi_character, mpi_logical, mpi_integer use shr_string_mod, only: shr_string_toUpper - use string_utils, only: inst2str + use string_utils, only: int2str ! Dummy argument: filepath for file containing namelist input character(len=*), intent(in) :: nlfile @@ -139,7 +139,8 @@ subroutine e_m_snapshot (name, pkgtype, longname, cslam) character (len=128) :: errmsg character (len=max_fieldname_len) :: name_str - character (len=128) :: desc_str, unit_str + character (len=128) :: desc_str, units_str + character (len=128) :: gridname logical :: cslamtr ! using cslam transport for mass tracers integer :: ivars character(len=*), parameter :: sub='e_m_snapshot' @@ -186,7 +187,7 @@ subroutine e_m_snapshot (name, pkgtype, longname, cslam) call endrun(errmsg) end if end if - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname=gridname) + call addfld (TRIM(ADJUSTL(name_str)), horiz_only, 'N', TRIM(ADJUSTL(units_str)),TRIM(ADJUSTL(desc_str)),gridname=gridname) if (thermo_budget_debug .or. ivars==teidx .or. ivars==wvidx.or. ivars==wlidx.or. ivars==wiidx) & call add_default(TRIM(ADJUSTL(name_str)), thermo_budget_histfile_num, 'N') @@ -217,12 +218,15 @@ subroutine e_m_budget (name, stg1name, stg2name, pkgtype, optype, longname, csla logical, intent(in), optional :: & cslam ! true => use cslam to transport mass variables - character(len=*), parameter :: sub='e_m_budget' - character(len=128) :: errmsg - character(len=1) :: opchar - character (len=256) :: name_str, desc_str, units_str, strstg1, strstg2 - integer :: ivars - logical :: cslamtr ! using cslam transport for mass tracers + character(len=*), parameter :: sub='e_m_budget' + character(len=128) :: errmsg + character(len=1) :: opchar + character (len=max_fieldname_len) :: name_str + character (len=128) :: desc_str, units_str + character (len=128) :: gridname + character (len=256) :: strstg1, strstg2 + integer :: ivars + logical :: cslamtr ! using cslam transport for mass tracers !----------------------------------------------------------------------- if (thermo_budget_history) then @@ -278,7 +282,7 @@ subroutine e_m_budget (name, stg1name, stg2name, pkgtype, optype, longname, csla call endrun(errmsg) end if end if - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'N', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)), & + call addfld (TRIM(ADJUSTL(name_str)), horiz_only, 'N', TRIM(ADJUSTL(units_str)),TRIM(ADJUSTL(desc_str)), & gridname=gridname,op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) if (thermo_budget_debug .or. ivars==teidx .or. ivars==wvidx.or. ivars==wlidx.or. ivars==wiidx) & From 51af377391f8e528198f74b5c59fb86fbbf874cf Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Wed, 19 Apr 2023 10:31:02 -0600 Subject: [PATCH 102/140] PR comment updates --- Externals.cfg | 4 +- bld/namelist_files/namelist_definition.xml | 7 -- doc/ChangeLog | 7 +- src/control/budgets.F90 | 80 +++++++++------------- src/control/cam_history.F90 | 69 ++++++++++--------- src/control/cam_history_support.F90 | 25 +++---- src/cpl/nuopc/atm_stream_ndep.F90 | 12 +++- 7 files changed, 102 insertions(+), 102 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 9b32826c75..13ddc8f76e 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -79,9 +79,9 @@ externals = Externals_CISM.cfg required = True [clm] -branch = ctsm5.1.dev120_mpasgrids +tag = ctsm5.1.dev120 protocol = git -repo_url = https://github.com/jtruesdal/ctsm +repo_url = https://github.com/ESCOMP/CTSM local_path = components/clm externals = Externals_CLM.cfg required = True diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 643831bf36..7d11589905 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -5076,13 +5076,6 @@ Produce output for the energy budget diagnostic package. Default: .false. - -Produce full output for the diagnostic package. -Default: .false. - - - Produce output for the AMWG diagnostic package. diff --git a/doc/ChangeLog b/doc/ChangeLog index 0575cc9cce..ed3ecc9390 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -11,7 +11,8 @@ Purpose of changes (include the issue number and title text for each relevant Gi Add inline energy/mass budgets support. (#519) Science changes are included that help close the mass and energy budgets of physics and the SE/MPAS dycores (#521) as well as adding all water - constituents to atmospheric mass (pressure) (#520) + constituents to atmospheric mass (pressure) (#520). Lastly, + a bugfix to corectly open an instance version of atm_in (#790). As of this commit energy/mass budgets have been roughed in for physics and the SE and MPAS dycores. Similar to amwg_diagnostic @@ -65,6 +66,7 @@ Purpose of changes (include the issue number and title text for each relevant Gi physics and dynamics to allow snapshots tailored to thermodynamic needs and data structures of those packages. + Describe any changes made to build system: Describe any changes made to the namelist: @@ -250,6 +252,9 @@ List all existing files that have been modified, and describe the changes: M utils/cam_thermo.F90 - energy and mass budget variables and descriptions. + M cpl/nuopc/atm_stream_ndep.F90 + - bug fix to allow opening instance version of atm_in namelist. + 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 diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index ea7406a89f..06fc510b8b 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -21,6 +21,7 @@ module budgets use cam_thermo, only: thermo_budget_vars, thermo_budget_vars_descriptor, & thermo_budget_vars_unit, thermo_budget_vars_massv, thermo_budget_num_vars,teidx,wvidx,wlidx,wiidx use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_kind_mod, only: cl => shr_kind_cl use spmd_utils, only: masterproc, masterprocid, mpicom implicit none @@ -43,15 +44,14 @@ module budgets integer, parameter, public :: budget_array_max = 500 ! number of budget diffs integer, public :: budget_num = 0 ! - character(len=64), public, protected :: budget_name(budget_array_max) ! budget names - character(len=128),public, protected :: budget_longname(budget_array_max) ! long name of budgets - character(len=128),public, protected :: budget_stagename(budget_array_max) ! long name of budgets - character(len=64), public, protected :: budget_stg1name(budget_array_max) - character(len=64), public, protected :: budget_stg2name(budget_array_max) + character(cl), public, protected :: budget_name(budget_array_max) ! budget names + character(cl), public, protected :: budget_longname(budget_array_max) ! long name of budgets + character(cl), public, protected :: budget_stagename(budget_array_max) ! long name of budgets + character(cl), public, protected :: budget_stg1name(budget_array_max) + character(cl), public, protected :: budget_stg2name(budget_array_max) integer, public :: thermo_budget_histfile_num = 1 logical, public :: thermo_budget_history = .false. - logical, public :: thermo_budget_debug = .false. real(r8), private :: dstepsize ! ! Constants for each budget @@ -78,7 +78,7 @@ subroutine budget_readnl(nlfile) integer :: unitn, ierr character(len=*), parameter :: subname = 'budget_readnl :: ' - namelist /thermo_budget_nl/ thermo_budget_history, thermo_budget_histfile_num, thermo_budget_debug + namelist /thermo_budget_nl/ thermo_budget_history, thermo_budget_histfile_num !----------------------------------------------------------------------- if (masterproc) then @@ -96,8 +96,6 @@ subroutine budget_readnl(nlfile) ! Broadcast namelist variables call mpi_bcast(thermo_budget_history , 1 , mpi_logical , masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_history") - call mpi_bcast(thermo_budget_debug , 1 , mpi_logical , masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_debug") call mpi_bcast(thermo_budget_histfile_num , 1 , mpi_integer , masterprocid, mpicom, ierr) if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_histfile_num") @@ -132,15 +130,15 @@ subroutine e_m_snapshot (name, pkgtype, longname, cslam) name ! budget name used as variable name in history file output (8 char max) character(len=*), intent(in) :: & pkgtype ! budget type either phy or dyn - character(len=*), intent(in), optional :: & + character(len=*), intent(in) :: & longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) logical, intent(in), optional :: & cslam ! true => CSLAM used to transport mass tracers - character (len=128) :: errmsg + character (cl) :: errmsg character (len=max_fieldname_len) :: name_str - character (len=128) :: desc_str, units_str - character (len=128) :: gridname + character (cl) :: desc_str, units_str + character (cl) :: gridname logical :: cslamtr ! using cslam transport for mass tracers integer :: ivars character(len=*), parameter :: sub='e_m_snapshot' @@ -161,11 +159,7 @@ subroutine e_m_snapshot (name, pkgtype, longname, cslam) budget_num = budget_num+1 ! set budget name and constants budget_name(budget_num) = trim(name_str) - if (present(longname)) then - budget_longname(budget_num) = trim(name_str) - else - budget_longname(budget_num) = trim(desc_str) - end if + budget_longname(budget_num) = trim(desc_str) budget_optype(budget_num)='stg' budget_pkgtype(budget_num)=pkgtype @@ -188,9 +182,7 @@ subroutine e_m_snapshot (name, pkgtype, longname, cslam) end if end if call addfld (TRIM(ADJUSTL(name_str)), horiz_only, 'N', TRIM(ADJUSTL(units_str)),TRIM(ADJUSTL(desc_str)),gridname=gridname) - - if (thermo_budget_debug .or. ivars==teidx .or. ivars==wvidx.or. ivars==wlidx.or. ivars==wiidx) & - call add_default(TRIM(ADJUSTL(name_str)), thermo_budget_histfile_num, 'N') + call add_default(TRIM(ADJUSTL(name_str)), thermo_budget_histfile_num, 'N') end do end if end subroutine e_m_snapshot @@ -212,19 +204,19 @@ subroutine e_m_budget (name, stg1name, stg2name, pkgtype, optype, longname, csla character(len=*), intent(in) :: & optype ! dif (difference) or sum - character(len=*), intent(in), optional :: & + character(len=*), intent(in) :: & longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) logical, intent(in), optional :: & cslam ! true => use cslam to transport mass variables character(len=*), parameter :: sub='e_m_budget' - character(len=128) :: errmsg + character(cl) :: errmsg character(len=1) :: opchar character (len=max_fieldname_len) :: name_str - character (len=128) :: desc_str, units_str - character (len=128) :: gridname - character (len=256) :: strstg1, strstg2 + character (cl) :: desc_str, units_str + character (cl) :: gridname + character (cl) :: strstg1, strstg2 integer :: ivars logical :: cslamtr ! using cslam transport for mass tracers !----------------------------------------------------------------------- @@ -250,11 +242,8 @@ subroutine e_m_budget (name, stg1name, stg2name, pkgtype, optype, longname, csla ! set budget name and constants budget_name(budget_num) = trim(name_str) - if (present(longname)) then - budget_longname(budget_num) = trim(desc_str) - else - budget_longname(budget_num) = trim(name_str) - end if + budget_longname(budget_num) = trim(desc_str) + if (optype=='dif') opchar='-' if (optype=='sum') opchar='+' if (optype=='stg') then @@ -284,9 +273,7 @@ subroutine e_m_budget (name, stg1name, stg2name, pkgtype, optype, longname, csla end if call addfld (TRIM(ADJUSTL(name_str)), horiz_only, 'N', TRIM(ADJUSTL(units_str)),TRIM(ADJUSTL(desc_str)), & gridname=gridname,op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) - - if (thermo_budget_debug .or. ivars==teidx .or. ivars==wvidx.or. ivars==wlidx.or. ivars==wiidx) & - call add_default(TRIM(ADJUSTL(name_str)), thermo_budget_histfile_num, 'N') + call add_default(TRIM(ADJUSTL(name_str)), thermo_budget_histfile_num, 'N') end do end if end subroutine e_m_budget @@ -299,28 +286,29 @@ subroutine budget_get_global (name, me_idx, global) use cam_history_support, only: active_entry,ptapes use cam_thermo, only: thermo_budget_vars_massv - ! Get the global integral of a budget. Optional abort argument allows returning - ! control to caller when budget name is not found. Default behavior is - ! to call endrun when name is not found. - + ! Get the global integral of a budget. Endrun will be called + ! when name is not found. !-----------------------------Arguments--------------------------------- character(len=*), intent(in) :: name ! budget name integer, intent(in) :: me_idx ! mass energy variable index real(r8), intent(out) :: global ! global integral of the budget field !---------------------------Local workspace----------------------------- - type (active_entry), pointer :: tape(:) => null() ! history tapes + type (active_entry), pointer :: tape(:) ! history tapes character (len=max_fieldname_len) :: name_str - character(len=128) :: errmsg - integer :: b_ind ! hentry index - integer :: f(ptapes),ff ! hentry index + character(cl) :: errmsg + integer :: b_ind ! budget index + integer :: h_ind(ptapes) ! hentry index + integer :: m_ind ! masterlist index integer :: idx,pidx,midx,uidx ! substring index for sum dif char integer :: m ! budget index logical :: found ! true if global integral found character(len=*), parameter :: sub='budget_get_global' !----------------------------------------------------------------------- - + ! Initialize tape pointer here to avoid initialization only on first invocation + nullify(tape) + name_str='' write(name_str,*) TRIM(ADJUSTL(name)) @@ -347,10 +335,10 @@ subroutine budget_get_global (name, me_idx, global) write(name_str,*) TRIM(ADJUSTL(budget_name(b_ind))) ! Find budget name in list and return global value - call get_field_properties(trim(adjustl(name_str)), found, tape_out=tape, ff_out=ff, f_out=f) + call get_field_properties(trim(adjustl(name_str)), found, tape_out=tape, ff_out=m_ind, f_out=h_ind) - if (found.and.f(thermo_budget_histfile_num)>0) then - call tape(thermo_budget_histfile_num)%hlist(f(thermo_budget_histfile_num))%get_global(global) + if (found.and.h_ind(thermo_budget_histfile_num)>0) then + call tape(thermo_budget_histfile_num)%hlist(h_ind(thermo_budget_histfile_num))%get_global(global) if (.not. thermo_budget_vars_massv(me_idx)) & global=global/dstepsize else diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 622573fe86..01ff739a37 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -1,5 +1,4 @@ module cam_history -#define HDEBUG1 FALSE !------------------------------------------------------------------------------------------- ! ! The cam_history module provides the user interface for CAM's history output capabilities. @@ -50,7 +49,8 @@ module cam_history field_info, active_entry, hentry, & horiz_only, write_hist_coord_attrs, & write_hist_coord_vars, interp_info_t, & - lookup_hist_coord_indices, get_hist_coord_index + lookup_hist_coord_indices, get_hist_coord_index, & + field_op_len use string_utils, only: date2yyyymmdd, sec2hms use sat_hist, only: is_satfile use solar_parms_data, only: solar_parms_on, kp=>solar_parms_kp, ap=>solar_parms_ap @@ -70,27 +70,27 @@ module cam_history public :: cam_history_snapshot_activate type grid_area_entry - integer :: decomp_type = -1 ! type of decomposition (e.g., physics or dynamics) - real(r8), allocatable :: wbuf(:,:,:) ! for area weights + integer :: decomp_type = -1 ! type of decomposition (e.g., physics or dynamics) + real(r8), allocatable :: wbuf(:,:,:) ! for area weights end type grid_area_entry - type (grid_area_entry), target, allocatable:: grid_wts(:) ! area wts for each decomp type - type (grid_area_entry), pointer :: allgrids_wt(:) ! area wts for each decomp type + type (grid_area_entry), target, allocatable:: grid_wts(:) ! area wts for each decomp type + type (grid_area_entry), pointer :: allgrids_wt(:) => null() ! area wts for each decomp type ! ! master_entry: elements of an entry in the master field list ! type master_entry - type (field_info) :: field ! field information + type (field_info) :: field ! field information character(len=max_fieldname_len) :: meridional_field = '' ! for vector fields character(len=max_fieldname_len) :: zonal_field = '' ! for vector fields - character(len=1) :: avgflag(ptapes) ! averaging flag - character(len=max_chars) :: time_op(ptapes) ! time operator (e.g. max, min, avg) - character(len=max_chars) :: field_op = '' ! field derived from sum/dif of field1 and field2 - character(len=max_fieldname_len) :: op_field1 = '' ! first field name to be summed/diffed - character(len=max_fieldname_len) :: op_field2 = '' ! second field name to be summed/diffed - logical :: act_sometape ! Field is active on some tape - logical :: actflag(ptapes) ! Per tape active/inactive flag - integer :: htapeindx(ptapes)! This field's index on particular history tape - type(master_entry), pointer :: next_entry => null() ! The next master entry + character(len=1) :: avgflag(ptapes) ! averaging flag + character(len=max_chars) :: time_op(ptapes) ! time operator (e.g. max, min, avg) + character(len=field_op_len) :: field_op = '' ! field derived from sum/dif of field1 and field2 + character(len=max_fieldname_len) :: op_field1 = '' ! first field name to be summed/diffed + character(len=max_fieldname_len) :: op_field2 = '' ! second field name to be summed/diffed + logical :: act_sometape ! Field is active on some tape + logical :: actflag(ptapes) ! Per tape active/inactive flag + integer :: htapeindx(ptapes)! This field's index on particular history tape + type(master_entry), pointer :: next_entry => null() ! The next master entry end type master_entry type (master_entry), pointer :: masterlinkedlist => null() ! master field linkedlist top @@ -485,7 +485,7 @@ subroutine intht (model_doi_url_in) if (tape(t)%hlist(f)%avgflag .eq. 'N') then ! set up areawt weight buffer fdecomp = tape(t)%hlist(f)%field%decomp_type if (any(allgrids_wt(:)%decomp_type == fdecomp)) then - wtidx=MAXLOC(allgrids_wt(:)%decomp_type, MASK = allgrids_wt(:)%decomp_type .EQ. fdecomp) + wtidx=FINDLOC(allgrids_wt(:)%decomp_type, fdecomp) tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf else ! area weights not found for this grid, then create them @@ -1003,16 +1003,19 @@ subroutine define_composed_field_ids(t) tape(t)%hlist(f)%op_field2=trim(field2) ! find ids for field1/2 do ff = 1, nflds(t) - if (trim(field1) == trim(tape(t)%hlist(ff)%field%name)) & - tape(t)%hlist(f)%field%op_field1_id = ff - if (trim(field2) == trim(tape(t)%hlist(ff)%field%name)) & - tape(t)%hlist(f)%field%op_field2_id = ff + if (trim(field1) == trim(tape(t)%hlist(ff)%field%name)) then + tape(t)%hlist(f)%field%op_field1_id = ff + end if + if (trim(field2) == trim(tape(t)%hlist(ff)%field%name)) then + tape(t)%hlist(f)%field%op_field2_id = ff + end if end do - if (tape(t)%hlist(f)%field%op_field1_id == -1) & - call endrun(trim(subname)//': No op_field1 match for '//trim(tape(t)%hlist(f)%field%name)) - if (tape(t)%hlist(f)%field%op_field2_id == -1) & - call endrun(trim(subname)//': No op_field2 match for '//trim(tape(t)%hlist(f)%field%name)) - + if (tape(t)%hlist(f)%field%op_field1_id == -1) then + call endrun(trim(subname)//': No op_field1 match for '//trim(tape(t)%hlist(f)%field%name)) + end if + if (tape(t)%hlist(f)%field%op_field2_id == -1) then + call endrun(trim(subname)//': No op_field2 match for '//trim(tape(t)%hlist(f)%field%name)) + end if else call endrun(trim(subname)//': Component fields not found for composed field') end if @@ -1537,7 +1540,7 @@ subroutine write_restart_history ( File, & integer, allocatable :: interp_output(:) integer :: maxnflds - + real(r8) :: integral ! hbuf area weighted integral maxnflds = maxval(nflds) allocate(xyfill(maxnflds, ptapes)) @@ -1679,7 +1682,8 @@ subroutine write_restart_history ( File, & ierr = pio_put_var(File, numlev_desc,start,tape(t)%hlist(f)%field%numlev) ierr = pio_put_var(File, hwrt_prec_desc,start,tape(t)%hlist(f)%hwrt_prec) - ierr = pio_put_var(File, hbuf_integral_desc,start,tape(t)%hlist(f)%hbuf_integral) + call tape(t)%hlist(f)%get_global(integral) + ierr = pio_put_var(File, hbuf_integral_desc,start,integral) ierr = pio_put_var(File, beg_nstep_desc,start,tape(t)%hlist(f)%beg_nstep) ierr = pio_put_var(File, sseq_desc,startc,tape(t)%hlist(f)%field%sampling_seq) ierr = pio_put_var(File, cm_desc,startc,tape(t)%hlist(f)%field%cell_methods) @@ -2081,8 +2085,8 @@ subroutine read_restart_history (File) tape(t)%hlist(f)%field%decomp_type = decomp(f,t) tape(t)%hlist(f)%field%numlev = tmpnumlev(f,t) tape(t)%hlist(f)%hwrt_prec = tmpprec(f,t) - tape(t)%hlist(f)%hbuf_integral = tmpintegral(f,t) tape(t)%hlist(f)%beg_nstep = tmpbeg_nstep(f,t) + call tape(t)%hlist(f)%put_global(tmpintegral(f,t)) ! If the field is an advected constituent set the mixing_ratio attribute fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) call cnst_get_ind(fname_tmp, idx, abort=.false.) @@ -2101,7 +2105,7 @@ subroutine read_restart_history (File) end if end do end do - deallocate(tmpname, tmpnumlev, tmpprec, tmpbeg_nstep, decomp, xyfill, is_subcol) + deallocate(tmpname, tmpnumlev, tmpprec, tmpbeg_nstep, decomp, xyfill, is_subcol, tmpintegral) deallocate(mdimnames) deallocate(tmpf1name,tmpf2name) @@ -2160,7 +2164,7 @@ subroutine read_restart_history (File) nullify(tape(t)%hlist(f)%wbuf) if (any(allgrids_wt(:)%decomp_type == tape(t)%hlist(f)%field%decomp_type)) then - wtidx=MAXLOC(allgrids_wt(:)%decomp_type, MASK = allgrids_wt(:)%decomp_type .EQ. fdecomp) + wtidx=FINDLOC(allgrids_wt(:)%decomp_type, fdecomp) tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf else ! area weights not found for this grid, then create them @@ -2215,6 +2219,7 @@ subroutine read_restart_history (File) do f = 1, nflds(t) fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) + if(masterproc) write(iulog, *) 'Reading history variable ',fname_tmp ierr = pio_inq_varid(tape(t)%File, fname_tmp, vdesc) call cam_pio_var_info(tape(t)%File, vdesc, ndims, dimids, dimlens) @@ -3045,6 +3050,8 @@ subroutine inifld (t, listentry, avgflag, prec_wrt) write(iulog,'(2a)')' units = ',trim(tape(t)%hlist(n)%field%units) write(iulog,'(a,i0)')' numlev = ',tape(t)%hlist(n)%field%numlev write(iulog,'(2a)')' avgflag = ',tape(t)%hlist(n)%avgflag + write(iulog,'(3a)')' time_op = "',trim(tape(t)%hlist(n)%time_op),'"' + write(iulog,'(a,i0)')' hwrt_prec = ',tape(t)%hlist(n)%hwrt_prec end if #endif diff --git a/src/control/cam_history_support.F90 b/src/control/cam_history_support.F90 index b77a31bcf9..dacb3c554d 100644 --- a/src/control/cam_history_support.F90 +++ b/src/control/cam_history_support.F90 @@ -24,9 +24,10 @@ module cam_history_support integer, parameter, public :: max_string_len = shr_kind_cxx integer, parameter, public :: max_chars = shr_kind_cl ! max chars for char variables - integer, parameter, public :: fieldname_len = 32 ! max chars for field name - integer, parameter, public :: fieldname_suffix_len = 3 ! length of field name suffix ("&IC") - integer, parameter, public :: fieldname_lenp2 = fieldname_len + 2 ! allow for extra characters + integer, parameter, public :: field_op_len = 3 ! max chars for field operation string (sum/dif) + integer, parameter, public :: fieldname_len = 32 ! max chars for field name + integer, parameter, public :: fieldname_suffix_len = 3 ! length of field name suffix ("&IC") + integer, parameter, public :: fieldname_lenp2 = fieldname_len + 2 ! allow for extra characters ! max_fieldname_len = max chars for field name (including suffix) integer, parameter, public :: max_fieldname_len = fieldname_len + fieldname_suffix_len @@ -117,9 +118,9 @@ module cam_history_support integer :: meridional_complement ! meridional field id or -1 integer :: zonal_complement ! zonal field id or -1 - character(len=max_chars) :: field_op = '' ! 'sum' or 'dif' - integer :: op_field1_id ! first field id to be summed/diffed or -1 - integer :: op_field2_id ! second field id to be summed/diffed or -1 + character(len=field_op_len) :: field_op = '' ! 'sum' or 'dif' + integer :: op_field1_id ! first field id to be summed/diffed or -1 + integer :: op_field2_id ! second field id to be summed/diffed or -1 character(len=max_fieldname_len) :: name ! field name character(len=max_chars) :: long_name ! long name @@ -157,21 +158,21 @@ module cam_history_support ! !--------------------------------------------------------------------------- type, public:: hentry - type (field_info) :: field ! field information - character(len=1) :: avgflag ! averaging flag - character(len=max_chars) :: time_op ! time operator (e.g. max, min, avg) + type (field_info) :: field ! field information + character(len=1) :: avgflag ! averaging flag + character(len=max_chars) :: time_op ! time operator (e.g. max, min, avg) character(len=max_fieldname_len) :: op_field1 ! field1 name for sum/dif operation character(len=max_fieldname_len) :: op_field2 ! field2 name for sum/dif operation - integer :: hwrt_prec ! history output precision + integer :: hwrt_prec ! history output precision real(r8), pointer :: hbuf(:,:,:) => NULL() - real(r8) :: hbuf_integral ! area weighted integral of active field + real(r8), private :: hbuf_integral ! area weighted integral of active field real(r8), pointer :: sbuf(:,:,:) => NULL() ! for standard deviation real(r8), pointer :: wbuf(:,:,:) => NULL() ! pointer to area weights type(var_desc_t), pointer :: varid(:) => NULL() ! variable ids integer, pointer :: nacs(:,:) => NULL() ! accumulation counter type(var_desc_t), pointer :: nacs_varid => NULL() - integer :: beg_nstep ! starting time step for nstep normalization + integer :: beg_nstep ! starting time step for nstep normalization type(var_desc_t), pointer :: beg_nstep_varid=> NULL() type(var_desc_t), pointer :: sbuf_varid => NULL() type(var_desc_t), pointer :: wbuf_varid => NULL() diff --git a/src/cpl/nuopc/atm_stream_ndep.F90 b/src/cpl/nuopc/atm_stream_ndep.F90 index 76ae37ec1b..394808a529 100644 --- a/src/cpl/nuopc/atm_stream_ndep.F90 +++ b/src/cpl/nuopc/atm_stream_ndep.F90 @@ -43,8 +43,9 @@ subroutine stream_ndep_init(model_mesh, model_clock, rc) ! Initialize data stream information. ! Uses: - use shr_nl_mod , only : shr_nl_find_group_name - use dshr_strdata_mod , only : shr_strdata_init_from_inline + use cam_instance , only: inst_suffix + use shr_nl_mod , only: shr_nl_find_group_name + use dshr_strdata_mod , only: shr_strdata_init_from_inline ! input/output variables type(ESMF_CLock), intent(in) :: model_clock @@ -56,6 +57,7 @@ subroutine stream_ndep_init(model_mesh, model_clock, rc) integer :: nml_error ! namelist i/o error flag character(len=CL) :: stream_ndep_data_filename character(len=CL) :: stream_ndep_mesh_filename + character(len=CL) :: filein ! atm namelist file integer :: stream_ndep_year_first ! first year in stream to use integer :: stream_ndep_year_last ! last year in stream to use integer :: stream_ndep_year_align ! align stream_year_firstndep with @@ -84,7 +86,11 @@ subroutine stream_ndep_init(model_mesh, model_clock, rc) ! Read ndep_stream namelist if (masterproc) then - open( newunit=nu_nml, file='atm_in', status='old', iostat=nml_error ) + filein = "atm_in" // trim(inst_suffix) + open( newunit=nu_nml, file=trim(filein), status='old', iostat=nml_error ) + if (nml_error /= 0) then + call endrun(subName//': ERROR opening '//trim(filein)//errMsg(sourcefile, __LINE__)) + end if call shr_nl_find_group_name(nu_nml, 'ndep_stream_nl', status=nml_error) if (nml_error == 0) then read(nu_nml, nml=ndep_stream_nl, iostat=nml_error) From b2f90247ae8666223c775b9466719625665d97a3 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Wed, 19 Apr 2023 15:26:46 -0600 Subject: [PATCH 103/140] next tranche of updates for the PR --- src/control/budgets.F90 | 42 +++++++++--------- src/control/cam_history.F90 | 68 +++++++++++++++-------------- src/dynamics/eul/dycore_budget.F90 | 34 ++------------- src/dynamics/fv/dycore_budget.F90 | 34 ++------------- src/dynamics/fv3/dycore_budget.F90 | 34 ++------------- src/dynamics/mpas/dp_coupling.F90 | 14 +++--- src/dynamics/mpas/dycore_budget.F90 | 2 +- src/dynamics/se/dycore_budget.F90 | 5 +-- 8 files changed, 72 insertions(+), 161 deletions(-) diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index 06fc510b8b..48e8504c58 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -33,7 +33,6 @@ module budgets budget_init, &! initialize budget variables e_m_snapshot, &! define a snapshot and add to history buffer e_m_budget, &! define a budget and add to history buffer - budget_ind_byname, &! return budget index given name budget_get_global, &! get global budget from history buffer budget_readnl, &! read budget namelist setting is_budget ! return logical if budget_defined @@ -346,28 +345,27 @@ subroutine budget_get_global (name, me_idx, global) call endrun(errmsg) end if + CONTAINS + function budget_ind_byname (name) + ! + ! Get the index of a budget. Ret -1 for not found + !-----------------------------Arguments--------------------------------- + character(len=*), intent(in) :: name ! budget name + + !---------------------------Local workspace----------------------------- + integer :: budget_ind_byname ! function return + integer :: m ! budget index + !----------------------------------------------------------------------- + ! Find budget name in list + budget_ind_byname = -1 + do m = 1, budget_array_max + if (trim(adjustl(name)) == trim(adjustl(budget_name(m))).or.trim(adjustl(name)) == trim(adjustl(budget_stagename(m)))) then + budget_ind_byname = m + return + end if + end do + end function budget_ind_byname end subroutine budget_get_global - !============================================================================== - function budget_ind_byname (name) - ! - ! Get the index of a budget. Ret -1 for not found - !-----------------------------Arguments--------------------------------- - character(len=*), intent(in) :: name ! budget name - - !---------------------------Local workspace----------------------------- - integer :: budget_ind_byname ! function return - integer :: m ! budget index - !----------------------------------------------------------------------- - ! Find budget name in list - budget_ind_byname = -1 - do m = 1, budget_array_max - if (trim(adjustl(name)) == trim(adjustl(budget_name(m))).or.trim(adjustl(name)) == trim(adjustl(budget_stagename(m)))) then - budget_ind_byname = m - return - end if - end do - end function budget_ind_byname - !============================================================================== function is_budget(name) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 01ff739a37..748b4bdbf0 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -489,7 +489,12 @@ subroutine intht (model_doi_url_in) tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf else ! area weights not found for this grid, then create them - wtidx=MINLOC(allgrids_wt(:)%decomp_type) + ! first check for an available spot in the array + if (any(allgrids_wt(:)%decomp_type == -1)) then + wtidx=MINLOC(allgrids_wt(:)%decomp_type) + else + call endrun('cam_history:intht: Error initializing allgrids_wt with area weights') + end if allgrids_wt(wtidx)%decomp_type=fdecomp areawt => cam_grid_get_areawt(fdecomp) allocate(allgrids_wt(wtidx(1))%wbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) @@ -1929,30 +1934,30 @@ subroutine read_restart_history (File) ierr = pio_inq_varid(File, 'numlev', vdesc) ierr = pio_get_var(File, vdesc, tmpnumlev) - allocate(tmpintegral(maxnflds,mtapes)) ierr = pio_inq_varid(File, 'hbuf_integral',vdesc) + allocate(tmpintegral(maxnflds,mtapes)) ierr = pio_get_var(File, vdesc, tmpintegral(:,:)) - allocate(tmpprec(maxnflds,mtapes)) ierr = pio_inq_varid(File, 'hwrt_prec',vdesc) + allocate(tmpprec(maxnflds,mtapes)) ierr = pio_get_var(File, vdesc, tmpprec(:,:)) - allocate(tmpbeg_nstep(maxnflds,mtapes)) ierr = pio_inq_varid(File, 'beg_nstep',vdesc) + allocate(tmpbeg_nstep(maxnflds,mtapes)) ierr = pio_get_var(File, vdesc, tmpbeg_nstep(:,:)) - allocate(xyfill(maxnflds,mtapes)) ierr = pio_inq_varid(File, 'xyfill', vdesc) + allocate(xyfill(maxnflds,mtapes)) ierr = pio_get_var(File, vdesc, xyfill) - allocate(is_subcol(maxnflds,mtapes)) ierr = pio_inq_varid(File, 'is_subcol', vdesc) + allocate(is_subcol(maxnflds,mtapes)) ierr = pio_get_var(File, vdesc, is_subcol) !! interpolated output - allocate(interp_output(mtapes)) ierr = pio_inq_varid(File, 'interpolate_output', vdesc) + allocate(interp_output(mtapes)) ierr = pio_get_var(File, vdesc, interp_output) interpolate_output(1:mtapes) = interp_output(1:mtapes) > 0 if (ptapes > mtapes) then @@ -2168,7 +2173,12 @@ subroutine read_restart_history (File) tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf else ! area weights not found for this grid, then create them - wtidx=MINLOC(allgrids_wt(:)%decomp_type) + ! first check for an available spot in the array + if (any(allgrids_wt(:)%decomp_type == -1)) then + wtidx=MINLOC(allgrids_wt(:)%decomp_type) + else + call endrun('cam_history.F90:read_restart_history: Error initializing allgrids_wt with area weights') + end if allgrids_wt(wtidx)%decomp_type=fdecomp areawt => cam_grid_get_areawt(fdecomp) allocate(allgrids_wt(wtidx(1))%wbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) @@ -4911,7 +4921,7 @@ subroutine h_normalize (f, t) / nsteps end do else - write(errmsg,*) sub//'FATAL: nstep normalization is bad, currstep,beg_nstep, nsteps=',currstep, tape(t)%hlist(f)%beg_nstep + write(errmsg,*) sub,'FATAL: bad nstep normalization, currstep, beg_nstep, nsteps=',currstep,tape(t)%hlist(f)%beg_nstep call endrun(errmsg) end if end if @@ -5007,17 +5017,14 @@ subroutine h_global (f, t) ! type (dim_index_2d) :: dimind ! 2-D dimension index integer :: ie ! dim3 index - integer :: count ! - integer :: i1 ! - integer :: j1 ! - integer :: fdims(3) ! - integer :: comm_id! + integer :: count ! tmp index + integer :: i1 ! dim1 index + integer :: j1 ! dim2 index + integer :: fdims(3) ! array shape integer :: begdim1,enddim1,begdim2,enddim2,begdim3,enddim3 ! real(r8) :: globalsum(1) ! globalsum real(r8), allocatable :: globalarr(:) ! globalarr values for this pe - - - + call t_startf ('h_global') ! wbuf contains the area weighting for this field decomposition @@ -5054,7 +5061,6 @@ subroutine h_global (f, t) deallocate(globalarr) end if call t_stopf ('h_global') - return end subroutine h_global subroutine h_field_op (f, t) @@ -5088,8 +5094,6 @@ subroutine h_field_op (f, t) begdim3 = tape(t)%hlist(f)%field%begdim3 enddim3 = tape(t)%hlist(f)%field%enddim3 - dimind = tape(t)%hlist(f)%field%get_dims(begdim3) - do c = begdim3, enddim3 dimind = tape(t)%hlist(f)%field%get_dims(c) if (trim(op) == 'dif') then @@ -5101,15 +5105,13 @@ subroutine h_field_op (f, t) tape(t)%hlist(f1)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) + & tape(t)%hlist(f2)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) else - call endrun('dyn_readnl: ERROR: budget_optype unknown:'//trim(op)) + call endrun('h_field_op: ERROR: budget_optype unknown:'//trim(op)) end if end do ! Set nsteps for composed fields using value of one of the component fields tape(t)%hlist(f)%beg_nstep=tape(t)%hlist(f1)%beg_nstep tape(t)%hlist(f)%nacs(:,:)=tape(t)%hlist(f1)%nacs(:,:) call t_stopf ('h_field_op') - - return end subroutine h_field_op !####################################################################### @@ -5585,25 +5587,25 @@ subroutine wshist (rgnht_in) ierr = pio_put_var (tape(t)%File, tape(t)%date_writtenid, startc, countc, (/cdate/)) ierr = pio_put_var (tape(t)%File, tape(t)%time_writtenid, startc, countc, (/ctime/)) - !$OMP PARALLEL DO PRIVATE (F) - do f=1,nflds(t) - if(.not. restart) then + if(.not. restart) then + !$OMP PARALLEL DO PRIVATE (F) + do f=1,nflds(t) ! Normalize all non composed fields, composed fields are calculated next using the normalized components if (tape(t)%hlist(f)%avgflag /= 'I'.and..not.tape(t)%hlist(f)%field%is_composed()) then call h_normalize (f, t) end if - end if - end do + end do + end if - !$OMP PARALLEL DO PRIVATE (F) - do f=1,nflds(t) - if(.not. restart) then + if(.not. restart) then + !$OMP PARALLEL DO PRIVATE (F) + do f=1,nflds(t) ! calculate composed fields from normalized components if (tape(t)%hlist(f)%field%is_composed()) then call h_field_op (f, t) end if - end if - end do + end do + end if ! ! Write field to history tape. Note that this is NOT threaded due to netcdf limitations ! diff --git a/src/dynamics/eul/dycore_budget.F90 b/src/dynamics/eul/dycore_budget.F90 index 23ea684799..36b89880eb 100644 --- a/src/dynamics/eul/dycore_budget.F90 +++ b/src/dynamics/eul/dycore_budget.F90 @@ -1,10 +1,7 @@ module dycore_budget -use shr_kind_mod, only: r8=>shr_kind_r8 implicit none public :: print_budget -real(r8), parameter :: eps = 1.0E-9_r8 -real(r8), parameter :: eps_mass = 1.0E-12_r8 !========================================================================================= contains @@ -14,19 +11,11 @@ subroutine print_budget(hstwr) use spmd_utils, only: masterproc use cam_abortutils, only: endrun - use cam_logfile, only: iulog - use shr_kind_mod, only: r8=>shr_kind_r8 - use budgets, only: budget_get_global, is_budget, thermo_budget_histfile_num, thermo_budget_history - use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv, & - teidx, seidx, keidx, poidx - use cam_thermo, only: teidx, seidx, keidx, poidx - use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv + use budgets, only: thermo_budget_history,thermo_budget_histfile_num ! arguments logical, intent(in) :: hstwr(:) - - ! Local variables - character(len=*), parameter :: subname = 'check_energy:print_budgets' + character(len=*), parameter :: subname = 'dycore_budget:print_budgets' !-------------------------------------------------------------------------------------- @@ -34,22 +23,5 @@ subroutine print_budget(hstwr) call endrun(subname//' is not implemented for the EUL dycore') end if end subroutine print_budget -!========================================================================================= -function abs_diff(a,b,pf) - real(r8), intent(in) :: a,b - character(LEN=5), optional, intent(out):: pf - real(r8) :: abs_diff - if (abs(b)>eps) then - abs_diff = abs((b-a)/b) - else - abs_diff = abs(b-a) - end if - If (present(pf)) then - if (abs_diff>eps) then - pf = ' FAIL' - else - pf = ' PASS' - end if - end if -end function abs_diff + end module dycore_budget diff --git a/src/dynamics/fv/dycore_budget.F90 b/src/dynamics/fv/dycore_budget.F90 index 3414bf519b..78643abab2 100644 --- a/src/dynamics/fv/dycore_budget.F90 +++ b/src/dynamics/fv/dycore_budget.F90 @@ -1,10 +1,7 @@ module dycore_budget -use shr_kind_mod, only: r8=>shr_kind_r8 implicit none public :: print_budget -real(r8), parameter :: eps = 1.0E-9_r8 -real(r8), parameter :: eps_mass = 1.0E-12_r8 !========================================================================================= contains @@ -14,19 +11,11 @@ subroutine print_budget(hstwr) use spmd_utils, only: masterproc use cam_abortutils, only: endrun - use cam_logfile, only: iulog - use shr_kind_mod, only: r8=>shr_kind_r8 - use budgets, only: budget_get_global, is_budget, thermo_budget_histfile_num, thermo_budget_history - use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv, & - teidx, seidx, keidx, poidx - use cam_thermo, only: teidx, seidx, keidx, poidx - use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv + use budgets, only: thermo_budget_histfile_num, thermo_budget_history ! arguments logical, intent(in) :: hstwr(:) - - ! Local variables - character(len=*), parameter :: subname = 'check_energy:print_budgets' + character(len=*), parameter :: subname = 'dycore_budget:print_budgets' !-------------------------------------------------------------------------------------- @@ -34,22 +23,5 @@ subroutine print_budget(hstwr) call endrun(subname//' is not implemented for the FV dycore') end if end subroutine print_budget -!========================================================================================= -function abs_diff(a,b,pf) - real(r8), intent(in) :: a,b - character(LEN=5), optional, intent(out):: pf - real(r8) :: abs_diff - if (abs(b)>eps) then - abs_diff = abs((b-a)/b) - else - abs_diff = abs(b-a) - end if - If (present(pf)) then - if (abs_diff>eps) then - pf = ' FAIL' - else - pf = ' PASS' - end if - end if -end function abs_diff + end module dycore_budget diff --git a/src/dynamics/fv3/dycore_budget.F90 b/src/dynamics/fv3/dycore_budget.F90 index 636f4ca7b3..1ba9bc8509 100644 --- a/src/dynamics/fv3/dycore_budget.F90 +++ b/src/dynamics/fv3/dycore_budget.F90 @@ -1,10 +1,8 @@ module dycore_budget -use shr_kind_mod, only: r8=>shr_kind_r8 + implicit none public :: print_budget -real(r8), parameter :: eps = 1.0E-9_r8 -real(r8), parameter :: eps_mass = 1.0E-12_r8 !========================================================================================= contains @@ -14,19 +12,11 @@ subroutine print_budget(hstwr) use spmd_utils, only: masterproc use cam_abortutils, only: endrun - use cam_logfile, only: iulog - use shr_kind_mod, only: r8=>shr_kind_r8 - use budgets, only: budget_get_global, is_budget, thermo_budget_histfile_num, thermo_budget_history - use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv, & - teidx, seidx, keidx, poidx - use cam_thermo, only: teidx, seidx, keidx, poidx - use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv + use budgets, only: thermo_budget_histfile_num, thermo_budget_history ! arguments logical, intent(in) :: hstwr(:) - - ! Local variables - character(len=*), parameter :: subname = 'check_energy:print_budgets' + character(len=*), parameter :: subname = 'dycore_budget:print_budgets' !-------------------------------------------------------------------------------------- @@ -34,22 +24,4 @@ subroutine print_budget(hstwr) call endrun(subname//' is not implemented for the FV3 dycore') end if end subroutine print_budget -!========================================================================================= -function abs_diff(a,b,pf) - real(r8), intent(in) :: a,b - character(LEN=5), optional, intent(out):: pf - real(r8) :: abs_diff - if (abs(b)>eps) then - abs_diff = abs((b-a)/b) - else - abs_diff = abs(b-a) - end if - If (present(pf)) then - if (abs_diff>eps) then - pf = ' FAIL' - else - pf = ' PASS' - end if - end if -end function abs_diff end module dycore_budget diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index 90e3e7c9a4..a53d1d7f86 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -439,7 +439,7 @@ subroutine derived_phys(phys_state, phys_tend, pbuf2d) zvirv(:,:) = zvir endif ! - ! update cp_dycore in modeule air_composition. + ! update cp_dycore in module air_composition. ! (note: at this point q is dry) ! call cam_thermo_water_update(phys_state(lchnk)%q(1:ncol,:,:), lchnk, ncol, vcoord) @@ -601,11 +601,11 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn ! Rnew and Rold are only needed for diagnostics purposes ! do m=1,thermodynamic_active_species_num + idx_thermo(m) = m + idx_dycore = thermodynamic_active_species_idx_dycore(m) do iCell = 1, nCellsSolve do k = 1, pver - idx_thermo(m) = m - idx_dycore = thermodynamic_active_species_idx_dycore(m) - qktmp(iCell,k,m) = tracers(idx_dycore,k,iCell) + qktmp(iCell,k,m) = tracers(idx_dycore,k,iCell) end do end do end do @@ -613,12 +613,10 @@ subroutine derived_tend(nCellsSolve, nCells, t_tend, u_tend, v_tend, q_tend, dyn Rnew = Rnew*cv/Rgas do m=1,thermodynamic_active_species_num + idx_dycore = thermodynamic_active_species_idx_dycore(m) do iCell = 1, nCellsSolve do k = 1, pver - idx_thermo(m) = m - idx_dycore = thermodynamic_active_species_idx_dycore(m) - qktmp(iCell,k,m) = tracers(idx_dycore,k,iCell)-& - dtime*q_tend(m,k,iCell) + qktmp(iCell,k,m) = tracers(idx_dycore,k,iCell)-dtime*q_tend(m,k,iCell) end do end do end do diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index f961495967..263205ffa4 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -27,7 +27,7 @@ subroutine print_budget(hstwr) logical, intent(in) :: hstwr(:) ! Local variables - character(len=*), parameter :: subname = 'check_energy:print_budgets' + character(len=*), parameter :: subname = 'dycore_budget:print_budgets' ! ! physics energy tendencies ! diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index 296d7461c6..e36da9fa66 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -18,20 +18,17 @@ subroutine print_budget(hstwr) use spmd_utils, only: masterproc use cam_abortutils, only: endrun use cam_logfile, only: iulog - use shr_kind_mod, only: r8=>shr_kind_r8 use budgets, only: budget_get_global, is_budget, thermo_budget_histfile_num, thermo_budget_history use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv, & teidx, seidx, keidx, poidx use dimensions_mod, only: ntrac use control_mod, only: ftype - use cam_thermo, only: teidx, seidx, keidx, poidx - use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv ! arguments logical, intent(in) :: hstwr(:) ! Local variables - character(len=*), parameter :: subname = 'check_energy:print_budgets' + character(len=*), parameter :: subname = 'dycore_budget:print_budgets' ! ! physics energy tendencies ! From a7ff2ed99e1b72f700169ca48c6ffcab46390bd6 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Thu, 20 Apr 2023 13:58:41 -0600 Subject: [PATCH 104/140] repond to PR comments --- src/dynamics/fv/metdata.F90 | 28 +++++++++++++++------------- src/dynamics/mpas/dp_coupling.F90 | 20 ++++++++------------ src/dynamics/mpas/dycore_budget.F90 | 6 ++++-- 3 files changed, 27 insertions(+), 27 deletions(-) diff --git a/src/dynamics/fv/metdata.F90 b/src/dynamics/fv/metdata.F90 index 316ebcd54d..58a51283bc 100644 --- a/src/dynamics/fv/metdata.F90 +++ b/src/dynamics/fv/metdata.F90 @@ -925,24 +925,26 @@ subroutine get_dyn_flds( state, tend, dt ) do c = begchunk, endchunk ncol = get_ncols_p(c) + ! + ! update water variables + ! + qini(:ncol,:pver) = state(c)%q(:ncol,:pver,1) + totliqini = 0.0_r8 + do m_cnst=1,thermodynamic_active_species_liq_num + m = thermodynamic_active_species_liq_idx(m_cnst) + totliqini(:ncol,:pver) = totliqini(:ncol,:pver)+state(c)%q(:ncol,:pver,m) + end do + toticeini = 0.0_r8 + do m_cnst=1,thermodynamic_active_species_ice_num + m = thermodynamic_active_species_ice_idx(m_cnst) + toticeini(:ncol,:pver) = toticeini(:ncol,:pver)+state(c)%q(:ncol,:pver,m) + end do + do k=1,pver do i=1,ncol if (met_nudge_temp) then state(c)%t(i,k) = (1._r8-met_rlx(k))*state(c)%t(i,k) + met_rlx(k)*met_t(i,k,c) end if - - qini (:ncol,:pver) = state(c)%q(:ncol,:pver, 1) - totliqini = 0.0_r8 - do m_cnst=1,thermodynamic_active_species_liq_num - m = thermodynamic_active_species_liq_idx(m_cnst) - totliqini(:ncol,:pver) = totliqini(:ncol,:pver)+state(c)%q(:ncol,:pver,m) - end do - toticeini = 0.0_r8 - do m_cnst=1,thermodynamic_active_species_ice_num - m = thermodynamic_active_species_ice_idx(m_cnst) - toticeini(:ncol,:pver) = toticeini(:ncol,:pver)+state(c)%q(:ncol,:pver,m) - end do - ! at this point tracer mixing ratios have already been ! converted from dry to moist state(c)%q(i,k,1) = alpha*state(c)%q(i,k,1) + (D1_0-alpha)*met_q(i,k,c) diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index a53d1d7f86..7cd1ce936d 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -771,18 +771,14 @@ subroutine hydrostatic_pressure(nCells, nVertLevels, qsize, index_qv, zz, zgrid, end do k = nVertLevels - rhok = 1.0_r8 - do idx=1,thermodynamic_active_species_num - rhok = rhok+q(thermodynamic_active_species_idx_dycore(idx),k,iCell) - end do - rhok = rhok*zz(k,iCell) * rho_zz(k,iCell) sum_water = 1.0_r8 do idx=1,thermodynamic_active_species_num sum_water = sum_water+q(thermodynamic_active_species_idx_dycore(idx),k,iCell) end do - thetavk = theta_m(k,iCell)/sum_water - tvk = thetavk*exner(k,iCell) - pk = dp(k)*rgas*tvk/(gravit*dz(k)) + rhok = sum_water*zz(k,iCell) * rho_zz(k,iCell) + thetavk = theta_m(k,iCell)/sum_water + tvk = thetavk*exner(k,iCell) + pk = dp(k)*rgas*tvk/(gravit*dz(k)) ! ! model top pressure consistently diagnosed using the assumption that the mid level ! is at height z(nVertLevels-1)+0.5*dz @@ -797,7 +793,7 @@ subroutine hydrostatic_pressure(nCells, nVertLevels, qsize, index_qv, zz, zgrid, do idx=1,thermodynamic_active_species_num sum_water = sum_water+q(thermodynamic_active_species_idx_dycore(idx),k,iCell) end do - thetavk = theta_m(k,iCell)/sum_water! (1.0_r8 + q(index_qv,k,iCell)) !convert modified theta to virtual theta + thetavk = theta_m(k,iCell)/sum_water!convert modified theta to virtual theta tvk = thetavk*exner(k,iCell) tk = tvk*sum_water/(1.0_r8+Rv_over_Rd*q(index_qv,k,iCell)) pint (k,iCell) = pint (k+1,iCell)+dp(k) @@ -816,8 +812,8 @@ subroutine tot_energy_dyn(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_z use air_composition, only: thermodynamic_active_species_ice_idx_dycore,thermodynamic_active_species_liq_idx_dycore use air_composition, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_liq_num use air_composition, only: dry_air_species_num, thermodynamic_active_species_R - use cam_thermo, only: wvidx,wlidx,wiidx,seidx,poidx,keidx,moidx,mridx,ttidx,teidx,thermo_budget_num_vars - use cam_thermo, only: get_hydrostatic_energy,moidx,mridx,ttidx, thermo_budget_vars + use cam_thermo, only: wvidx,wlidx,wiidx,seidx,poidx,keidx,teidx,thermo_budget_num_vars + use cam_thermo, only: get_hydrostatic_energy,thermo_budget_vars use dyn_tests_utils, only: vcoord=>vc_height use cam_history_support, only: max_fieldname_len ! Arguments @@ -893,7 +889,7 @@ subroutine tot_energy_dyn(nCells, nVertLevels, qsize, index_qv, zz, zgrid, rho_z enddo call get_hydrostatic_energy(tracers, .false., pdeldry, cp_or_cv, u, v, temperature, & vcoord=vcoord, phis = phis, z_mid=zcell, dycore_idx=.true., & - se=internal_energy, po =potential_energy, ke =kinetic_energy, & + se=internal_energy, po=potential_energy, ke=kinetic_energy, & wv=water_vapor , liq=liq , ice=ice) call outfld(name_out(seidx),internal_energy ,ncells,1) diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index 263205ffa4..1ec077f251 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -20,7 +20,7 @@ subroutine print_budget(hstwr) use spmd_utils, only: masterproc use cam_logfile, only: iulog use cam_abortutils, only: endrun - use cam_thermo, only: teidx, thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv + use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv use cam_thermo, only: teidx, seidx, keidx, poidx ! arguments @@ -47,7 +47,7 @@ subroutine print_budget(hstwr) real(r8) :: dEdt_phys_total_dynE(4) ! dE/dt physics total using dycore E (dyAM-dyBF) ! physics total = parameterizations + efix + dry-mass adjustment ! - ! SE dycore specific energy tendencies + ! dycore specific energy tendencies ! real(r8) :: dEdt_phys_total_in_dyn(4) ! dEdt of physics total in dynamical core ! physics total = parameterizations + efix + dry-mass adjustment @@ -224,6 +224,8 @@ subroutine print_budget(hstwr) write(iulog,*)" " write(iulog,*)" (equation 23 in Lauritzen and Williamson (2019))" write(iulog,*)" " + write(iulog,*)" Technically this equation is only valid with instantaneous time-step to" + write(iulog,*)" time-step output" tmp = previous_dEdt_phys_dyn_coupl_err+previous_dEdt_adiabatic_dycore+previous_dEdt_dry_mass_adjust diff = abs_diff(-dEdt_efix_dynE(1),tmp,pf) From 30d45f576ff0bbe30ac5f8e4dfa50df41cd885e2 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Thu, 20 Apr 2023 16:28:48 -0600 Subject: [PATCH 105/140] PR comments mods --- src/dynamics/mpas/dycore_budget.F90 | 92 +++++++++++------------------ 1 file changed, 36 insertions(+), 56 deletions(-) diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index 1ec077f251..d97fcdc021 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -5,11 +5,9 @@ module dycore_budget public :: print_budget real(r8), parameter :: eps = 1.0E-9_r8 real(r8), parameter :: eps_mass = 1.0E-12_r8 -real(r8), save :: previous_dEdt_adiabatic_dycore = 0.0_r8 -real(r8), save :: previous_dEdt_dry_mass_adjust = 0.0_r8 -real(r8), save :: previous_dEdt_phys_dyn_coupl_err = 0.0_r8 -real(r8), save :: previous_E_bf = 0.0_r8!xxx -real(r8), save :: previous_dEdt_phys_total_dynE = 0.0_r8!xxx +real(r8), save :: previous_dEdt_adiabatic_dycore_and_pdc_errors = 0.0_r8 +real(r8), save :: previous_dEdt_dry_mass_adjust = 0.0_r8 +real(r8), save :: previous_dEdt_phys_dyn_coupl_err_Agrid = 0.0_r8 !========================================================================================= contains !========================================================================================= @@ -27,7 +25,7 @@ subroutine print_budget(hstwr) logical, intent(in) :: hstwr(:) ! Local variables - character(len=*), parameter :: subname = 'dycore_budget:print_budgets' + character(len=*), parameter :: subname = 'dycore_budget:print_budgets:' ! ! physics energy tendencies ! @@ -51,9 +49,9 @@ subroutine print_budget(hstwr) ! real(r8) :: dEdt_phys_total_in_dyn(4) ! dEdt of physics total in dynamical core ! physics total = parameterizations + efix + dry-mass adjustment - real(r8) :: dEdt_param_efix_in_dyn(4) ! dEdt of physics total in dynamical core + real(r8) :: dEdt_param_efix_in_dyn(4) ! dEdt CAM physics + energy fixer in dynamical core real(r8) :: dEdt_dme_adjust_in_dyn(4) ! dEdt of dme adjust in dynamical core - real(r8) :: dEdt_dycore_phys ! dEdt dycore (estimated in physics) + real(r8) :: dEdt_dycore_and_pdc_estimated_from_efix ! dEdt dycore and PDC errors (estimated in physics) ! ! mass budgets physics ! @@ -182,11 +180,11 @@ subroutine print_budget(hstwr) diff = abs_diff(dEdt_param_physE(i),dEdt_param_dynE(i),pf=pf) write(iulog,fmt)"dE/dt all parameterizations (xxAP-xxBP) ",str(i)," ",dEdt_param_physE(i)," ",dEdt_param_dynE(i)," ",diff,pf write(iulog,*) " " + if (diff>eps) then + write(iulog,*)"FAIL" + call endrun(subname//"dE/dt's in physics inconsistent") + end if end do - if (diff>eps) then - write(iulog,*)"FAIL" - call endrun(subname//"dE/dt's in physics inconsistent") - end if write(iulog,*)" " write(iulog,*)" " write(iulog,*)"dE/dt from dry-mass adjustment will differ if dynamics and physics use" @@ -227,35 +225,18 @@ subroutine print_budget(hstwr) write(iulog,*)" Technically this equation is only valid with instantaneous time-step to" write(iulog,*)" time-step output" - tmp = previous_dEdt_phys_dyn_coupl_err+previous_dEdt_adiabatic_dycore+previous_dEdt_dry_mass_adjust - diff = abs_diff(-dEdt_efix_dynE(1),tmp,pf) - write(iulog,*) "" - write(iulog,*) "Check if that is the case:", pf, diff - write(iulog,*) " " - if (abs(diff)>eps) then - write(iulog,*) "dE/dt energy fixer(t=n) = ",dEdt_efix_dynE(1) - write(iulog,*) "dE/dt dry mass adjustment (t=n-1) = ",previous_dEdt_dry_mass_adjust - write(iulog,*) "dE/dt adiabatic dycore (t=n-1) = ",previous_dEdt_adiabatic_dycore - write(iulog,*) "dE/dt physics-dynamics coupling errors (t=n-1) = ",previous_dEdt_phys_dyn_coupl_err - ! call endrun(subname//"Error in energy fixer budget") - end if - dEdt_dycore_phys = -dEdt_efix_dynE(1)-previous_dEdt_phys_dyn_coupl_err-previous_dEdt_dry_mass_adjust + write(iulog,*) " dE/dt energy fixer(t=n) = ",dEdt_efix_dynE(1) + write(iulog,*) " dE/dt dry mass adjustment (t=n-1) = ",previous_dEdt_dry_mass_adjust + write(iulog,*) " dE/dt adiabatic dycore (t=n-1) = ",previous_dEdt_adiabatic_dycore_and_pdc_errors + write(iulog,*) " dE/dt PDC errors (A-grid) (t=n-1) = ",previous_dEdt_phys_dyn_coupl_err_Agrid + write(iulog,*) " dE/dt PDC errors (other ) (t=n-1) = ??" + dEdt_dycore_and_pdc_estimated_from_efix = -dEdt_efix_dynE(1)-previous_dEdt_phys_dyn_coupl_err_Agrid-previous_dEdt_dry_mass_adjust write(iulog,*) " " - write(iulog,*) "xxx " - write(iulog,*) " " - - tmp = (E_dyBF(1)-previous_E_bf)/1800.0_r8!-previous_dEdt_phys_total_dynE - write(iulog,*) "Dycore: ",tmp - write(iulog,*) "Phys total:" ,previous_dEdt_phys_total_dynE - write(iulog,*) "Residual: ",previous_dEdt_phys_total_dynE-tmp - write(iulog,*) " " - write(iulog,*) "xxx " - write(iulog,*) " " - - - write(iulog,*) "Hence the dycore E dissipation estimated from energy fixer " - write(iulog,'(A39,F6.2,A6)') "based on previous time-step values is ",dEdt_dycore_phys," W/M^2" + write(iulog,*) "Hence the dycore E dissipation and physics-dynamics coupling errors" + write(iulog,*) "associated with mapping wind tendencies to C-grid and dribbling " + write(iulog,*) "tendencies in the dycore (PDC other), estimated from energy fixer " + write(iulog,'(A39,F6.2,A6)') "based on previous time-step values is ",dEdt_dycore_and_pdc_estimated_from_efix," W/M^2" write(iulog,*) " " write(iulog,*) " " write(iulog,*) "-------------------------------------------------------------------" @@ -285,16 +266,18 @@ subroutine print_budget(hstwr) end if write(iulog,*)" " - write(iulog,*)"-------------------------------------------------------------------------" - write(iulog,*)" Consistency check 2: total energy increment on dynamics decomposition " - write(iulog,*)" on an A-grid (physics grid) the as physics increment (also on A-grid)?" - write(iulog,*)" (note that wind tendencies are mapped to C-grid in MPAS dycore" - write(iulog,*)"-------------------------------------------------------------------------" + write(iulog,*)"----------------------------------------------------------------------------" + write(iulog,*)" Consistency check 2: total energy increment on dynamics decomposition " + write(iulog,*)" on an A-grid (physics grid) the same as physics increment (also on A-grid)?" + write(iulog,*)" Note that wind tendencies are mapped to C-grid in MPAS dycore and added " + write(iulog,*)" throughout the time-integration leading to additional physics-dynamics " + write(iulog,*)" coupling errors " + write(iulog,*)"----------------------------------------------------------------------------" write(iulog,*)" " - previous_dEdt_phys_dyn_coupl_err = dEdt_phys_total_in_dyn(1)-dEdt_phys_total_dynE(1) + previous_dEdt_phys_dyn_coupl_err_Agrid = dEdt_phys_total_in_dyn(1)-dEdt_phys_total_dynE(1) diff = abs_diff(dEdt_phys_total_dynE(1),dEdt_phys_total_in_dyn(1),pf=pf) - write(iulog,'(A41,E8.2,A7,A5)')" dE/dt physics-dynamics coupling errors ",diff," W/M^2 ",pf + write(iulog,'(A50,E8.2,A7,A5)')" dE/dt physics-dynamics coupling errors (A-grid) ",diff," W/M^2 ",pf write(iulog,*)" " if (abs(diff)>eps) then do i=1,4 @@ -317,7 +300,7 @@ subroutine print_budget(hstwr) write(iulog,*)" Energy diagnostics have not been implemented in the MPAS" write(iulog,*)" dynamical core so a detailed budget is not available." write(iulog,*)" " - write(iulog,*)" dE/dt adiabatic dynamical core must therefore be estiamted" + write(iulog,*)" dE/dt adiabatic dynamical core must therefore be estimated" write(iulog,*)" from" write(iulog,*)" " write(iulog,*)" dE/dt adiabatic dycore (t=n-1) = " @@ -325,15 +308,15 @@ subroutine print_budget(hstwr) write(iulog,*)" -dE/dt energy fixer(t=n)" write(iulog,*)" -dE/dt physics-dynamics coupling errors (t=n-1)" write(iulog,*)" " - dEdt_dycore_phys = -dEdt_efix_dynE(1)-previous_dEdt_dry_mass_adjust - write(iulog,'(A34,F6.2,A6)') " = ",dEdt_dycore_phys," W/M^2" + dEdt_dycore_and_pdc_estimated_from_efix = -dEdt_efix_dynE(1)-previous_dEdt_dry_mass_adjust + write(iulog,'(A34,F6.2,A6)') " = ",dEdt_dycore_and_pdc_estimated_from_efix," W/M^2" write(iulog,*)" " write(iulog,*)" assuming no physics-dynamics coupling errors, that is," write(iulog,*)" dE/dt physics-dynamics coupling errors (t=n-1) = 0" write(iulog,*)" " write(iulog,*)" For MPAS the physics-dynamics coupling errors include:" write(iulog,*)" - `dribbling' temperature and wind tendencies during the" - write(iulog,*)" dynamical core time-integration." + write(iulog,*)" dynamical core time-integration" write(iulog,*)" - mapping wind tendencies from A to C grid" write(iulog,*)" " @@ -375,7 +358,7 @@ subroutine print_budget(hstwr) ! all of the mass-tendency should come from parameterization - checking ! if (abs(dMdt_parameterizations-dMdt_phys_total)>eps_mass) then - write(iulog,*) "Error: dMASS/dt parameterizations (pAP-pBP) .ne. dMASS/dt physics total (pAM-pBF)" + write(iulog,*) "Error: dMASS/dt parameterizations (pAP-pBP) /= dMASS/dt physics total (pAM-pBF)" write(iulog,*) "dMASS/dt parameterizations (pAP-pBP) ",dMdt_parameterizations," Pa/m^2/s" write(iulog,*) "dMASS/dt physics total (pAM-pBF) ",dMdt_phys_total," Pa/m^2/s" call endrun(subname//"mass change not only due to parameterizations. See atm.log") @@ -398,11 +381,8 @@ subroutine print_budget(hstwr) ! ! save adiabatic dycore dE/dt and dry-mass adjustment to avoid samping error ! - previous_dEdt_adiabatic_dycore = dEdt_dycore_phys - previous_dEdt_dry_mass_adjust = dEdt_dme_adjust_dynE(1) - - previous_E_bf = E_dyBF(1) !xxx - previous_dEdt_phys_total_dynE = dEdt_phys_total_dynE(1)!xxx + previous_dEdt_adiabatic_dycore_and_pdc_errors = dEdt_dycore_and_pdc_estimated_from_efix + previous_dEdt_dry_mass_adjust = dEdt_dme_adjust_dynE(1) end if end subroutine print_budget !========================================================================================= From 0208c49e4a7abe0d1d343467766363f5ffb0cbbb Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Thu, 20 Apr 2023 16:48:00 -0600 Subject: [PATCH 106/140] more mods --- src/dynamics/mpas/dycore_budget.F90 | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index d97fcdc021..e65ebadaed 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -5,9 +5,8 @@ module dycore_budget public :: print_budget real(r8), parameter :: eps = 1.0E-9_r8 real(r8), parameter :: eps_mass = 1.0E-12_r8 -real(r8), save :: previous_dEdt_adiabatic_dycore_and_pdc_errors = 0.0_r8 -real(r8), save :: previous_dEdt_dry_mass_adjust = 0.0_r8 -real(r8), save :: previous_dEdt_phys_dyn_coupl_err_Agrid = 0.0_r8 +real(r8), save :: previous_dEdt_dry_mass_adjust = 0.0_r8 +real(r8), save :: previous_dEdt_phys_dyn_coupl_err_Agrid = 0.0_r8 !========================================================================================= contains !========================================================================================= @@ -224,12 +223,12 @@ subroutine print_budget(hstwr) write(iulog,*)" " write(iulog,*)" Technically this equation is only valid with instantaneous time-step to" write(iulog,*)" time-step output" - + write(iulog,*) " " write(iulog,*) " dE/dt energy fixer(t=n) = ",dEdt_efix_dynE(1) write(iulog,*) " dE/dt dry mass adjustment (t=n-1) = ",previous_dEdt_dry_mass_adjust - write(iulog,*) " dE/dt adiabatic dycore (t=n-1) = ",previous_dEdt_adiabatic_dycore_and_pdc_errors + write(iulog,*) " dE/dt adiabatic dycore (t=n-1) = unknown" write(iulog,*) " dE/dt PDC errors (A-grid) (t=n-1) = ",previous_dEdt_phys_dyn_coupl_err_Agrid - write(iulog,*) " dE/dt PDC errors (other ) (t=n-1) = ??" + write(iulog,*) " dE/dt PDC errors (other ) (t=n-1) = unknown" dEdt_dycore_and_pdc_estimated_from_efix = -dEdt_efix_dynE(1)-previous_dEdt_phys_dyn_coupl_err_Agrid-previous_dEdt_dry_mass_adjust write(iulog,*) " " @@ -377,12 +376,10 @@ subroutine print_budget(hstwr) end if end if end do - ! - ! save adiabatic dycore dE/dt and dry-mass adjustment to avoid samping error + ! save dry-mass adjustment to avoid samping error ! - previous_dEdt_adiabatic_dycore_and_pdc_errors = dEdt_dycore_and_pdc_estimated_from_efix - previous_dEdt_dry_mass_adjust = dEdt_dme_adjust_dynE(1) + previous_dEdt_dry_mass_adjust = dEdt_dme_adjust_dynE(1) end if end subroutine print_budget !========================================================================================= From 0a6f9cfc2f75fc3c95c010da9f34b6bd6d1498a8 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 20 Apr 2023 18:05:50 -0600 Subject: [PATCH 107/140] PR budget mods no answer changing --- src/control/budgets.F90 | 9 ++++-- src/control/cam_history.F90 | 4 +-- src/dynamics/eul/dycore_budget.F90 | 2 +- src/dynamics/fv/dycore_budget.F90 | 2 +- src/dynamics/fv3/dycore_budget.F90 | 2 +- src/dynamics/mpas/dycore_budget.F90 | 4 +-- src/dynamics/se/dycore/global_norms_mod.F90 | 33 ++++++--------------- src/dynamics/se/dycore_budget.F90 | 2 +- src/physics/cam/check_energy.F90 | 4 +-- src/physics/simple/physpkg.F90 | 2 ++ src/utils/cam_grid_support.F90 | 2 +- src/utils/cam_thermo.F90 | 2 +- 12 files changed, 28 insertions(+), 40 deletions(-) diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index 48e8504c58..aad7ece760 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -180,7 +180,8 @@ subroutine e_m_snapshot (name, pkgtype, longname, cslam) call endrun(errmsg) end if end if - call addfld (TRIM(ADJUSTL(name_str)), horiz_only, 'N', TRIM(ADJUSTL(units_str)),TRIM(ADJUSTL(desc_str)),gridname=gridname) + call addfld (TRIM(ADJUSTL(name_str)), horiz_only, 'N', TRIM(ADJUSTL(units_str)), & + TRIM(ADJUSTL(desc_str)), gridname=gridname) call add_default(TRIM(ADJUSTL(name_str)), thermo_budget_histfile_num, 'N') end do end if @@ -359,7 +360,8 @@ function budget_ind_byname (name) ! Find budget name in list budget_ind_byname = -1 do m = 1, budget_array_max - if (trim(adjustl(name)) == trim(adjustl(budget_name(m))).or.trim(adjustl(name)) == trim(adjustl(budget_stagename(m)))) then + if (trim(adjustl(name)) == trim(adjustl(budget_name(m))).or. & + trim(adjustl(name)) == trim(adjustl(budget_stagename(m)))) then budget_ind_byname = m return end if @@ -384,7 +386,8 @@ function is_budget(name) is_budget = .false. do m = 1, budget_array_max - if (trim(adjustl(name)) == trim(adjustl(budget_name(m))).or.trim(adjustl(name)) == trim(adjustl(budget_stagename(m)))) then + if (trim(adjustl(name)) == trim(adjustl(budget_name(m))).or. & + trim(adjustl(name)) == trim(adjustl(budget_stagename(m)))) then is_budget = .true. return end if diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 748b4bdbf0..5f17efd47f 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -4921,8 +4921,8 @@ subroutine h_normalize (f, t) / nsteps end do else - write(errmsg,*) sub,'FATAL: bad nstep normalization, currstep, beg_nstep, nsteps=',currstep,tape(t)%hlist(f)%beg_nstep - call endrun(errmsg) + write(errmsg,*) sub,'FATAL: bad nstep normalization, currstep, beg_nstep=',currstep,',',tape(t)%hlist(f)%beg_nstep + call endrun(trim(errmsg)) end if end if if (avgflag == 'S') then diff --git a/src/dynamics/eul/dycore_budget.F90 b/src/dynamics/eul/dycore_budget.F90 index 36b89880eb..e89a167a20 100644 --- a/src/dynamics/eul/dycore_budget.F90 +++ b/src/dynamics/eul/dycore_budget.F90 @@ -15,7 +15,7 @@ subroutine print_budget(hstwr) ! arguments logical, intent(in) :: hstwr(:) - character(len=*), parameter :: subname = 'dycore_budget:print_budgets' + character(len=*), parameter :: subname = 'dycore_budget:print_budgets:' !-------------------------------------------------------------------------------------- diff --git a/src/dynamics/fv/dycore_budget.F90 b/src/dynamics/fv/dycore_budget.F90 index 78643abab2..1f976a4708 100644 --- a/src/dynamics/fv/dycore_budget.F90 +++ b/src/dynamics/fv/dycore_budget.F90 @@ -15,7 +15,7 @@ subroutine print_budget(hstwr) ! arguments logical, intent(in) :: hstwr(:) - character(len=*), parameter :: subname = 'dycore_budget:print_budgets' + character(len=*), parameter :: subname = 'dycore_budget:print_budgets:' !-------------------------------------------------------------------------------------- diff --git a/src/dynamics/fv3/dycore_budget.F90 b/src/dynamics/fv3/dycore_budget.F90 index 1ba9bc8509..bf8901248e 100644 --- a/src/dynamics/fv3/dycore_budget.F90 +++ b/src/dynamics/fv3/dycore_budget.F90 @@ -16,7 +16,7 @@ subroutine print_budget(hstwr) ! arguments logical, intent(in) :: hstwr(:) - character(len=*), parameter :: subname = 'dycore_budget:print_budgets' + character(len=*), parameter :: subname = 'dycore_budget:print_budgets:' !-------------------------------------------------------------------------------------- diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index 263205ffa4..1880262c10 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -27,7 +27,7 @@ subroutine print_budget(hstwr) logical, intent(in) :: hstwr(:) ! Local variables - character(len=*), parameter :: subname = 'dycore_budget:print_budgets' + character(len=*), parameter :: subname = 'dycore_budget:print_budgets:' ! ! physics energy tendencies ! @@ -394,7 +394,7 @@ subroutine print_budget(hstwr) end do ! - ! save adiabatic dycore dE/dt and dry-mass adjustment to avoid samping error + ! save adiabatic dycore dE/dt and dry-mass adjustment to avoid sampling error ! previous_dEdt_adiabatic_dycore = dEdt_dycore_phys previous_dEdt_dry_mass_adjust = dEdt_dme_adjust_dynE(1) diff --git a/src/dynamics/se/dycore/global_norms_mod.F90 b/src/dynamics/se/dycore/global_norms_mod.F90 index 5551d813e7..0b07808a40 100644 --- a/src/dynamics/se/dycore/global_norms_mod.F90 +++ b/src/dynamics/se/dycore/global_norms_mod.F90 @@ -61,7 +61,6 @@ subroutine global_integrals(elem, h,hybrid,npts,num_flds,nets,nete,I_sphere) ! J_tmp = 0.0_r8 -!JMD print *,'global_integral: before loop' do ie=nets,nete do q=1,num_flds do j=1,np @@ -75,9 +74,7 @@ subroutine global_integrals(elem, h,hybrid,npts,num_flds,nets,nete,I_sphere) do ie=nets,nete global_shared_buf(ie,1:num_flds) = J_tmp(ie,:) enddo - !JMD print *,'global_integral: before wrap_repro_sum' call wrap_repro_sum(nvars=num_flds, comm=hybrid%par%comm) - !JMD print *,'global_integral: after wrap_repro_sum' I_sphere(:) =global_shared_sum(1:num_flds) /(4.0_r8*PI) end subroutine global_integrals @@ -107,7 +104,6 @@ subroutine global_integrals_general(h,hybrid,npts,da,num_flds,nets,nete,I_sphere ! J_tmp = 0.0_r8 -!JMD print *,'global_integral: before loop' do ie=nets,nete do q=1,num_flds do j=1,npts @@ -120,9 +116,7 @@ subroutine global_integrals_general(h,hybrid,npts,da,num_flds,nets,nete,I_sphere do ie=nets,nete global_shared_buf(ie,1:num_flds) = J_tmp(ie,:) enddo - !JMD print *,'global_integral: before wrap_repro_sum' call wrap_repro_sum(nvars=num_flds, comm=hybrid%par%comm) - !JMD print *,'global_integral: after wrap_repro_sum' I_sphere(:) =global_shared_sum(1:num_flds) /(4.0_r8*PI) end subroutine global_integrals_general @@ -160,12 +154,11 @@ function global_integral_elem(elem, h,hybrid,npts,nets,nete) result(I_sphere) real (kind=r8) :: da real (kind=r8) :: J_tmp(nets:nete) ! -! This algorythm is independent of thread count and task count. +! This algorithm is independent of thread count and task count. ! This is a requirement of consistancy checking in cam. ! J_tmp = 0.0_r8 -!JMD print *,'global_integral: before loop' do ie=nets,nete do j=1,np do i=1,np @@ -177,11 +170,8 @@ function global_integral_elem(elem, h,hybrid,npts,nets,nete) result(I_sphere) do ie=nets,nete global_shared_buf(ie,1) = J_tmp(ie) enddo -!JMD print *,'global_integral: before wrap_repro_sum' call wrap_repro_sum(nvars=1, comm=hybrid%par%comm) -!JMD print *,'global_integral: after wrap_repro_sum' I_tmp = global_shared_sum(1) -!JMD print *,'global_integral: after global_shared_sum' I_sphere = I_tmp(1)/(4.0_r8*PI) end function global_integral_elem @@ -210,28 +200,23 @@ function global_integral_fvm(fvm, h,hybrid,npts,nets,nete) result(I_sphere) real (kind=r8) :: da real (kind=r8) :: J_tmp(nets:nete) ! -! This algorythm is independent of thread count and task count. +! This algorithm is independent of thread count and task count. ! This is a requirement of consistancy checking in cam. ! J_tmp = 0.0_r8 - -!JMD print *,'global_integral: before loop' - do ie=nets,nete - do j=1,npts - do i=1,npts - da = fvm(ie)%area_sphere(i,j) - J_tmp(ie) = J_tmp(ie) + da*h(i,j,ie) - end do + do ie=nets,nete + do j=1,npts + do i=1,npts + da = fvm(ie)%area_sphere(i,j) + J_tmp(ie) = J_tmp(ie) + da*h(i,j,ie) end do end do + end do do ie=nets,nete - global_shared_buf(ie,1) = J_tmp(ie) + global_shared_buf(ie,1) = J_tmp(ie) enddo -!JMD print *,'global_integral: before wrap_repro_sum' call wrap_repro_sum(nvars=1, comm=hybrid%par%comm) -!JMD print *,'global_integral: after wrap_repro_sum' I_tmp = global_shared_sum(1) -!JMD print *,'global_integral: after global_shared_sum' I_sphere = I_tmp(1)/(4.0_r8*PI) end function global_integral_fvm diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index e36da9fa66..a9c4e11a1e 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -28,7 +28,7 @@ subroutine print_budget(hstwr) logical, intent(in) :: hstwr(:) ! Local variables - character(len=*), parameter :: subname = 'dycore_budget:print_budgets' + character(len=*), parameter :: subname = 'dycore_budget:print_budgets:' ! ! physics energy tendencies ! diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 3ecf148cb8..70a420b274 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -390,7 +390,7 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & cp_or_cv(:,:) = cpair else call endrun('check_energy_chng: cpairv is not allowed to vary when subcolumns are turned on') - end if + end if call get_hydrostatic_energy(state%q(1:ncol,1:pver,1:pcnst),.true., & state%pdel(1:ncol,1:pver), cp_or_cv(1:ncol,1:pver), & @@ -949,8 +949,6 @@ subroutine tot_energy_phys(state, outfld_name_suffix,vc) ! MR is equation (6) without \Delta A and sum over areas (areas are in units of radians**2) ! MO is equation (7) without \Delta A and sum over areas (areas are in units of radians**2) ! - lchnk = state%lchnk - ncol = state%ncol mr_cnst = rearth**3/gravit mo_cnst = omega*rearth**4/gravit diff --git a/src/physics/simple/physpkg.F90 b/src/physics/simple/physpkg.F90 index a461245a2a..0c43ec3eb2 100644 --- a/src/physics/simple/physpkg.F90 +++ b/src/physics/simple/physpkg.F90 @@ -654,6 +654,8 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) if (.not. moist_physics) then deallocate(cldliqini) deallocate(cldiceini) + deallocate(totliqini) + deallocate(toticeini) end if end subroutine tphysac diff --git a/src/utils/cam_grid_support.F90 b/src/utils/cam_grid_support.F90 index f56571a808..d86c829e77 100644 --- a/src/utils/cam_grid_support.F90 +++ b/src/utils/cam_grid_support.F90 @@ -2079,7 +2079,7 @@ subroutine add_cam_grid_attribute_1d_r8(gridname, name, long_name, & character(len=120) :: errormsg integer :: gridind integer :: dimsize - if (masterproc) write(iulog,*)'adding cam_grid_attribute gridname,name,dimname=',gridname,name,dimname + gridind = get_cam_grid_index(trim(gridname)) if (gridind > 0) then call find_cam_grid_attr(gridind, trim(name), attptr) diff --git a/src/utils/cam_thermo.F90 b/src/utils/cam_thermo.F90 index 4eb4aab995..7b75ed11d5 100644 --- a/src/utils/cam_thermo.F90 +++ b/src/utils/cam_thermo.F90 @@ -1613,7 +1613,7 @@ subroutine get_hydrostatic_energy_1hd(tracer, moist_mixing_ratio, pdel_in, & ! or internal energy (z coordinate) real(r8), intent(out), optional :: se (:) ! PO: vertically integrated PHIS term (pressure coordinate) - ! or potential enerhy (z coordinate) + ! or potential energy (z coordinate) real(r8), intent(out), optional :: po (:) ! WV: vertically integrated water vapor real(r8), intent(out), optional :: wv (:) From 9456829ac1ce00894a65ed1d487054730339044a Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 21 Apr 2023 11:24:05 -0600 Subject: [PATCH 108/140] PR responses --- src/dynamics/se/dycore/global_norms_mod.F90 | 22 +++-------- src/dynamics/se/dycore/prim_advance_mod.F90 | 6 +-- src/dynamics/se/dycore_budget.F90 | 42 ++++++++++----------- 3 files changed, 26 insertions(+), 44 deletions(-) diff --git a/src/dynamics/se/dycore/global_norms_mod.F90 b/src/dynamics/se/dycore/global_norms_mod.F90 index 0b07808a40..2761a59b9c 100644 --- a/src/dynamics/se/dycore/global_norms_mod.F90 +++ b/src/dynamics/se/dycore/global_norms_mod.F90 @@ -45,9 +45,6 @@ subroutine global_integrals(elem, h,hybrid,npts,num_flds,nets,nete,I_sphere) type (hybrid_t) , intent(in) :: hybrid real (kind=r8) :: I_sphere(num_flds) - - real (kind=r8) :: I_shared - common /gblintcom/I_shared ! ! Local variables ! @@ -89,9 +86,6 @@ subroutine global_integrals_general(h,hybrid,npts,da,num_flds,nets,nete,I_sphere real (kind=r8), intent(in) :: da(npts,npts,nets:nete) real (kind=r8) :: I_sphere(num_flds) - - real (kind=r8) :: I_shared - common /gblintcom/I_shared ! ! Local variables ! @@ -143,9 +137,6 @@ function global_integral_elem(elem, h,hybrid,npts,nets,nete) result(I_sphere) real (kind=r8) :: I_sphere - real (kind=r8) :: I_shared - common /gblintcom/I_shared - ! Local variables integer :: ie,j,i @@ -189,9 +180,6 @@ function global_integral_fvm(fvm, h,hybrid,npts,nets,nete) result(I_sphere) real (kind=r8) :: I_sphere - real (kind=r8) :: I_shared - common /gblintcom/I_shared - ! Local variables integer :: ie,j,i @@ -387,11 +375,11 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& max_min_dx = ParallelMax(max_min_dx,hybrid) min_max_dx = ParallelMin(min_max_dx,hybrid) max_ratio = ParallelMax(max_ratio,hybrid) - ! Physical units for area - min_area = min_area*rearth*rearth/1000000._r8 - max_area = max_area*rearth*rearth/1000000._r8 - avg_area = avg_area*rearth*rearth/1000000._r8 - tot_area = tot_area_rad*rearth*rearth/1000000._r8 + ! Physical units for area (unit sphere to Earth sphere) + min_area = min_area*rearth*rearth/1000000._r8 !m2 (rearth is in units of km) + max_area = max_area*rearth*rearth/1000000._r8 !m2 (rearth is in units of km) + avg_area = avg_area*rearth*rearth/1000000._r8 !m2 (rearth is in units of km) + tot_area = tot_area_rad*rearth*rearth/1000000._r8!m2 (rearth is in units of km) if (hybrid%masterthread) then write(iulog,* )"" write(iulog,* )"Running Global Integral Diagnostic..." diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index 9a5977e6e1..15cb209888 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -1693,17 +1693,15 @@ end subroutine output_qdp_var_dynamics ! column integrate mass-variable and outfld ! subroutine util_function(f_in,nx,nz,name_out,ie) - use physconst, only: gravit + use physconst, only: rga use cam_history, only: outfld, hist_fld_active integer, intent(in) :: nx,nz,ie real(kind=r8), intent(in) :: f_in(nx,nx,nz) character(len=16), intent(in) :: name_out real(kind=r8) :: f_out(nx*nx) integer :: i,j,k - real(kind=r8) :: inv_g if (hist_fld_active(name_out)) then f_out = 0.0_r8 - inv_g = 1.0_r8/gravit do k = 1, nz do j = 1, nx do i = 1, nx @@ -1711,7 +1709,7 @@ subroutine util_function(f_in,nx,nz,name_out,ie) end do end do end do - f_out = f_out*inv_g + f_out = f_out*rga call outfld(name_out,f_out,nx*nx,ie) end if end subroutine util_function diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index a9c4e11a1e..3a24d31e98 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -217,11 +217,11 @@ subroutine print_budget(hstwr) diff = abs_diff(dEdt_param_physE(i),dEdt_param_dynE(i),pf=pf) write(iulog,fmt)"dE/dt all parameterizations (xxAP-xxBP) ",str(i)," ",dEdt_param_physE(i)," ",dEdt_param_dynE(i)," ",diff,pf write(iulog,*) " " + if (diff>eps) then + write(iulog,*)"FAIL" + call endrun(subname//"dE/dt's in physics inconsistent") + end if end do - if (diff>eps) then - write(iulog,*)"FAIL" - call endrun(subname//"dE/dt's in physics inconsistent") - end if write(iulog,*)" " write(iulog,*)" " write(iulog,*)"dE/dt from dry-mass adjustment will differ if dynamics and physics use" @@ -261,7 +261,6 @@ subroutine print_budget(hstwr) write(iulog,*) "dE/dt dry mass adjustment (t=n-1) = ",previous_dEdt_dry_mass_adjust write(iulog,*) "dE/dt adiabatic dycore (t=n-1) = ",previous_dEdt_adiabatic_dycore write(iulog,*) "dE/dt physics-dynamics coupling errors (t=n-1) = ",previous_dEdt_phys_dyn_coupl_err - ! call endrun(subname//"Error in energy fixer budget") end if else previous_dEdt_phys_dyn_coupl_err = dEdt_efix_dynE(1)+previous_dEdt_dry_mass_adjust+previous_dEdt_adiabatic_dycore @@ -335,19 +334,7 @@ subroutine print_budget(hstwr) write(iulog,*)" Consistency check 2: total energy increment in dynamics same as physics?" write(iulog,*)"-------------------------------------------------------------------------" write(iulog,*)" " - if (ntrac>0) then - write(iulog,'(a46,F6.2,a6)')"dE/dt physics tendency in dynamics (dBD-dAF) ",dEdt_phys_total_in_dyn(1)," W/M^2" - write(iulog,'(a46,F6.2,a6)')"dE/dt physics tendency in physics (dyAM-dyBF) ",dEdt_phys_total_dynE(1)," W/M^2" - write(iulog,*)" " - write(iulog,*) " When runnig with a physics grid this consistency check does not make sense" - write(iulog,*) " since it is computed on the GLL grid whereas we enforce energy conservation" - write(iulog,*) " on the physics grid. To assess the errors of running dynamics on GLL" - write(iulog,*) " grid, tracers on CSLAM grid and physics on physics grid we use the energy" - write(iulog,*) " fixer check from above:" - write(iulog,*) " " - write(iulog,*) " dE/dt physics-dynamics coupling errors (t=n-1) =",previous_dEdt_phys_dyn_coupl_err - write(iulog,*) "" - else + if (ntrac==0) then previous_dEdt_phys_dyn_coupl_err = dEdt_phys_total_in_dyn(1)-dEdt_phys_total_dynE(1) diff = abs_diff(dEdt_phys_total_dynE(1),dEdt_phys_total_in_dyn(1),pf=pf) write(iulog,'(A40,E8.2,A7,A5)')" dE/dt physics-dynamics coupling errors ",diff," W/M^2 ",pf @@ -368,7 +355,7 @@ subroutine print_budget(hstwr) write(iulog,*) "Break-down below:" write(iulog,*) "" end if - + do i=1,4 write(iulog,*) str(i),":" write(iulog,*) "======" @@ -380,6 +367,18 @@ subroutine print_budget(hstwr) write(iulog,*) " physics total = parameterizations + efix + dry-mass adjustment" write(iulog,*) " " end do + else + write(iulog,'(a46,F6.2,a6)')"dE/dt physics tendency in dynamics (dBD-dAF) ",dEdt_phys_total_in_dyn(1)," W/M^2" + write(iulog,'(a46,F6.2,a6)')"dE/dt physics tendency in physics (dyAM-dyBF) ",dEdt_phys_total_dynE(1)," W/M^2" + write(iulog,*)" " + write(iulog,*) " When runnig with a physics grid this consistency check does not make sense" + write(iulog,*) " since it is computed on the GLL grid whereas we enforce energy conservation" + write(iulog,*) " on the physics grid. To assess the errors of running dynamics on GLL" + write(iulog,*) " grid, tracers on CSLAM grid and physics on physics grid we use the energy" + write(iulog,*) " fixer check from above:" + write(iulog,*) " " + write(iulog,*) " dE/dt physics-dynamics coupling errors (t=n-1) =",previous_dEdt_phys_dyn_coupl_err + write(iulog,*) "" end if end if write(iulog,*)" " @@ -467,10 +466,7 @@ subroutine print_budget(hstwr) write(iulog,*) "(detailed budget below)" write(iulog,*) " " write(iulog,*)"dMASS/dt 2D dynamics (dAD-dBD) ",dMdt_floating_dyn," Pa/m^2/s" - if (is_budget('dAR').and.is_budget('dAD')) then - call budget_get_global('dAR-dAD',m_cnst,dMdt_vert_remap) - write(iulog,*)"dE/dt vertical remapping (dAR-dAD) ",dMdt_vert_remap - end if + write(iulog,*)"dE/dt vertical remapping (dAR-dAD) ",dMdt_vert_remap write(iulog,*)" " write(iulog,*)"Breakdown of 2D dynamics:" write(iulog,*)" " From c9a5f54a4ee1b124e6642eeeb7dd1fb92146ce1d Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 21 Apr 2023 11:30:09 -0600 Subject: [PATCH 109/140] PR mods. --- src/dynamics/se/dycore_budget.F90 | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index 3a24d31e98..a3802edabf 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -350,9 +350,9 @@ subroutine print_budget(hstwr) write(iulog,*) "" else write(iulog,*) "" - write(iulog,*) "Since ftype<>1 there are physics dynamics coupling errors" + write(iulog,*) " Since ftype<>1 there are physics dynamics coupling errors" write(iulog,*) "" - write(iulog,*) "Break-down below:" + write(iulog,*) " Break-down below:" write(iulog,*) "" end if @@ -367,9 +367,12 @@ subroutine print_budget(hstwr) write(iulog,*) " physics total = parameterizations + efix + dry-mass adjustment" write(iulog,*) " " end do + if (ftype==1) then + call endrun(subname//"Physics-dynamics coupling error. See atm.log") + end if else - write(iulog,'(a46,F6.2,a6)')"dE/dt physics tendency in dynamics (dBD-dAF) ",dEdt_phys_total_in_dyn(1)," W/M^2" - write(iulog,'(a46,F6.2,a6)')"dE/dt physics tendency in physics (dyAM-dyBF) ",dEdt_phys_total_dynE(1)," W/M^2" + write(iulog,'(a47,F6.2,a6)')" dE/dt physics tendency in dynamics (dBD-dAF) ",dEdt_phys_total_in_dyn(1)," W/M^2" + write(iulog,'(a47,F6.2,a6)')" dE/dt physics tendency in physics (dyAM-dyBF) ",dEdt_phys_total_dynE(1)," W/M^2" write(iulog,*)" " write(iulog,*) " When runnig with a physics grid this consistency check does not make sense" write(iulog,*) " since it is computed on the GLL grid whereas we enforce energy conservation" From 7ad2d0951a9ea48fd184c8e37c9ba977c5ff1cdf Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 21 Apr 2023 14:23:42 -0600 Subject: [PATCH 110/140] replace ntrac>0 with use_cslam throughout code; other clean-up --- src/dynamics/se/advect_tend.F90 | 6 +- src/dynamics/se/dycore/dimensions_mod.F90 | 6 +- src/dynamics/se/dycore/fvm_mod.F90 | 13 ++- src/dynamics/se/dycore/global_norms_mod.F90 | 108 ++++++++++---------- src/dynamics/se/dycore/hybrid_mod.F90 | 4 +- src/dynamics/se/dycore/namelist_mod.F90 | 4 +- src/dynamics/se/dycore/prim_advance_mod.F90 | 42 ++++---- src/dynamics/se/dycore/prim_driver_mod.F90 | 16 +-- src/dynamics/se/dycore/prim_state_mod.F90 | 16 +-- src/dynamics/se/dycore/viscosity_mod.F90 | 6 +- src/dynamics/se/dycore_budget.F90 | 34 +++--- src/dynamics/se/dyn_comp.F90 | 56 +++++----- src/dynamics/se/dyn_grid.F90 | 13 +-- src/dynamics/se/restart_dynamics.F90 | 8 +- src/dynamics/se/test_fvm_mapping.F90 | 15 +-- 15 files changed, 170 insertions(+), 177 deletions(-) diff --git a/src/dynamics/se/advect_tend.F90 b/src/dynamics/se/advect_tend.F90 index 856e3408a2..44ea0ff6f7 100644 --- a/src/dynamics/se/advect_tend.F90 +++ b/src/dynamics/se/advect_tend.F90 @@ -25,7 +25,7 @@ subroutine compute_adv_tends_xyz(elem,fvm,nets,nete,qn0,n0) use cam_history, only: outfld, hist_fld_active use time_manager, only: get_step_size use constituents, only: tottnam,pcnst - use dimensions_mod, only: nc,np,nlev,ntrac + use dimensions_mod, only: nc,np,nlev,use_cslam use element_mod, only: element_t use fvm_control_volume_mod, only: fvm_struct implicit none @@ -38,7 +38,7 @@ subroutine compute_adv_tends_xyz(elem,fvm,nets,nete,qn0,n0) logical :: init real(r8), allocatable, dimension(:,:) :: ftmp - if (ntrac>0) then + if (use_cslam) then nx=nc else nx=np @@ -52,7 +52,7 @@ subroutine compute_adv_tends_xyz(elem,fvm,nets,nete,qn0,n0) adv_tendxyz(:,:,:,:,:) = 0._r8 endif - if (ntrac>0) then + if (use_cslam) then do ie=nets,nete do ic=1,pcnst adv_tendxyz(:,:,:,ic,ie) = fvm(ie)%c(1:nc,1:nc,:,ic) - adv_tendxyz(:,:,:,ic,ie) diff --git a/src/dynamics/se/dycore/dimensions_mod.F90 b/src/dynamics/se/dycore/dimensions_mod.F90 index 5f528b47b2..eb1564600c 100644 --- a/src/dynamics/se/dycore/dimensions_mod.F90 +++ b/src/dynamics/se/dycore/dimensions_mod.F90 @@ -15,7 +15,6 @@ module dimensions_mod #else integer, parameter :: ntrac_d = 0 ! No fvm tracers if CSLAM is off #endif - ! ! The variables below hold indices of water vapor and condensate loading tracers as well as ! associated heat capacities (initialized in dyn_init): @@ -36,8 +35,9 @@ module dimensions_mod integer, parameter, public :: nc = 3 !cslam resolution integer , public :: fv_nphys !physics-grid resolution - the "MAX" is so that the code compiles with NC=0 - integer :: ntrac = 0 !ntrac is set in dyn_comp - integer :: qsize = 0 !qsize is set in dyn_comp + integer :: ntrac = 0 !ntrac is set in dyn_comp + logical, public :: use_cslam = .false. !logical for CSLAM + integer :: qsize = 0 !qsize is set in dyn_comp ! ! fvm dimensions: logical, public :: lprint!for debugging diff --git a/src/dynamics/se/dycore/fvm_mod.F90 b/src/dynamics/se/dycore/fvm_mod.F90 index 93aa41a008..c55358a063 100644 --- a/src/dynamics/se/dycore/fvm_mod.F90 +++ b/src/dynamics/se/dycore/fvm_mod.F90 @@ -290,14 +290,14 @@ subroutine fvm_init1(par,elem) use control_mod, only: rsplit use dimensions_mod, only: qsize, qsize_d use dimensions_mod, only: fvm_supercycling, fvm_supercycling_jet - use dimensions_mod, only: nc,nhe, nhc, nlev,ntrac, ntrac_d,ns, nhr + use dimensions_mod, only: nc,nhe, nhc, nlev,ntrac, ntrac_d,ns, nhr, use_cslam use dimensions_mod, only: large_Courant_incr use dimensions_mod, only: kmin_jet,kmax_jet type (parallel_t) :: par type (element_t),intent(inout) :: elem(:) ! - if (ntrac>0) then + if (use_cslam) then if (par%masterproc) then write(iulog,*) " " write(iulog,*) "|-----------------------------------------|" @@ -305,7 +305,7 @@ subroutine fvm_init1(par,elem) write(iulog,*) "|-----------------------------------------|" write(iulog,*) " " end if - if (ntrac>0) then + if (use_cslam) then if (par%masterproc) then write(iulog,*) "Running consistent SE-CSLAM, Lauritzen et al. (2017, MWR)." write(iulog,*) "CSLAM = Conservative Semi-LAgrangian Multi-tracer scheme" @@ -517,8 +517,8 @@ end subroutine fvm_init2 subroutine fvm_init3(elem,fvm,hybrid,nets,nete,irecons) use control_mod , only: neast, nwest, seast, swest use fvm_analytic_mod, only: compute_reconstruct_matrix - use dimensions_mod , only: fv_nphys - use dimensions_mod, only: nlev, nc, nhe, nlev, ntrac, ntrac_d,nhc + use dimensions_mod , only: fv_nphys, use_cslam + use dimensions_mod, only: nlev, nc, nhe, nlev, nhc use coordinate_systems_mod, only: cartesian2D_t,cartesian3D_t use coordinate_systems_mod, only: cubedsphere2cart, cart2cubedsphere implicit none @@ -536,7 +536,7 @@ subroutine fvm_init3(elem,fvm,hybrid,nets,nete,irecons) type (cartesian2D_t) :: gnom type(cartesian3D_t) :: tmpcart3d - if (ntrac>0.and.nc.ne.fv_nphys) then + if (use_cslam.and.nc.ne.fv_nphys) then ! ! fill the fvm halo for mapping in d_p_coupling if ! physics grid resolution is different than fvm resolution @@ -728,7 +728,6 @@ subroutine fvm_pg_init(elem, fvm, hybrid, nets, nete,irecons) use control_mod, only : neast, nwest, seast, swest use coordinate_systems_mod, only : cubedsphere2cart, cart2cubedsphere use dimensions_mod, only: fv_nphys, nhe_phys,nhc_phys - use dimensions_mod, only: ntrac_d use cube_mod ,only: dmap use control_mod ,only: cubed_sphere_map use fvm_analytic_mod, only: compute_reconstruct_matrix diff --git a/src/dynamics/se/dycore/global_norms_mod.F90 b/src/dynamics/se/dycore/global_norms_mod.F90 index 2761a59b9c..843fd88bc7 100644 --- a/src/dynamics/se/dycore/global_norms_mod.F90 +++ b/src/dynamics/se/dycore/global_norms_mod.F90 @@ -32,7 +32,7 @@ module global_norms_mod contains - subroutine global_integrals(elem, h,hybrid,npts,num_flds,nets,nete,I_sphere) + subroutine global_integrals(elem,fld,hybrid,npts,num_flds,nets,nete,I_sphere) use hybrid_mod, only: hybrid_t use element_mod, only: element_t use dimensions_mod, only: np @@ -41,7 +41,7 @@ subroutine global_integrals(elem, h,hybrid,npts,num_flds,nets,nete,I_sphere) type(element_t) , intent(in) :: elem(:) integer , intent(in) :: npts,nets,nete,num_flds - real (kind=r8), intent(in) :: h(npts,npts,num_flds,nets:nete) + real (kind=r8), intent(in) :: fld(npts,npts,num_flds,nets:nete) type (hybrid_t) , intent(in) :: hybrid real (kind=r8) :: I_sphere(num_flds) @@ -63,7 +63,7 @@ subroutine global_integrals(elem, h,hybrid,npts,num_flds,nets,nete,I_sphere) do j=1,np do i=1,np da = elem(ie)%mp(i,j)*elem(ie)%metdet(i,j) - J_tmp(ie,q) = J_tmp(ie,q) + da*h(i,j,q,ie) + J_tmp(ie,q) = J_tmp(ie,q) + da*fld(i,j,q,ie) end do end do end do @@ -75,13 +75,13 @@ subroutine global_integrals(elem, h,hybrid,npts,num_flds,nets,nete,I_sphere) I_sphere(:) =global_shared_sum(1:num_flds) /(4.0_r8*PI) end subroutine global_integrals - subroutine global_integrals_general(h,hybrid,npts,da,num_flds,nets,nete,I_sphere) + subroutine global_integrals_general(fld,hybrid,npts,da,num_flds,nets,nete,I_sphere) use hybrid_mod, only: hybrid_t use physconst, only: pi use parallel_mod, only: global_shared_buf, global_shared_sum integer, intent(in) :: npts,nets,nete,num_flds - real (kind=r8), intent(in) :: h(npts,npts,num_flds,nets:nete) + real (kind=r8), intent(in) :: fld(npts,npts,num_flds,nets:nete) type (hybrid_t), intent(in) :: hybrid real (kind=r8), intent(in) :: da(npts,npts,nets:nete) @@ -102,7 +102,7 @@ subroutine global_integrals_general(h,hybrid,npts,da,num_flds,nets,nete,I_sphere do q=1,num_flds do j=1,npts do i=1,npts - J_tmp(ie,q) = J_tmp(ie,q) + da(i,j,ie)*h(i,j,q,ie) + J_tmp(ie,q) = J_tmp(ie,q) + da(i,j,ie)*fld(i,j,q,ie) end do end do end do @@ -123,7 +123,7 @@ end subroutine global_integrals_general ! ! ================================ ! -------------------------- - function global_integral_elem(elem, h,hybrid,npts,nets,nete) result(I_sphere) + function global_integral_elem(elem,fld,hybrid,npts,nets,nete) result(I_sphere) use hybrid_mod, only: hybrid_t use element_mod, only: element_t use dimensions_mod, only: np @@ -132,7 +132,7 @@ function global_integral_elem(elem, h,hybrid,npts,nets,nete) result(I_sphere) type(element_t) , intent(in) :: elem(:) integer , intent(in) :: npts,nets,nete - real (kind=r8), intent(in) :: h(npts,npts,nets:nete) + real (kind=r8), intent(in) :: fld(npts,npts,nets:nete) type (hybrid_t) , intent(in) :: hybrid real (kind=r8) :: I_sphere @@ -154,7 +154,7 @@ function global_integral_elem(elem, h,hybrid,npts,nets,nete) result(I_sphere) do j=1,np do i=1,np da = elem(ie)%mp(i,j)*elem(ie)%metdet(i,j) - J_tmp(ie) = J_tmp(ie) + da*h(i,j,ie) + J_tmp(ie) = J_tmp(ie) + da*fld(i,j,ie) end do end do end do @@ -167,7 +167,7 @@ function global_integral_elem(elem, h,hybrid,npts,nets,nete) result(I_sphere) end function global_integral_elem - function global_integral_fvm(fvm, h,hybrid,npts,nets,nete) result(I_sphere) + function global_integral_fvm(fvm,fld,hybrid,npts,nets,nete) result(I_sphere) use hybrid_mod, only: hybrid_t use fvm_control_volume_mod, only: fvm_struct use physconst, only: pi @@ -175,7 +175,7 @@ function global_integral_fvm(fvm, h,hybrid,npts,nets,nete) result(I_sphere) type (fvm_struct) , intent(in) :: fvm(:) integer , intent(in) :: npts,nets,nete - real (kind=r8), intent(in) :: h(npts,npts,nets:nete) + real (kind=r8), intent(in) :: fld(npts,npts,nets:nete) type (hybrid_t) , intent(in) :: hybrid real (kind=r8) :: I_sphere @@ -196,7 +196,7 @@ function global_integral_fvm(fvm, h,hybrid,npts,nets,nete) result(I_sphere) do j=1,npts do i=1,npts da = fvm(ie)%area_sphere(i,j) - J_tmp(ie) = J_tmp(ie) + da*h(i,j,ie) + J_tmp(ie) = J_tmp(ie) + da*fld(i,j,ie) end do end do end do @@ -231,7 +231,7 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& ! use hybrid_mod, only: hybrid_t use element_mod, only: element_t - use dimensions_mod, only: np,ne,nelem,nc,nhe,ntrac,nlev,large_Courant_incr + use dimensions_mod, only: np,ne,nelem,nc,nhe,use_cslam,nlev,large_Courant_incr use dimensions_mod, only: nu_scale_top,nu_div_lev,nu_lev,nu_t_lev use quadrature_mod, only: gausslobatto, quadrature_t @@ -280,7 +280,7 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& real (kind=r8) :: dt_max_hypervis, dt_max_hypervis_tracer, dt_max_laplacian_top real(kind=r8) :: I_sphere, nu_max, nu_div_max - real(kind=r8) :: h(np,np,nets:nete) + real(kind=r8) :: fld(np,np,nets:nete) logical :: top_000_032km, top_032_042km, top_042_090km, top_090_140km, top_140_600km ! model top location ranges logical :: nu_set,div_set,lev_set @@ -335,9 +335,9 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& ! !****************************************************************************************** ! - h(:,:,nets:nete)=1.0_r8 + fld(:,:,nets:nete)=1.0_r8 ! Calculate surface area by integrating 1.0_r8 over sphere and dividing by 4*PI (Should be 1) - I_sphere = global_integral(elem, h(:,:,nets:nete),hybrid,np,nets,nete) + I_sphere = global_integral(elem, fld(:,:,nets:nete),hybrid,np,nets,nete) min_normDinv = 1E99_r8 max_normDinv = 0 @@ -743,7 +743,7 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& dt_max_adv = S_rk/(umax*max_normDinv*lambda_max*ra) dt_max_gw = S_rk/(ugw*max_normDinv*lambda_max*ra) dt_max_tracer_se = S_rk_tracer*min_gw/(umax*max_normDinv*ra) - if (ntrac>0) then + if (use_cslam) then if (large_Courant_incr) then dt_max_tracer_fvm = dble(nhe)*(4.0_r8*pi*Rearth/dble(4.0_r8*ne*nc))/umax else @@ -780,7 +780,7 @@ subroutine print_cfl(elem,hybrid,nets,nete,dtnu,ptop,pmid,& dt_tracer_visco_actual,'s' if (dt_tracer_visco_actual>dt_max_hypervis_tracer) write(iulog,*) 'WARNING: dt_tracer_hypervis theoretically unstable' - if (ntrac>0) then + if (use_cslam) then write(iulog,'(a,f10.2,a,f10.2,a)') '* dt_tracer_fvm (time-stepping tracers ; q ) < ',dt_max_tracer_fvm,& 's ',dt_tracer_fvm_actual if (dt_tracer_fvm_actual>dt_max_tracer_fvm) write(iulog,*) 'WARNING: dt_tracer_fvm theortically unstable' @@ -819,13 +819,13 @@ end subroutine print_cfl ! ! ================================ - function global_maximum(h,hybrid,npts,nets,nete) result(Max_sphere) + function global_maximum(fld,hybrid,npts,nets,nete) result(Max_sphere) use hybrid_mod, only : hybrid_t use reduction_mod, only : red_max, pmax_mt integer , intent(in) :: npts,nets,nete - real (kind=r8), intent(in) :: h(npts,npts,nets:nete) + real (kind=r8), intent(in) :: fld(npts,npts,nets:nete) type (hybrid_t) , intent(in) :: hybrid real (kind=r8) :: Max_sphere @@ -834,7 +834,7 @@ function global_maximum(h,hybrid,npts,nets,nete) result(Max_sphere) real (kind=r8) :: redp(1) - Max_sphere = MAXVAL(h(:,:,nets:nete)) + Max_sphere = MAXVAL(fld(:,:,nets:nete)) redp(1) = Max_sphere call pmax_mt(red_max,redp,1,hybrid) @@ -849,39 +849,39 @@ end function global_maximum ! for a scalar quantity ! =========================================================== - function l1_snorm(elem, h,ht,hybrid,npts,nets,nete) result(l1) + function l1_snorm(elem,fld,fld_exact,hybrid,npts,nets,nete) result(l1) use element_mod, only : element_t use hybrid_mod, only : hybrid_t type(element_t) , intent(in) :: elem(:) integer , intent(in) :: npts,nets,nete - real (kind=r8), intent(in) :: h(npts,npts,nets:nete) ! computed soln - real (kind=r8), intent(in) :: ht(npts,npts,nets:nete) ! true soln + real (kind=r8), intent(in) :: fld(npts,npts,nets:nete) ! computed soln + real (kind=r8), intent(in) :: fld_exact(npts,npts,nets:nete) ! true soln type (hybrid_t) , intent(in) :: hybrid real (kind=r8) :: l1 ! Local variables - real (kind=r8) :: dhabs(npts,npts,nets:nete) - real (kind=r8) :: htabs(npts,npts,nets:nete) - real (kind=r8) :: dhabs_int - real (kind=r8) :: htabs_int + real (kind=r8) :: dfld_abs(npts,npts,nets:nete) + real (kind=r8) :: fld_exact_abs(npts,npts,nets:nete) + real (kind=r8) :: dfld_abs_int + real (kind=r8) :: fld_exact_abs_int integer i,j,ie do ie=nets,nete do j=1,npts do i=1,npts - dhabs(i,j,ie) = ABS(h(i,j,ie)-ht(i,j,ie)) - htabs(i,j,ie) = ABS(ht(i,j,ie)) + dfld_abs(i,j,ie) = ABS(fld(i,j,ie)-fld_exact(i,j,ie)) + fld_exact_abs(i,j,ie) = ABS(fld_exact(i,j,ie)) end do end do end do - dhabs_int = global_integral(elem, dhabs(:,:,nets:nete),hybrid,npts,nets,nete) - htabs_int = global_integral(elem, htabs(:,:,nets:nete),hybrid,npts,nets,nete) + dfld_abs_int = global_integral(elem, dfld_abs(:,:,nets:nete),hybrid,npts,nets,nete) + fld_exact_abs_int = global_integral(elem, fld_exact_abs(:,:,nets:nete),hybrid,npts,nets,nete) - l1 = dhabs_int/htabs_int + l1 = dfld_abs_int/fld_exact_abs_int end function l1_snorm @@ -957,38 +957,38 @@ end function l1_vnorm ! ! =========================================================== - function l2_snorm(elem, h,ht,hybrid,npts,nets,nete) result(l2) + function l2_snorm(elem,fld,fld_exact,hybrid,npts,nets,nete) result(l2) use element_mod, only : element_t use hybrid_mod, only : hybrid_t type(element_t), intent(in) :: elem(:) integer , intent(in) :: npts,nets,nete - real (kind=r8), intent(in) :: h(npts,npts,nets:nete) ! computed soln - real (kind=r8), intent(in) :: ht(npts,npts,nets:nete) ! true soln + real (kind=r8), intent(in) :: fld(npts,npts,nets:nete) ! computed soln + real (kind=r8), intent(in) :: fld_exact(npts,npts,nets:nete) ! true soln type (hybrid_t) , intent(in) :: hybrid real (kind=r8) :: l2 ! Local variables real (kind=r8) :: dh2(npts,npts,nets:nete) - real (kind=r8) :: ht2(npts,npts,nets:nete) + real (kind=r8) :: fld_exact2(npts,npts,nets:nete) real (kind=r8) :: dh2_int - real (kind=r8) :: ht2_int + real (kind=r8) :: fld_exact2_int integer i,j,ie do ie=nets,nete do j=1,npts do i=1,npts - dh2(i,j,ie)=(h(i,j,ie)-ht(i,j,ie))**2 - ht2(i,j,ie)=ht(i,j,ie)**2 + dh2(i,j,ie)=(fld(i,j,ie)-fld_exact(i,j,ie))**2 + fld_exact2(i,j,ie)=fld_exact(i,j,ie)**2 end do end do end do dh2_int = global_integral(elem,dh2(:,:,nets:nete),hybrid,npts,nets,nete) - ht2_int = global_integral(elem,ht2(:,:,nets:nete),hybrid,npts,nets,nete) + fld_exact2_int = global_integral(elem,fld_exact2(:,:,nets:nete),hybrid,npts,nets,nete) - l2 = SQRT(dh2_int)/SQRT(ht2_int) + l2 = SQRT(dh2_int)/SQRT(fld_exact2_int) end function l2_snorm @@ -1063,35 +1063,35 @@ end function l2_vnorm ! ! =========================================================== - function linf_snorm(h,ht,hybrid,npts,nets,nete) result(linf) + function linf_snorm(fld,fld_exact,hybrid,npts,nets,nete) result(linf) use hybrid_mod, only : hybrid_t integer , intent(in) :: npts,nets,nete - real (kind=r8), intent(in) :: h(npts,npts,nets:nete) ! computed soln - real (kind=r8), intent(in) :: ht(npts,npts,nets:nete) ! true soln + real (kind=r8), intent(in) :: fld(npts,npts,nets:nete) ! computed soln + real (kind=r8), intent(in) :: fld_exact(npts,npts,nets:nete) ! true soln type (hybrid_t) , intent(in) :: hybrid real (kind=r8) :: linf ! Local variables - real (kind=r8) :: dhabs(npts,npts,nets:nete) - real (kind=r8) :: htabs(npts,npts,nets:nete) - real (kind=r8) :: dhabs_max - real (kind=r8) :: htabs_max + real (kind=r8) :: dfld_abs(npts,npts,nets:nete) + real (kind=r8) :: fld_exact_abs(npts,npts,nets:nete) + real (kind=r8) :: dfld_abs_max + real (kind=r8) :: fld_exact_abs_max integer i,j,ie do ie=nets,nete do j=1,npts do i=1,npts - dhabs(i,j,ie)=ABS(h(i,j,ie)-ht(i,j,ie)) - htabs(i,j,ie)=ABS(ht(i,j,ie)) + dfld_abs(i,j,ie)=ABS(fld(i,j,ie)-fld_exact(i,j,ie)) + fld_exact_abs(i,j,ie)=ABS(fld_exact(i,j,ie)) end do end do end do - dhabs_max = global_maximum(dhabs(:,:,nets:nete),hybrid,npts,nets,nete) - htabs_max = global_maximum(htabs(:,:,nets:nete),hybrid,npts,nets,nete) + dfld_abs_max = global_maximum(dfld_abs(:,:,nets:nete),hybrid,npts,nets,nete) + fld_exact_abs_max = global_maximum(fld_exact_abs(:,:,nets:nete),hybrid,npts,nets,nete) - linf = dhabs_max/htabs_max + linf = dfld_abs_max/fld_exact_abs_max end function linf_snorm diff --git a/src/dynamics/se/dycore/hybrid_mod.F90 b/src/dynamics/se/dycore/hybrid_mod.F90 index 19f1043a92..5e7b4208ca 100644 --- a/src/dynamics/se/dycore/hybrid_mod.F90 +++ b/src/dynamics/se/dycore/hybrid_mod.F90 @@ -7,7 +7,7 @@ module hybrid_mod use parallel_mod , only : parallel_t, copy_par use thread_mod , only : omp_set_num_threads, omp_get_thread_num use thread_mod , only : horz_num_threads, vert_num_threads, tracer_num_threads -use dimensions_mod, only : nlev, qsize, ntrac +use dimensions_mod, only : nlev, qsize, ntrac, use_cslam implicit none private @@ -241,7 +241,7 @@ subroutine init_loop_ranges(nelemd) work_pool_trac(ith+1,2) = end_index end do - if(ntrac>0 .and. ntrac0) then + if ((cubed_sphere_map /= 0) .AND. use_cslam) then if (par%masterproc) then write(iulog, *) subname, 'fvm transport and require equi-angle gnomonic cube sphere mapping.' write(iulog, *) ' Set cubed_sphere_map = 0 or comment it out all together. ' diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index 15cb209888..1dbf3d1ef8 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -262,7 +262,7 @@ end subroutine prim_advance_exp subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsubstep) - use dimensions_mod, only: np, nc, nlev, qsize, ntrac + use dimensions_mod, only: np, nc, nlev, qsize, ntrac, use_cslam use element_mod, only: element_t use control_mod, only: ftype, ftype_conserve use fvm_control_volume_mod, only: fvm_struct @@ -282,7 +282,7 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu real (kind=r8), allocatable :: ftmp_fvm(:,:,:,:,:) !diagnostics - if (ntrac>0) allocate(ftmp_fvm(nc,nc,nlev,ntrac,nets:nete)) + if (use_cslam) allocate(ftmp_fvm(nc,nc,nlev,ntrac,nets:nete)) if (ftype==0) then ! @@ -314,7 +314,7 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu ! do state-update for tracers and "dribbling" forcing for u,v,T ! dt_local = dt_dribble - if (ntrac>0) then + if (use_cslam) then dt_local_tracer = dt_dribble dt_local_tracer_fvm = dt_phys if (nsubstep.ne.1) then @@ -363,7 +363,7 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu else ftmp(:,:,:,:,ie) = 0.0_r8 end if - if (ntrac>0.and.dt_local_tracer_fvm>0) then + if (use_cslam.and.dt_local_tracer_fvm>0) then ! ! Repeat for the fvm tracers: fc holds tendency (fc_new-fc_old)/dt_physics ! @@ -387,7 +387,7 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu end do end do else - if (ntrac>0) ftmp_fvm(:,:,:,:,ie) = 0.0_r8 + if (use_cslam) ftmp_fvm(:,:,:,:,ie) = 0.0_r8 end if if (ftype_conserve==1) then @@ -416,13 +416,13 @@ subroutine applyCAMforcing(elem,fvm,np1,np1_qdp,dt_dribble,dt_phys,nets,nete,nsu dt_local*elem(ie)%derived%FM(:,:,:,:) end if end do - if (ntrac>0) then + if (use_cslam) then call output_qdp_var_dynamics(ftmp_fvm(:,:,:,:,:),nc,ntrac,nets,nete,'PDC') else call output_qdp_var_dynamics(ftmp(:,:,:,:,:),np,qsize,nets,nete,'PDC') end if if (ftype==1.and.nsubstep==1) call tot_energy_dyn(elem,fvm,nets,nete,np1,np1_qdp,'p2d') - if (ntrac>0) deallocate(ftmp_fvm) + if (use_cslam) deallocate(ftmp_fvm) end subroutine applyCAMforcing @@ -438,7 +438,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, ! use physconst, only: cappa, cpair use cam_thermo, only: get_molecular_diff_coef, get_rho_dry - use dimensions_mod, only: np, nlev, nc, ntrac, npsq, qsize, ksponge_end + use dimensions_mod, only: np, nlev, nc, use_cslam, npsq, qsize, ksponge_end use dimensions_mod, only: nu_scale_top,nu_lev,kmvis_ref,kmcnd_ref,rho_ref,km_sponge_factor use dimensions_mod, only: nu_t_lev use control_mod, only: nu, nu_t, hypervis_subcycle,hypervis_subcycle_sponge, nu_p, nu_top @@ -541,7 +541,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, enddo enddo - if (ntrac>0) then + if (use_cslam) then !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,nc @@ -593,7 +593,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, kptr = kbeg - 1 + 2*nlev call edgeVunpack(edge3,vtens(:,:,2,kbeg:kend,ie),kblk,kptr,ie) - if (ntrac>0) then + if (use_cslam) then do k=kbeg,kend temp(:,:,k) = elem(ie)%state%dp3d(:,:,k,nt) / elem(ie)%spheremp ! STATE before DSS corners(0:np+1,0:np+1,k) = 0.0_r8 @@ -603,7 +603,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, kptr = kbeg - 1 + 3*nlev call edgeVunpack(edge3,elem(ie)%state%dp3d(:,:,kbeg:kend,nt),kblk,kptr,ie) - if (ntrac>0) then + if (use_cslam) then desc = elem(ie)%desc kptr = kbeg - 1 + 3*nlev @@ -818,7 +818,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, end do end if - if (ntrac>0.and.nu_dp>0) then + if (use_cslam.and.nu_dp>0) then ! ! mass flux for CSLAM due to sponge layer diffusion on dp ! @@ -866,7 +866,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, kptr = 2*ksponge_end call edgeVunpack(edgeSponge,vtens(:,:,2,1:ksponge_end,ie),kblk,kptr,ie) - if (ntrac>0.and.nu_dp>0.0_r8) then + if (use_cslam.and.nu_dp>0.0_r8) then do k=1,ksponge_end temp(:,:,k) = elem(ie)%state%dp3d(:,:,k,nt) / elem(ie)%spheremp ! STATE before DSS corners(0:np+1,0:np+1,k) = 0.0_r8 @@ -876,7 +876,7 @@ subroutine advance_hypervis_dp(edge3,elem,fvm,hybrid,deriv,nt,qn0,nets,nete,dt2, kptr = 3*ksponge_end call edgeVunpack(edgeSponge,elem(ie)%state%dp3d(:,:,1:ksponge_end,nt),kblk,kptr,ie) - if (ntrac>0.and.nu_dp>0.0_r8) then + if (use_cslam.and.nu_dp>0.0_r8) then desc = elem(ie)%desc kptr = 3*ksponge_end @@ -975,7 +975,7 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& ! allows us to fuse these two loops for more cache reuse ! ! =================================== - use dimensions_mod, only: np, nc, nlev, ntrac + use dimensions_mod, only: np, nc, nlev, use_cslam use hybrid_mod, only: hybrid_t use element_mod, only: element_t use derivative_mod, only: derivative_t, divergence_sphere, gradient_sphere, vorticity_sphere @@ -1262,7 +1262,7 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& enddo - if (ntrac>0.and.eta_ave_w.ne.0._r8) then + if (use_cslam.and.eta_ave_w.ne.0._r8) then !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,np @@ -1305,7 +1305,7 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& kptr=nlev call edgeVunpack(edge3, elem(ie)%state%v(:,:,:,:,np1), 2*nlev, kptr, ie) - if (ntrac>0.and.eta_ave_w.ne.0._r8) then + if (use_cslam.and.eta_ave_w.ne.0._r8) then do k=1,nlev stashdp3d(:,:,k) = elem(ie)%state%dp3d(:,:,k,np1)/elem(ie)%spheremp(:,:) end do @@ -1316,7 +1316,7 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& kptr=kptr+2*nlev call edgeVunpack(edge3, elem(ie)%state%dp3d(:,:,:,np1),nlev,kptr,ie) - if (ntrac>0.and.eta_ave_w.ne.0._r8) then + if (use_cslam.and.eta_ave_w.ne.0._r8) then desc = elem(ie)%desc call edgeDGVunpack(edge3, corners, nlev, kptr, ie) @@ -1436,7 +1436,7 @@ subroutine distribute_flux_at_corners(cflux, corners, getmapP) end subroutine distribute_flux_at_corners subroutine tot_energy_dyn(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suffix) - use dimensions_mod, only: npsq,nlev,np,nc,ntrac,qsize + use dimensions_mod, only: npsq,nlev,np,nc,use_cslam,qsize use physconst, only: gravit, cpair, rearth, omega use element_mod, only: element_t use cam_history, only: outfld @@ -1500,7 +1500,7 @@ subroutine tot_energy_dyn(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suffix) name_out(i)=trim(thermo_budget_vars(i))//'_'//trim(outfld_name_suffix) end do - if (ntrac>0) then + if (use_cslam) then ixwv = 1 call cnst_get_ind('CLDLIQ' , ixcldliq, abort=.false.) call cnst_get_ind('CLDICE' , ixcldice, abort=.false.) @@ -1548,7 +1548,7 @@ subroutine tot_energy_dyn(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suffix) ! ! mass variables are output on CSLAM grid if using CSLAM else GLL grid ! - if (ntrac>0) then + if (use_cslam) then if (ixwv>0) then cdp_fvm = fvm(ie)%c(1:nc,1:nc,:,ixwv)*fvm(ie)%dp_fvm(1:nc,1:nc,:) call util_function(cdp_fvm,nc,nlev,name_out(wvidx),ie) diff --git a/src/dynamics/se/dycore/prim_driver_mod.F90 b/src/dynamics/se/dycore/prim_driver_mod.F90 index 8538156882..6196c525ab 100644 --- a/src/dynamics/se/dycore/prim_driver_mod.F90 +++ b/src/dynamics/se/dycore/prim_driver_mod.F90 @@ -26,7 +26,7 @@ module prim_driver_mod subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) use dimensions_mod, only: irecons_tracer, fvm_supercycling - use dimensions_mod, only: fv_nphys, ntrac, nc + use dimensions_mod, only: fv_nphys, nc use parallel_mod, only: syncmp use time_mod, only: timelevel_t, tstep, phys_tscale, nsplit, TimeLevel_Qdp use time_mod, only: nsplit_baseline,rsplit_baseline @@ -227,7 +227,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst use thread_mod, only: omp_get_thread_num use perf_mod , only: t_startf, t_stopf use fvm_mod , only: fill_halo_fvm, ghostBufQnhc_h - use dimensions_mod, only: ntrac,fv_nphys, ksponge_end + use dimensions_mod, only: use_cslam,fv_nphys, ksponge_end type (element_t) , intent(inout) :: elem(:) type(fvm_struct), intent(inout) :: fvm(:) @@ -378,7 +378,7 @@ subroutine prim_run_subcycle(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord,nsubst call prim_printstate(elem, tl, hybrid,nets,nete, fvm, omega_cn) end if - if (ntrac>0.and.nsubstep==nsplit.and.nc.ne.fv_nphys) then + if (use_cslam.and.nsubstep==nsplit.and.nc.ne.fv_nphys) then ! ! fill the fvm halo for mapping in d_p_coupling if ! physics grid resolution is different than fvm resolution @@ -414,7 +414,7 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) use prim_advection_mod, only: prim_advec_tracers_remap, prim_advec_tracers_fvm, deriv use derivative_mod, only: subcell_integration use hybrid_mod, only: set_region_num_threads, config_thread_region, get_loop_ranges - use dimensions_mod, only: ntrac,fvm_supercycling,fvm_supercycling_jet + use dimensions_mod, only: use_cslam,fvm_supercycling,fvm_supercycling_jet use dimensions_mod, only: kmin_jet, kmax_jet use fvm_mod, only: ghostBufQnhc_vh,ghostBufQ1_vh, ghostBufFlux_vh use fvm_mod, only: ghostBufQ1_h,ghostBufQnhcJet_h, ghostBufFluxJet_h @@ -493,7 +493,7 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) ! defer final timelevel update until after Q update. enddo #ifdef HOMME_TEST_SUB_ELEMENT_MASS_FLUX - if (ntrac>0.and.rstep==1) then + if (use_cslam.and.rstep==1) then do ie=nets,nete do k=1,nlev tempdp3d = elem(ie)%state%dp3d(:,:,k,tl%np1) - & @@ -540,7 +540,7 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) if (qsize > 0) then call t_startf('prim_advec_tracers_remap') - if(ntrac>0) then + if(use_cslam) then ! Deactivate threading in the tracer dimension if this is a CSLAM run region_num_threads = 1 else @@ -548,7 +548,7 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) endif call omp_set_nested(.true.) !$OMP PARALLEL NUM_THREADS(region_num_threads), DEFAULT(SHARED), PRIVATE(hybridnew) - if(ntrac>0) then + if(use_cslam) then ! Deactivate threading in the tracer dimension if this is a CSLAM run hybridnew = config_thread_region(hybrid,'serial') else @@ -562,7 +562,7 @@ subroutine prim_step(elem, fvm, hybrid,nets,nete, dt, tl, hvcoord, rstep) ! ! only run fvm transport every fvm_supercycling rstep ! - if (ntrac>0) then + if (use_cslam) then ! ! FVM transport ! diff --git a/src/dynamics/se/dycore/prim_state_mod.F90 b/src/dynamics/se/dycore/prim_state_mod.F90 index f01ffbd049..2f4bcbb2db 100644 --- a/src/dynamics/se/dycore/prim_state_mod.F90 +++ b/src/dynamics/se/dycore/prim_state_mod.F90 @@ -19,7 +19,7 @@ module prim_state_mod CONTAINS subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) - use dimensions_mod, only: ntrac + use dimensions_mod, only: use_cslam use constituents, only: cnst_name use air_composition, only: thermodynamic_active_species_idx_dycore, dry_air_species_num use air_composition, only: thermodynamic_active_species_num,thermodynamic_active_species_idx @@ -60,7 +60,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) n0=tl%n0 call TimeLevel_Qdp( tl, qsplit, n0_qdp) ! moist surface pressure - if (ntrac>0) then + if (use_cslam) then do ie=nets,nete moist_ps_fvm(:,:,ie)=SUM(fvm(ie)%dp_fvm(1:nc,1:nc,:),DIM=3) do q=dry_air_species_num+1,thermodynamic_active_species_num @@ -86,7 +86,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) do ie=nets,nete da_gll(:,:,ie) = elem(ie)%mp(:,:)*elem(ie)%metdet(:,:) enddo - if (ntrac>0) then + if (use_cslam) then do ie=nets,nete da_fvm(:,:,ie) = fvm(ie)%area_sphere(:,:) enddo @@ -103,7 +103,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) varname(3) = 'T ' varname(4) = 'OMEGA ' varname(5) = 'OMEGA CN ' - if (ntrac>0) then + if (use_cslam) then varname(6) = 'PSDRY(fvm)' varname(7) = 'PS(fvm) ' varname(8) = 'PSDRY(gll)' @@ -133,7 +133,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) min_local(ie,5) = 0.0_r8 max_local(ie,5) = 0.0_r8 end if - if (ntrac>0) then + if (use_cslam) then min_local(ie,6) = MINVAL(SUM(fvm(ie)%dp_fvm(1:nc,1:nc,:),DIM=3)) max_local(ie,6) = MAXVAL(SUM(fvm(ie)%dp_fvm(1:nc,1:nc,:),DIM=3)) min_local(ie,7) = MINVAL(moist_ps_fvm(:,:,ie)) @@ -168,7 +168,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) max_local(ie,nm2+1) = MAXVAL(elem(ie)%derived%FT(:,:,:)) min_local(ie,nm2+2) = MINVAL(elem(ie)%derived%FM(:,:,:,:)) max_local(ie,nm2+2) = MAXVAL(elem(ie)%derived%FM(:,:,:,:)) - if (ntrac>0) then + if (use_cslam) then do q=1,statediag_numtrac varname(nm2+2+q) = TRIM('F'//TRIM(cnst_name(q))) min_local(ie,nm2+2+q) = MINVAL(fvm(ie)%fc(1:nc,1:nc,:,q)) @@ -201,7 +201,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) ! tracers ! mass = -1.0_r8 - if (ntrac>0) then + if (use_cslam) then do ie=nets,nete do q=1,statediag_numtrac tmp_fvm(:,:,q,ie) = SUM(fvm(ie)%c(1:nc,1:nc,:,q)*fvm(ie)%dp_fvm(1:nc,1:nc,:),DIM=3) @@ -243,7 +243,7 @@ subroutine prim_printstate(elem, tl,hybrid,nets,nete, fvm, omega_cn) if (tl%nstep==0.or..not. initial_run) then mass_chg(:) = 0.0_R8 elem(nets)%derived%mass(nm+1:nm+statediag_numtrac) = mass(nm+1:nm+statediag_numtrac) - if (ntrac>0) then + if (use_cslam) then elem(nets)%derived%mass(6:9) = mass(6:9) else elem(nets)%derived%mass(6:7) = mass(6:7) diff --git a/src/dynamics/se/dycore/viscosity_mod.F90 b/src/dynamics/se/dycore/viscosity_mod.F90 index 1240d4a15f..04b0a1a91d 100644 --- a/src/dynamics/se/dycore/viscosity_mod.F90 +++ b/src/dynamics/se/dycore/viscosity_mod.F90 @@ -52,7 +52,7 @@ module viscosity_mod subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid,nt,nets,nete,kbeg,kend,hvcoord) use derivative_mod, only : subcell_Laplace_fluxes - use dimensions_mod, only : ntrac, nu_div_lev,nu_lev + use dimensions_mod, only : use_cslam, nu_div_lev,nu_lev use hybvcoord_mod, only : hvcoord_t !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! compute weak biharmonic operator @@ -86,7 +86,7 @@ subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid, kblk = kend - kbeg + 1 - if (ntrac>0) dpflux = 0 + if (use_cslam) dpflux = 0 !if tensor hyperviscosity with tensor V is used, then biharmonic operator is (\grad\cdot V\grad) (\grad \cdot \grad) !so tensor is only used on second call to laplace_sphere_wk var_coef1 = .true. @@ -150,7 +150,7 @@ subroutine biharmonic_wk_dp3d(elem,dptens,dpflux,ttens,vtens,deriv,edge3,hybrid, kptr = kbeg - 1 + 3*nlev call edgeVunpack(edge3,dptens(:,:,kbeg:kend,ie),kblk,kptr,ie) - if (ntrac>0) then + if (use_cslam) then do k=1,nlev !CLEAN tmp(:,:)= rspheremv(:,:)*dptens(:,:,k,ie) tmp(:,:)= elem(ie)%rspheremp(:,:)*dptens(:,:,k,ie) diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index a3802edabf..28e3296608 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -21,7 +21,7 @@ subroutine print_budget(hstwr) use budgets, only: budget_get_global, is_budget, thermo_budget_histfile_num, thermo_budget_history use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv, & teidx, seidx, keidx, poidx - use dimensions_mod, only: ntrac + use dimensions_mod, only: use_cslam use control_mod, only: ftype ! arguments @@ -253,7 +253,7 @@ subroutine print_budget(hstwr) tmp = previous_dEdt_phys_dyn_coupl_err+previous_dEdt_adiabatic_dycore+previous_dEdt_dry_mass_adjust diff = abs_diff(-dEdt_efix_dynE(1),tmp,pf) - if (ntrac==0) then + if (.not.use_cslam) then write(iulog,*) "Check if that is the case:", pf, diff write(iulog,*) " " if (abs(diff)>eps) then @@ -282,7 +282,7 @@ subroutine print_budget(hstwr) write(iulog,*) " -dE/dt dynamics state mapped to GLL grid" end if write(iulog,*) "" - if (ntrac==0) then + if (.not.use_cslam) then dEdt_dycore_phys = -dEdt_efix_dynE(1)-previous_dEdt_phys_dyn_coupl_err-previous_dEdt_dry_mass_adjust write(iulog,*) "Hence the dycore E dissipation estimated from energy fixer " write(iulog,'(A39,F6.2,A6)') "based on previous time-step values is ",dEdt_dycore_phys," W/M^2" @@ -296,7 +296,7 @@ subroutine print_budget(hstwr) write(iulog,*) "Is globally integrated total energy of state at the end of dynamics (dBF)" write(iulog,*) "and beginning of physics (using dynamics in physics energy; dyBF) the same?" write(iulog,*) "" - if (ntrac==0) then + if (.not.use_cslam) then if (abs(E_dyBF(1))>eps) then diff = abs_diff(E_dBF(1),E_dyBF(1)) if (abs(diff)0) then + if (use_cslam) then allocate(kord_tr_cslam(ntrac)) kord_tr_cslam(:) = vert_remap_tracer_alg end if @@ -667,7 +669,7 @@ subroutine dyn_init(dyn_in, dyn_out) ! CSLAM tracers are always indexed as in physics ! of no CSLAM then SE tracers are always indexed as in physics ! - if (ntrac>0) then + if (use_cslam) then ! ! note that in this case qsize = thermodynamic_active_species_num ! @@ -691,7 +693,7 @@ subroutine dyn_init(dyn_in, dyn_out) end do do m=1,thermodynamic_active_species_liq_num - if (ntrac>0) then + if (use_cslam) then do mfound=1,qsize if (TRIM(cnst_name(thermodynamic_active_species_liq_idx(m)))==TRIM(cnst_name_gll(mfound))) then thermodynamic_active_species_liq_idx_dycore(m) = mfound @@ -705,7 +707,7 @@ subroutine dyn_init(dyn_in, dyn_out) end if end do do m=1,thermodynamic_active_species_ice_num - if (ntrac>0) then + if (use_cslam) then do mfound=1,qsize if (TRIM(cnst_name(thermodynamic_active_species_ice_idx(m)))==TRIM(cnst_name_gll(mfound))) then thermodynamic_active_species_ice_idx_dycore(m) = mfound @@ -851,7 +853,7 @@ subroutine dyn_init(dyn_in, dyn_out) call addfld ('FT', (/ 'lev' /), 'A', 'K/s', 'Temperature forcing term on GLL grid',gridname='GLL') ! Tracer forcing on fvm (CSLAM) grid and internal CSLAM pressure fields - if (ntrac>0) then + if (use_cslam) then do m = 1, ntrac call addfld (trim(cnst_name(m))//'_fvm', (/ 'lev' /), 'I', 'kg/kg', & trim(cnst_longname(m)), gridname='FVM') @@ -873,7 +875,7 @@ subroutine dyn_init(dyn_in, dyn_out) ! Energy diagnostics and axial angular momentum diagnostics call addfld ('ABS_dPSdt', horiz_only, 'A', 'Pa/s', 'Absolute surface pressure tendency',gridname='GLL') - if (ntrac>0) then + if (use_cslam) then #ifdef waccm_debug call addfld ('CSLAM_gamma', (/ 'lev' /), 'A', '', 'Courant number from CSLAM', gridname='FVM') #endif @@ -891,31 +893,31 @@ subroutine dyn_init(dyn_in, dyn_out) if (thermo_budget_history) then ! Register stages for budgets do istage = 1, num_stages - call e_m_snapshot(TRIM(ADJUSTL(stage(istage))), 'dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), cslam=ntrac>0) + call e_m_snapshot(TRIM(ADJUSTL(stage(istage))), 'dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), cslam=use_cslam) end do ! ! Register tendency (difference) budgets ! - call e_m_budget('dEdt_floating_dyn' ,'dAD','dBD','dyn','dif',longname="dE/dt floating dynamics (dAD-dBD)" ,cslam=ntrac>0) - call e_m_budget('dEdt_vert_remap' ,'dAR','dAD','dyn','dif',longname="dE/dt vertical remapping (dAR-dAD)" ,cslam=ntrac>0) - call e_m_budget('dEdt_phys_tot_in_dyn','dBD','dAF','dyn','dif',longname="dE/dt physics tendency in dynamics (dBD-dAF)" ,cslam=ntrac>0) - - call e_m_budget('dEdt_del4' ,'dCH','dBH','dyn','dif',longname="dE/dt del4 (dCH-dBH)" ,cslam=ntrac>0) - call e_m_budget('dEdt_del4_fric_heat','dAH','dCH','dyn','dif',longname="dE/dt del4 frictional heating (dAH-dCH)" ,cslam=ntrac>0) - call e_m_budget('dEdt_del4_tot' ,'dAH','dBH','dyn','dif',longname="dE/dt del4 + del4 frictional heating (dAH-dBH)",cslam=ntrac>0) - call e_m_budget('dEdt_del2_sponge' ,'dAS','dBS','dyn','dif',longname="dE/dt del2 sponge (dAS-dBS)" ,cslam=ntrac>0) + call e_m_budget('dEdt_floating_dyn' ,'dAD','dBD','dyn','dif',longname="dE/dt floating dynamics (dAD-dBD)" ,cslam=use_cslam) + call e_m_budget('dEdt_vert_remap' ,'dAR','dAD','dyn','dif',longname="dE/dt vertical remapping (dAR-dAD)" ,cslam=use_cslam) + call e_m_budget('dEdt_phys_tot_in_dyn','dBD','dAF','dyn','dif',longname="dE/dt physics tendency in dynamics (dBD-dAF)" ,cslam=use_cslam) + + call e_m_budget('dEdt_del4' ,'dCH','dBH','dyn','dif',longname="dE/dt del4 (dCH-dBH)" ,cslam=use_cslam) + call e_m_budget('dEdt_del4_fric_heat','dAH','dCH','dyn','dif',longname="dE/dt del4 frictional heating (dAH-dCH)" ,cslam=use_cslam) + call e_m_budget('dEdt_del4_tot' ,'dAH','dBH','dyn','dif',longname="dE/dt del4 + del4 frictional heating (dAH-dBH)",cslam=use_cslam) + call e_m_budget('dEdt_del2_sponge' ,'dAS','dBS','dyn','dif',longname="dE/dt del2 sponge (dAS-dBS)" ,cslam=use_cslam) ! ! Register derived budgets ! - call e_m_budget('dEdt_dycore' ,'dEdt_floating_dyn','dEdt_vert_remap' ,'dyn','sum',longname="dE/dt adiabatic dynamics" ,cslam=ntrac>0) - call e_m_budget('dEdt_del2_del4_tot' ,'dEdt_del4_tot' ,'dEdt_del2_sponge' ,'dyn','sum',longname="dE/dt explicit diffusion total",cslam=ntrac>0) + call e_m_budget('dEdt_dycore' ,'dEdt_floating_dyn','dEdt_vert_remap' ,'dyn','sum',longname="dE/dt adiabatic dynamics" ,cslam=use_cslam) + call e_m_budget('dEdt_del2_del4_tot' ,'dEdt_del4_tot' ,'dEdt_del2_sponge' ,'dyn','sum',longname="dE/dt explicit diffusion total",cslam=use_cslam) call e_m_budget('dEdt_residual' ,'dEdt_floating_dyn','dEdt_del2_del4_tot','dyn','dif',& - longname="dE/dt residual (dEdt_floating_dyn-dEdt_del2_del4_tot)",cslam=ntrac>0) + longname="dE/dt residual (dEdt_floating_dyn-dEdt_del2_del4_tot)",cslam=use_cslam) end if ! ! add dynamical core tracer tendency output ! - if (ntrac>0) then + if (use_cslam) then do m = 1, pcnst call addfld(tottnam(m),(/ 'lev' /),'A','kg/kg/s',trim(cnst_name(m))//' horz + vert', & gridname='FVM') @@ -1059,7 +1061,7 @@ subroutine dyn_run(dyn_state) end if - if (ntrac > 0) then + if (use_cslam) then do ie = nets, nete do m = 1, ntrac do k = 1, nlev @@ -1673,7 +1675,7 @@ subroutine read_inidat(dyn_in) ! if CSLAM active then we only advect water vapor and condensate ! loading tracers in state%qdp - if (ntrac > 0) then + if (use_cslam) then do ie = 1, nelemd do nq = 1, thermodynamic_active_species_num m_cnst = thermodynamic_active_species_idx(nq) @@ -1704,7 +1706,7 @@ subroutine read_inidat(dyn_in) ! interpolate fvm tracers and fvm pressure variables - if (ntrac > 0) then + if (use_cslam) then if (par%masterproc) then write(iulog,*) 'Initializing dp_fvm from spectral element dp' end if @@ -1726,7 +1728,7 @@ subroutine read_inidat(dyn_in) write(iulog,*) 'FVM tracers, FVM pressure variables and se_area_sphere initialized.' end if - end if ! (ntrac > 0) + end if ! (use_cslam) ! Cleanup deallocate(qtmp) @@ -2271,7 +2273,7 @@ subroutine write_dyn_vars(dyn_out) integer :: ie, m !---------------------------------------------------------------------------- - if (ntrac > 0) then + if (use_cslam) then do ie = 1, nelemd call outfld('dp_fvm', RESHAPE(dyn_out%fvm(ie)%dp_fvm(1:nc,1:nc,:), & (/nc*nc,nlev/)), nc*nc, ie) diff --git a/src/dynamics/se/dyn_grid.F90 b/src/dynamics/se/dyn_grid.F90 index d92ca269ea..b20bdad4c4 100644 --- a/src/dynamics/se/dyn_grid.F90 +++ b/src/dynamics/se/dyn_grid.F90 @@ -41,7 +41,7 @@ module dyn_grid use pio, only: file_desc_t use dimensions_mod, only: globaluniquecols, nelem, nelemd, nelemdmax -use dimensions_mod, only: ne, np, npsq, fv_nphys, nlev, ntrac +use dimensions_mod, only: ne, np, npsq, fv_nphys, nlev, use_cslam use element_mod, only: element_t use fvm_control_volume_mod, only: fvm_struct use hybvcoord_mod, only: hvcoord_t @@ -59,7 +59,6 @@ module dyn_grid integer, parameter :: fvm_decomp = 102 ! The FVM (CSLAM) grid integer, parameter :: physgrid_d = 103 ! physics grid on dynamics decomp integer, parameter :: ini_decomp = 104 ! alternate dynamics grid for reading initial file - character(len=3), protected :: ini_grid_name ! Name of horizontal grid dimension in initial file. @@ -736,6 +735,8 @@ subroutine define_cam_grids() use shr_const_mod, only: PI => SHR_CONST_PI ! Local variables + real(r8), parameter :: area_sphere = 4.0_r8*PI + integer :: i, ii, j, k, ie, mapind character(len=8) :: latname, lonname, ncolname, areaname @@ -790,7 +791,7 @@ subroutine define_cam_grids() do j = 1, np do i = 1, np pearea(ii) = elem(ie)%mp(i,j)*elem(ie)%metdet(i,j) - pearea_wt(ii) = pearea(ii)/(4.0_r8*PI) + pearea_wt(ii) = pearea(ii)/area_sphere pelat_deg(ii) = elem(ie)%spherep(i,j)%lat * rad2deg pelon_deg(ii) = elem(ie)%spherep(i,j)%lon * rad2deg ii = ii + 1 @@ -883,7 +884,7 @@ subroutine define_cam_grids() ! Create FVM grid object for CSLAM !--------------------------------- - if (ntrac > 0) then + if (use_cslam) then ncols_fvm = nc * nc * nelemd ngcols_fvm = nc * nc * nelem_d @@ -900,7 +901,7 @@ subroutine define_cam_grids() fvm_coord(mapind) = fvm(ie)%center_cart(i,j)%lon*rad2deg fvm_map(mapind) = k + ((elem(ie)%GlobalId-1) * nc * nc) fvm_area(mapind) = fvm(ie)%area_sphere(i,j) - fvm_areawt(mapind) = fvm_area(mapind)/(4.0_r8*PI) + fvm_areawt(mapind) = fvm_area(mapind)/area_sphere k = k + 1 end do end do @@ -975,7 +976,7 @@ subroutine define_cam_grids() physgrid_coord(mapind) = fvm(ie)%center_cart_physgrid(i,j)%lon*rad2deg physgrid_map(mapind) = k + ((elem(ie)%GlobalId-1) * fv_nphys * fv_nphys) physgrid_area(mapind) = fvm(ie)%area_sphere_physgrid(i,j) - physgrid_areawt(mapind) = physgrid_area(mapind)/(4.0_r8*PI) + physgrid_areawt(mapind) = physgrid_area(mapind)/area_sphere k = k + 1 end do end do diff --git a/src/dynamics/se/restart_dynamics.F90 b/src/dynamics/se/restart_dynamics.F90 index d3b1aa28fa..f5b3c6a0d8 100644 --- a/src/dynamics/se/restart_dynamics.F90 +++ b/src/dynamics/se/restart_dynamics.F90 @@ -43,7 +43,7 @@ module restart_dynamics use parallel_mod, only: par use thread_mod, only: horz_num_threads -use dimensions_mod, only: np, npsq, ne, nlev, qsize, nelemd, nc, ntrac +use dimensions_mod, only: np, npsq, ne, nlev, qsize, nelemd, nc, ntrac, use_cslam use dof_mod, only: UniquePoints use element_mod, only: element_t use time_mod, only: tstep, TimeLevel_Qdp @@ -148,7 +148,7 @@ subroutine init_restart_dynamics(file, dyn_out) ! CSLAM restart fields - if (ntrac > 0) then + if (use_cslam) then grid_id = cam_grid_id('FVM') call cam_grid_write_attr(File, grid_id, info) @@ -223,7 +223,7 @@ subroutine write_restart_dynamics(File, dyn_out) ! write CSLAM fields - if (ntrac > 0) then + if (use_cslam) then grid_id = cam_grid_id('FVM') @@ -621,7 +621,7 @@ subroutine read_restart_dynamics(File, dyn_in, dyn_out) ! read cslam fields - if (ntrac > 0) then + if (use_cslam) then ! Checks that file and model dimensions agree. diff --git a/src/dynamics/se/test_fvm_mapping.F90 b/src/dynamics/se/test_fvm_mapping.F90 index ef0481b5e0..4a26484854 100644 --- a/src/dynamics/se/test_fvm_mapping.F90 +++ b/src/dynamics/se/test_fvm_mapping.F90 @@ -3,7 +3,7 @@ module test_fvm_mapping use fvm_control_volume_mod, only: fvm_struct use cam_history, only: outfld use physconst, only: pi - use dimensions_mod, only: np, nelemd, nlev, npsq, ntrac + use dimensions_mod, only: np, nelemd, nlev, npsq, ntrac, use_cslam use element_mod, only: element_t implicit none private @@ -147,10 +147,6 @@ subroutine test_mapping_overwrite_tendencies(phys_state,phys_tend,ncols,lchnk,q_ integer :: m_cnst, nq, ie q_prev(:,:,ntrac) = 0.0_r8 - do ie=1,nelemd -!xxx fvm(ie)%c(:,:,:,ntrac) = 0.0_r8 - end do - phys_state%pdel(1:ncols,:) = phys_state%pdeldry(1:ncols,:) !make sure there is no conversion from wet to dry do nq=ntrac,ntrac m_cnst = nq @@ -243,7 +239,7 @@ subroutine test_mapping_output_mapped_tendencies(fvm,elem,nets,nete,tl_f,tl_qdp) name = 'p2d_'//trim(cnst_name(m_cnst))//'_err_gll' call outfld(TRIM(name), RESHAPE(elem(ie)%derived%fq(:,:,:,nq),(/npsq,nlev/)), npsq, ie) end do - if (ntrac>0) then + if (use_cslam) then do nq=ntrac,ntrac m_cnst = nq name = 'p2f_'//trim(cnst_name(m_cnst))//'_fvm' @@ -356,7 +352,6 @@ subroutine test_mapping_overwrite_dyn_state(elem,fvm) end do end if end do -! call fill_halo_fvm_noprealloc(elem,fvm,hybrid,nets,nete,nhc,1,nlev)!xxx nhr chould be a function of interp_method #endif end subroutine test_mapping_overwrite_dyn_state @@ -370,15 +365,11 @@ subroutine test_mapping_output_phys_state(phys_state,fvm) integer :: lchnk, ncol,k,icol,m_cnst,nq,ie character(LEN=128) :: name - do ie=1,nelemd -!xxx fvm(ie)%c(:,:,:,ntrac) = 0.0_r8 - end do - do lchnk = begchunk, endchunk call outfld('d2p_scalar', phys_state(lchnk)%omega(1:pcols,1:pver), pcols, lchnk) call outfld('d2p_u', phys_state(lchnk)%U(1:pcols,1:pver), pcols, lchnk) call outfld('d2p_v', phys_state(lchnk)%V(1:pcols,1:pver), pcols, lchnk) - if (ntrac>0) then + if (use_cslam) then do nq=ntrac,ntrac m_cnst = nq name = 'f2p_'//trim(cnst_name(m_cnst)) From 627d3802e6e55ca77418abb8f0ea51660168e5b6 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 21 Apr 2023 14:33:57 -0600 Subject: [PATCH 111/140] PR updates --- src/control/budgets.F90 | 21 ++++++++++++++------- src/dynamics/mpas/dyn_comp.F90 | 4 ---- src/dynamics/se/dp_coupling.F90 | 2 +- 3 files changed, 15 insertions(+), 12 deletions(-) diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index aad7ece760..1901b04a14 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -237,17 +237,24 @@ subroutine e_m_budget (name, stg1name, stg2name, pkgtype, optype, longname, csla TRIM(ADJUSTL(longname)) write(units_str,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) - budget_num = budget_num + 1 + if (budget_num < budget_array_max) then + budget_num = budget_num + 1 + else + write(errmsg, *) sub, ': Maximum number of budgets reached - increase budget_array_max parameter ' + call endrun(errmsg) + end if budget_pkgtype(budget_num)=pkgtype ! set budget name and constants budget_name(budget_num) = trim(name_str) budget_longname(budget_num) = trim(desc_str) - if (optype=='dif') opchar='-' - if (optype=='sum') opchar='+' - if (optype=='stg') then - write(errmsg,*) sub, ': FATAL: bad value optype should be sum of dif:', optype + if (optype=='dif') then + opchar='-' + else if (optype=='sum') then + opchar='+' + else + write(errmsg,*) sub, ': FATAL: unknown operation type, expecting "sum" or "dif":', optype call endrun(errmsg) end if budget_stg1name(budget_num) = trim(adjustl(strstg1)) @@ -359,7 +366,7 @@ function budget_ind_byname (name) !----------------------------------------------------------------------- ! Find budget name in list budget_ind_byname = -1 - do m = 1, budget_array_max + do m = 1, budget_num if (trim(adjustl(name)) == trim(adjustl(budget_name(m))).or. & trim(adjustl(name)) == trim(adjustl(budget_stagename(m)))) then budget_ind_byname = m @@ -385,7 +392,7 @@ function is_budget(name) ! Find budget name in list of defined budgets is_budget = .false. - do m = 1, budget_array_max + do m = 1, budget_num if (trim(adjustl(name)) == trim(adjustl(budget_name(m))).or. & trim(adjustl(name)) == trim(adjustl(budget_stagename(m)))) then is_budget = .true. diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index 5c82978703..a6256c27da 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -197,10 +197,6 @@ module dyn_comp real(r8), dimension(:), pointer :: fzm ! Interp weight from k layer midpoint to k layer ! interface [dimensionless] (nver) real(r8), dimension(:), pointer :: fzp ! Interp weight from k-1 layer midpoint to k - - real(r8), dimension(:), pointer :: areaCell ! cell area (m^2) - ! layer interface [dimensionless] (nver) - ! ! State that may be directly derived from dycore prognostic state ! diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index 6d0b05a510..8d0ca47bb0 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -674,7 +674,7 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) ! ! CAM physics: water tracers are moist; the rest dry ! - factor_array(1:ncol,1:nlev) = 1/factor_array(1:ncol,1:nlev) + factor_array(1:ncol,1:nlev) = 1._r8/factor_array(1:ncol,1:nlev) do m = 1,pcnst if (cnst_type(m) == 'wet') then do k = 1, nlev From 10f5d9e523125b918bb0e0ac6948e099687d07c0 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 21 Apr 2023 14:36:57 -0600 Subject: [PATCH 112/140] PR update check budget_num --- src/control/budgets.F90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index 1901b04a14..3dcb3c0281 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -155,7 +155,12 @@ subroutine e_m_snapshot (name, pkgtype, longname, cslam) TRIM(ADJUSTL(longname)) write(units_str,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) - budget_num = budget_num+1 + if (budget_num < budget_array_max) then + budget_num = budget_num + 1 + else + write(errmsg, *) sub, ': Maximum number of budgets reached - increase budget_array_max parameter ' + call endrun(errmsg) + end if ! set budget name and constants budget_name(budget_num) = trim(name_str) budget_longname(budget_num) = trim(desc_str) From f475865d66049d8aca0af5925233a48a43fe0528 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 21 Apr 2023 14:44:56 -0600 Subject: [PATCH 113/140] replace /gravit with rga throughout code --- src/dynamics/se/dycore/prim_advance_mod.F90 | 10 +++---- src/dynamics/se/dycore/prim_driver_mod.F90 | 4 +-- src/physics/cam/check_energy.F90 | 31 ++++++++------------- src/utils/cam_thermo.F90 | 20 ++++++------- 4 files changed, 29 insertions(+), 36 deletions(-) diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index 1dbf3d1ef8..211fa06324 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -987,7 +987,7 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& use cam_thermo, only: get_gz, get_virtual_temp use air_composition, only: thermodynamic_active_species_num, dry_air_species_num use air_composition, only: get_cp_dry, get_R_dry - use physconst, only: tref,cpair,gravit,lapse_rate + use physconst, only: tref,cpair,rga,lapse_rate implicit none integer, intent(in) :: np1,nm1,n0,nets,nete @@ -1205,7 +1205,7 @@ subroutine compute_and_apply_rhs(np1,nm1,n0,dt2,elem,hvcoord,hybrid,& ! T1 = .0065*Tref*Cp/g ! = ~191 ! T0 = Tref-T1 ! = ~97 ! - T1 = lapse_rate*Tref*cpair/gravit + T1 = lapse_rate*Tref*cpair*rga T0 = Tref-T1 if (hvcoord%hybm(k)>0) then @@ -1437,7 +1437,7 @@ end subroutine distribute_flux_at_corners subroutine tot_energy_dyn(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suffix) use dimensions_mod, only: npsq,nlev,np,nc,use_cslam,qsize - use physconst, only: gravit, cpair, rearth, omega + use physconst, only: rga, cpair, rearth, omega use element_mod, only: element_t use cam_history, only: outfld use cam_history_support, only: max_fieldname_len @@ -1624,8 +1624,8 @@ subroutine tot_energy_dyn(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suffix) call strlist_get_ind(cnst_name_gll, 'CLDLIQ', ixcldliq, abort=.false.) call strlist_get_ind(cnst_name_gll, 'CLDICE', ixcldice, abort=.false.) - mr_cnst = rearth**3/gravit - mo_cnst = omega*rearth**4/gravit + mr_cnst = rga*rearth**3 + mo_cnst = rga*omega*rearth**4 do ie=nets,nete mr = 0.0_r8 mo = 0.0_r8 diff --git a/src/dynamics/se/dycore/prim_driver_mod.F90 b/src/dynamics/se/dycore/prim_driver_mod.F90 index 6196c525ab..af22869f24 100644 --- a/src/dynamics/se/dycore/prim_driver_mod.F90 +++ b/src/dynamics/se/dycore/prim_driver_mod.F90 @@ -40,7 +40,7 @@ subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) use hybvcoord_mod, only: hvcoord_t use prim_advection_mod, only: prim_advec_init2,deriv use prim_advance_mod, only: compute_omega - use physconst, only: gravit, cappa, cpair, tref, lapse_rate + use physconst, only: rga, cappa, cpair, tref, lapse_rate use cam_thermo, only: get_dp_ref use physconst, only: pstd @@ -157,7 +157,7 @@ subroutine prim_init2(elem, fvm, hybrid, nets, nete, tl, hvcoord) ! T1 = .0065*Tref*Cp/g ! = ~191 ! T0 = Tref-T1 ! = ~97 ! - T1 = lapse_rate*Tref*cpair/gravit + T1 = lapse_rate*Tref*cpair*rga T0 = Tref-T1 do ie=nets,nete do k=1,nlev diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 70a420b274..7b2c0ada05 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -25,7 +25,7 @@ module check_energy use spmd_utils, only: masterproc use gmean_mod, only: gmean - use physconst, only: gravit, latvap, latice, cpair, rair + use physconst, only: gravit, rga, latvap, latice, cpair, rair use air_composition, only: cpairv, rairv, cp_or_cv_dycore use physics_types, only: physics_state, physics_tend, physics_ptend, physics_ptend_init use constituents, only: cnst_get_ind, pcnst, cnst_name, cnst_get_type_byind @@ -601,7 +601,7 @@ subroutine check_energy_fix(state, ptend, nstep, eshflx) ! compute effective sensible heat flux do i = 1, ncol - eshflx(i) = heat_glob * (state%pint(i,pver+1) - state%pint(i,1)) / gravit + eshflx(i) = heat_glob * (state%pint(i,pver+1) - state%pint(i,1)) * rga end do return @@ -657,7 +657,7 @@ subroutine check_tracers_init(state, tracerint) tr = 0._r8 do k = 1, pver do i = 1, ncol - tr(i) = tr(i) + state%q(i,k,m)*trpdel(i,k)/gravit + tr(i) = tr(i) + state%q(i,k,m)*trpdel(i,k)*rga end do end do @@ -745,7 +745,7 @@ subroutine check_tracers_chng(state, tracerint, name, nstep, ztodt, cflx) tr = 0._r8 do k = 1, pver do i = 1, ncol - tr(i) = tr(i) + state%q(i,k,m)*trpdel(i,k)/gravit + tr(i) = tr(i) + state%q(i,k,m)*trpdel(i,k)*rga end do end do @@ -818,7 +818,7 @@ end subroutine check_tracers_chng !####################################################################### subroutine tot_energy_phys(state, outfld_name_suffix,vc) - use physconst, only: gravit,rearth,omega + use physconst, only: rga,rearth,omega use cam_thermo, only: get_hydrostatic_energy,thermo_budget_num_vars,thermo_budget_vars, & wvidx,wlidx,wiidx,seidx,poidx,keidx,moidx,mridx,ttidx,teidx use cam_history, only: outfld @@ -874,12 +874,7 @@ subroutine tot_energy_phys(state, outfld_name_suffix,vc) end if if (state%psetcols == pcols) then - if (vc_loc == vc_height) then - ! - ! compute cv if vertical coordinate is height: cv = cp - R - ! - cp_or_cv(:ncol,:) = cp_or_cv_dycore(:ncol,:,lchnk) - else if (vc_loc == vc_dry_pressure) then + if (vc_loc == vc_height .or. vc_loc == vc_dry_pressure) then cp_or_cv(:ncol,:) = cp_or_cv_dycore(:ncol,:,lchnk) else cp_or_cv(:ncol,:) = cpairv(:ncol,:,lchnk) @@ -888,10 +883,8 @@ subroutine tot_energy_phys(state, outfld_name_suffix,vc) call endrun('tot_energy_phys: energy diagnostics not implemented/tested for subcolumns') end if - if (vc_loc == vc_height) then - scaling(:ncol,:) = cpairv(:ncol,:,lchnk)/cp_or_cv(:ncol,:) !cp/cv scaling for temperature increment under constant volume - else if (vc_loc == vc_dry_pressure) then - scaling(:ncol,:) = cpairv(:ncol,:,lchnk)/cp_or_cv(:ncol,:) + if (vc_loc == vc_height .or. vc_loc == vc_dry_pressure) then + scaling(:ncol,:) = cpairv(:ncol,:,lchnk)/cp_or_cv(:ncol,:)!scaling for energy consistency else scaling(:ncol,:) = 1.0_r8 !internal energy / enthalpy same as CAM physics end if @@ -914,14 +907,14 @@ subroutine tot_energy_phys(state, outfld_name_suffix,vc) ! do k = 1, pver do i = 1, ncol - tt_tmp = state%q(i,k,ixtt)*state%pdel(i,k)/gravit + tt_tmp = state%q(i,k,ixtt)*state%pdel(i,k)*rga tt (i) = tt(i) + tt_tmp end do end do else do k = 1, pver do i = 1, ncol - tt_tmp = state%q(i,k,ixtt)*state%pdeldry(i,k)/gravit + tt_tmp = state%q(i,k,ixtt)*state%pdeldry(i,k)*rga tt (i) = tt(i) + tt_tmp end do end do @@ -950,8 +943,8 @@ subroutine tot_energy_phys(state, outfld_name_suffix,vc) ! MO is equation (7) without \Delta A and sum over areas (areas are in units of radians**2) ! - mr_cnst = rearth**3/gravit - mo_cnst = omega*rearth**4/gravit + mr_cnst = rga*rearth**3 + mo_cnst = rga*omega*rearth**4 mr = 0.0_r8 mo = 0.0_r8 diff --git a/src/utils/cam_thermo.F90 b/src/utils/cam_thermo.F90 index 7b75ed11d5..a9ae3a409f 100644 --- a/src/utils/cam_thermo.F90 +++ b/src/utils/cam_thermo.F90 @@ -1579,7 +1579,7 @@ subroutine get_hydrostatic_energy_1hd(tracer, moist_mixing_ratio, pdel_in, & use cam_logfile, only: iulog use dyn_tests_utils, only: vc_height, vc_moist_pressure, vc_dry_pressure use air_composition, only: wv_idx - use physconst, only: gravit, latvap, latice + use physconst, only: rga, latvap, latice ! Dummy arguments ! tracer: tracer mixing ratio @@ -1699,15 +1699,15 @@ subroutine get_hydrostatic_energy_1hd(tracer, moist_mixing_ratio, pdel_in, & do kdx = 1, SIZE(tracer, 2) do idx = 1, SIZE(tracer, 1) ke_vint(idx) = ke_vint(idx) + (pdel(idx, kdx) * & - 0.5_r8 * (U(idx, kdx)**2 + V(idx, kdx)**2) / gravit) + 0.5_r8 * (U(idx, kdx)**2 + V(idx, kdx)**2) * rga se_vint(idx) = se_vint(idx) + (T(idx, kdx) * & - cp_or_cv(idx, kdx) * pdel(idx, kdx) / gravit) + cp_or_cv(idx, kdx) * pdel(idx, kdx) * rga) po_vint(idx) = po_vint(idx)+pdel(idx, kdx) end do end do do idx = 1, SIZE(tracer, 1) - po_vint(idx) = (phis(idx) * po_vint(idx) / gravit) + po_vint(idx) = (phis(idx) * po_vint(idx) * rga) end do case(vc_height) if ((.not. present(phis)) .or. (.not. present(phis))) then @@ -1720,12 +1720,12 @@ subroutine get_hydrostatic_energy_1hd(tracer, moist_mixing_ratio, pdel_in, & do kdx = 1, SIZE(tracer, 2) do idx = 1, SIZE(tracer, 1) ke_vint(idx) = ke_vint(idx) + (pdel(idx, kdx) * & - 0.5_r8 * (U(idx, kdx)**2 + V(idx, kdx)**2) / gravit) + 0.5_r8 * (U(idx, kdx)**2 + V(idx, kdx)**2) * rga) se_vint(idx) = se_vint(idx) + (T(idx, kdx) * & - cp_or_cv(idx, kdx) * pdel(idx, kdx) / gravit) + cp_or_cv(idx, kdx) * pdel(idx, kdx) * rga) ! z_mid is height above ground po_vint(idx) = po_vint(idx) + (z_mid(idx, kdx) + & - phis(idx) / gravit) * pdel(idx, kdx) + phis(idx) * rga) * pdel(idx, kdx) end do end do case default @@ -1755,7 +1755,7 @@ subroutine get_hydrostatic_energy_1hd(tracer, moist_mixing_ratio, pdel_in, & do kdx = 1, SIZE(tracer, 2) do idx = 1, SIZE(tracer, 1) wv_vint(idx) = wv_vint(idx) + (tracer(idx, kdx, wvidx) * & - pdel(idx, kdx) / gravit) + pdel(idx, kdx) * rga) end do end do if (present(wv)) wv = wv_vint @@ -1765,7 +1765,7 @@ subroutine get_hydrostatic_energy_1hd(tracer, moist_mixing_ratio, pdel_in, & do kdx = 1, SIZE(tracer, 2) do idx = 1, SIZE(tracer, 1) liq_vint(idx) = liq_vint(idx) + (pdel(idx, kdx) * & - tracer(idx, kdx, species_liq_idx(qdx)) / gravit) + tracer(idx, kdx, species_liq_idx(qdx)) * rga) end do end do end do @@ -1779,7 +1779,7 @@ subroutine get_hydrostatic_energy_1hd(tracer, moist_mixing_ratio, pdel_in, & do kdx = 1, SIZE(tracer, 2) do idx = 1, SIZE(tracer, 1) ice_vint(idx) = ice_vint(idx) + (pdel(idx, kdx) * & - tracer(idx, kdx, species_ice_idx(qdx)) / gravit) + tracer(idx, kdx, species_ice_idx(qdx)) * rga) end do end do end do From 1a77db4958df5f6b16068bb450b559327eaba853 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Fri, 21 Apr 2023 15:44:15 -0600 Subject: [PATCH 114/140] bug in previous commit - round-off answer changes! --- src/physics/cam/geopotential.F90 | 31 ++++++++++++++++--------------- src/physics/cam/phys_control.F90 | 3 ++- src/utils/cam_thermo.F90 | 2 +- 3 files changed, 19 insertions(+), 17 deletions(-) diff --git a/src/physics/cam/geopotential.F90 b/src/physics/cam/geopotential.F90 index 72d5aa4b5c..93e99644ac 100644 --- a/src/physics/cam/geopotential.F90 +++ b/src/physics/cam/geopotential.F90 @@ -101,11 +101,7 @@ subroutine geopotential_t( & hkl(i) = piln(i,k+1) - piln(i,k) hkk(i) = 1._r8 - pint(i,k) * hkl(i) * rpdel(i,k) end do - else!MPAS, SE or EUL - ! - ! For EUL and SE: pmid = 0.5*(pint(k+1)+pint(k)) - ! For MPAS : pmid is computed from theta_m, rhodry, etc. - ! + else do i = 1,ncol hkl(i) = pdel(i,k) / pmid(i,k) hkk(i) = 0.5_r8 * hkl(i) @@ -155,22 +151,27 @@ subroutine geopotential_t( & do k = pver, 1, -1 ! First set hydrostatic elements consistent with dynamics - - if ((dycore_is('LR') .or. dycore_is('FV3'))) then - do i = 1,ncol - hkl(i) = piln(i,k+1) - piln(i,k) - hkk(i) = 1._r8 - pint(i,k) * hkl(i) * rpdel(i,k) - end do - else!MPAS, SE or EUL + + ! + ! the outcommented code is left for when/if we will support + ! FV3 and/or FV with condensate loading + ! + +! if ((dycore_is('LR') .or. dycore_is('FV3'))) then +! do i = 1,ncol +! hkl(i) = piln(i,k+1) - piln(i,k) +! hkk(i) = 1._r8 - pint(i,k) * hkl(i) * rpdel(i,k) +! end do +! else!MPAS, SE or EUL ! - ! For EUL and SE: pmid = 0.5*(pint(k+1)+pint(k)) - ! For MPAS : pmid is computed from theta_m, rhodry, etc. + ! For SE : pmid = 0.5*(pint(k+1)+pint(k)) + ! For MPAS : pmid is computed from theta_m, rhodry, etc. ! do i = 1,ncol hkl(i) = pdel(i,k) / pmid(i,k) hkk(i) = 0.5_r8 * hkl(i) end do - end if +! end if ! Now compute tv, zm, zi diff --git a/src/physics/cam/phys_control.F90 b/src/physics/cam/phys_control.F90 index 25183962bf..8d0cad7ee3 100644 --- a/src/physics/cam/phys_control.F90 +++ b/src/physics/cam/phys_control.F90 @@ -56,7 +56,8 @@ module phys_control logical :: history_aerosol = .false. ! output the MAM aerosol variables and tendencies logical :: history_aero_optics = .false. ! output the aerosol logical :: history_eddy = .false. ! output the eddy variables -logical :: history_budget = .false. ! output tendencies and state variables for CAM4 +logical :: history_budget = .false. ! output tendencies and state variables for T, water vapor, + ! cloud ice and cloud liquid budgets logical :: convproc_do_aer = .false. ! switch for new convective scavenging treatment for modal aerosols integer :: history_budget_histfile_num = 1 ! output history file number for budget fields diff --git a/src/utils/cam_thermo.F90 b/src/utils/cam_thermo.F90 index a9ae3a409f..a395af611f 100644 --- a/src/utils/cam_thermo.F90 +++ b/src/utils/cam_thermo.F90 @@ -1699,7 +1699,7 @@ subroutine get_hydrostatic_energy_1hd(tracer, moist_mixing_ratio, pdel_in, & do kdx = 1, SIZE(tracer, 2) do idx = 1, SIZE(tracer, 1) ke_vint(idx) = ke_vint(idx) + (pdel(idx, kdx) * & - 0.5_r8 * (U(idx, kdx)**2 + V(idx, kdx)**2) * rga + 0.5_r8 * (U(idx, kdx)**2 + V(idx, kdx)**2)) * rga se_vint(idx) = se_vint(idx) + (T(idx, kdx) * & cp_or_cv(idx, kdx) * pdel(idx, kdx) * rga) po_vint(idx) = po_vint(idx)+pdel(idx, kdx) From 96fc4c1372a1b2c442e43bdf28c683e86bf40aac Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 21 Apr 2023 15:45:23 -0600 Subject: [PATCH 115/140] split long lines for PR --- src/dynamics/fv/metdata.F90 | 10 ++++++---- src/dynamics/mpas/dycore_budget.F90 | 7 +++++-- src/dynamics/mpas/dyn_comp.F90 | 18 +++++++++++------ src/dynamics/se/dycore_budget.F90 | 9 ++++++--- src/dynamics/se/dyn_comp.F90 | 30 ++++++++++++++++++----------- src/utils/air_composition.F90 | 3 ++- src/utils/cam_thermo.F90 | 9 ++++++--- 7 files changed, 56 insertions(+), 30 deletions(-) diff --git a/src/dynamics/fv/metdata.F90 b/src/dynamics/fv/metdata.F90 index 58a51283bc..06957af5ef 100644 --- a/src/dynamics/fv/metdata.F90 +++ b/src/dynamics/fv/metdata.F90 @@ -660,7 +660,9 @@ subroutine get_met_srf2( cam_in ) ! Nudging land and forcing ocean. if (met_srf_land_scale) then - met_rlx_sfc(:ncol) = (1._r8 - cam_in(c)%landfrac(:ncol)) * met_rlx_sfc(:ncol) + cam_in(c)%landfrac(:ncol) * met_rlx(pver) + met_rlx_sfc(:ncol) = (1._r8 - cam_in(c)%landfrac(:ncol)) * & + met_rlx_sfc(:ncol) + & + cam_in(c)%landfrac(:ncol) * met_rlx(pver) else where(cam_in(c)%landfrac(:ncol) == 1._r8) met_rlx_sfc(:ncol) = 0._r8 end if @@ -725,9 +727,9 @@ subroutine get_met_srf2( cam_in ) end if if (met_srf_refs) then - cam_in(c)%qref(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%qref(:ncol) + met_rlx_sfc(:ncol) * met_qref(:ncol,c) - cam_in(c)%tref(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%tref(:ncol) + met_rlx_sfc(:ncol) * met_tref(:ncol,c) - cam_in(c)%u10(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%u10(:ncol) + met_rlx_sfc(:ncol) * met_u10(:ncol,c) + cam_in(c)%qref(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%qref(:ncol) + met_rlx_sfc(:ncol) * met_qref(:ncol,c) + cam_in(c)%tref(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%tref(:ncol) + met_rlx_sfc(:ncol) * met_tref(:ncol,c) + cam_in(c)%u10(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%u10(:ncol) + met_rlx_sfc(:ncol) * met_u10(:ncol,c) end if if (met_srf_sst) then diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index b35ec48ceb..da11d617de 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -193,7 +193,8 @@ subroutine print_budget(hstwr) write(iulog,*) " ----- ----- ----" do i=1,4 diff = dEdt_dme_adjust_physE(i)-dEdt_dme_adjust_dynE(i) - write(iulog,fmt)"dE/dt dry mass adjustment (xxAM-xxAP) ",str(i)," ",dEdt_dme_adjust_physE(i)," ",dEdt_dme_adjust_dynE(i)," ",diff + write(iulog,fmt)"dE/dt dry mass adjustment (xxAM-xxAP) ",str(i)," ",dEdt_dme_adjust_physE(i), & + " ",dEdt_dme_adjust_dynE(i)," ",diff end do write(iulog,*)" " write(iulog,*)"Compare to dry mass adjustment in dynamics (xx=d,dy):" @@ -230,7 +231,9 @@ subroutine print_budget(hstwr) write(iulog,*) " dE/dt PDC errors (A-grid) (t=n-1) = ",previous_dEdt_phys_dyn_coupl_err_Agrid write(iulog,*) " dE/dt PDC errors (other ) (t=n-1) = unknown" - dEdt_dycore_and_pdc_estimated_from_efix = -dEdt_efix_dynE(1)-previous_dEdt_phys_dyn_coupl_err_Agrid-previous_dEdt_dry_mass_adjust + dEdt_dycore_and_pdc_estimated_from_efix = -dEdt_efix_dynE(1) - & + previous_dEdt_phys_dyn_coupl_err_Agrid - & + previous_dEdt_dry_mass_adjust write(iulog,*) " " write(iulog,*) "Hence the dycore E dissipation and physics-dynamics coupling errors" write(iulog,*) "associated with mapping wind tendencies to C-grid and dribbling " diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index a6256c27da..ec729d1ea3 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -543,9 +543,12 @@ subroutine dyn_init(dyn_in, dyn_out) ! initialize MPAS energy budgets ! add budgets that are derived from stages ! - call e_m_budget('dEdt_param_efix_in_dyn','dAP','dBF',pkgtype='dyn',optype='dif',longname="dE/dt parameterizations+efix in dycore (dparam)(dAP-dBF)") - call e_m_budget('dEdt_dme_adjust_in_dyn','dAM','dAP',pkgtype='dyn',optype='dif',longname="dE/dt dry mass adjustment in dycore (dAM-dAP)") - call e_m_budget('dEdt_phys_total_in_dyn','dAM','dBF',pkgtype='dyn',optype='dif',longname="dE/dt physics total in dycore (phys) (dAM-dBF)") + call e_m_budget('dEdt_param_efix_in_dyn','dAP','dBF',pkgtype='dyn',optype='dif', & + longname="dE/dt parameterizations+efix in dycore (dparam)(dAP-dBF)") + call e_m_budget('dEdt_dme_adjust_in_dyn','dAM','dAP',pkgtype='dyn',optype='dif', & + longname="dE/dt dry mass adjustment in dycore (dAM-dAP)") + call e_m_budget('dEdt_phys_total_in_dyn','dAM','dBF',pkgtype='dyn',optype='dif', & + longname="dE/dt physics total in dycore (phys) (dAM-dBF)") end if ! @@ -554,19 +557,22 @@ subroutine dyn_init(dyn_in, dyn_out) do m=1,thermodynamic_active_species_num thermodynamic_active_species_idx_dycore(m) = dyn_out % cam_from_mpas_cnst(thermodynamic_active_species_idx(m)) if (masterproc) then - write(iulog,'(a,2I4)') subname//": m,thermodynamic_active_species_idx_dycore: ",m,thermodynamic_active_species_idx_dycore(m) + write(iulog,'(a,2I4)') subname//": m,thermodynamic_active_species_idx_dycore: ", & + m,thermodynamic_active_species_idx_dycore(m) end if end do do m=1,thermodynamic_active_species_liq_num thermodynamic_active_species_liq_idx_dycore(m) = dyn_out % cam_from_mpas_cnst(thermodynamic_active_species_liq_idx(m)) if (masterproc) then - write(iulog,'(a,2I4)') subname//": m,thermodynamic_active_species_idx_liq_dycore: ",m,thermodynamic_active_species_liq_idx_dycore(m) + write(iulog,'(a,2I4)') subname//": m,thermodynamic_active_species_idx_liq_dycore: ", & + m,thermodynamic_active_species_liq_idx_dycore(m) end if end do do m=1,thermodynamic_active_species_ice_num thermodynamic_active_species_ice_idx_dycore(m) = dyn_out % cam_from_mpas_cnst(thermodynamic_active_species_ice_idx(m)) if (masterproc) then - write(iulog,'(a,2I4)') subname//": m,thermodynamic_active_species_idx_ice_dycore: ",m,thermodynamic_active_species_ice_idx_dycore(m) + write(iulog,'(a,2I4)') subname//": m,thermodynamic_active_species_idx_ice_dycore: ", & + m,thermodynamic_active_species_ice_idx_dycore(m) end if end do diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index 28e3296608..d344295bc6 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -213,9 +213,11 @@ subroutine print_budget(hstwr) write(iulog,*) " ----- ----- -----------" do i=1,4 diff = abs_diff(dEdt_efix_physE(i),dEdt_efix_dynE(i),pf=pf) - write(iulog,fmt)"dE/dt energy fixer (xxBP-xxBF) ",str(i)," ",dEdt_efix_physE(i), " ",dEdt_efix_dynE(i)," ",diff,pf + write(iulog,fmt)"dE/dt energy fixer (xxBP-xxBF) ",str(i)," ",dEdt_efix_physE(i), " ", & + dEdt_efix_dynE(i)," ",diff,pf diff = abs_diff(dEdt_param_physE(i),dEdt_param_dynE(i),pf=pf) - write(iulog,fmt)"dE/dt all parameterizations (xxAP-xxBP) ",str(i)," ",dEdt_param_physE(i)," ",dEdt_param_dynE(i)," ",diff,pf + write(iulog,fmt)"dE/dt all parameterizations (xxAP-xxBP) ",str(i)," ",dEdt_param_physE(i)," ", & + dEdt_param_dynE(i)," ",diff,pf write(iulog,*) " " if (diff>eps) then write(iulog,*)"FAIL" @@ -231,7 +233,8 @@ subroutine print_budget(hstwr) write(iulog,*) " ----- ----- ----" do i=1,4 diff = dEdt_dme_adjust_physE(i)-dEdt_dme_adjust_dynE(i) - write(iulog,fmt)"dE/dt dry mass adjustment (xxAM-xxAP) ",str(i)," ",dEdt_dme_adjust_physE(i)," ",dEdt_dme_adjust_dynE(i)," ",diff + write(iulog,fmt)"dE/dt dry mass adjustment (xxAM-xxAP) ",str(i)," ",dEdt_dme_adjust_physE(i)," ", & + dEdt_dme_adjust_dynE(i)," ",diff end do write(iulog,*)" " write(iulog,*)" " diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 4d200887cd..ec666cb402 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -898,21 +898,29 @@ subroutine dyn_init(dyn_in, dyn_out) ! ! Register tendency (difference) budgets ! - call e_m_budget('dEdt_floating_dyn' ,'dAD','dBD','dyn','dif',longname="dE/dt floating dynamics (dAD-dBD)" ,cslam=use_cslam) - call e_m_budget('dEdt_vert_remap' ,'dAR','dAD','dyn','dif',longname="dE/dt vertical remapping (dAR-dAD)" ,cslam=use_cslam) - call e_m_budget('dEdt_phys_tot_in_dyn','dBD','dAF','dyn','dif',longname="dE/dt physics tendency in dynamics (dBD-dAF)" ,cslam=use_cslam) - - call e_m_budget('dEdt_del4' ,'dCH','dBH','dyn','dif',longname="dE/dt del4 (dCH-dBH)" ,cslam=use_cslam) - call e_m_budget('dEdt_del4_fric_heat','dAH','dCH','dyn','dif',longname="dE/dt del4 frictional heating (dAH-dCH)" ,cslam=use_cslam) - call e_m_budget('dEdt_del4_tot' ,'dAH','dBH','dyn','dif',longname="dE/dt del4 + del4 frictional heating (dAH-dBH)",cslam=use_cslam) - call e_m_budget('dEdt_del2_sponge' ,'dAS','dBS','dyn','dif',longname="dE/dt del2 sponge (dAS-dBS)" ,cslam=use_cslam) + call e_m_budget('dEdt_floating_dyn' ,'dAD','dBD','dyn','dif', & + longname="dE/dt floating dynamics (dAD-dBD)" ,cslam=use_cslam) + call e_m_budget('dEdt_vert_remap' ,'dAR','dAD','dyn','dif', & + longname="dE/dt vertical remapping (dAR-dAD)" ,cslam=use_cslam) + call e_m_budget('dEdt_phys_tot_in_dyn','dBD','dAF','dyn','dif', & + longname="dE/dt physics tendency in dynamics (dBD-dAF)" ,cslam=use_cslam) + call e_m_budget('dEdt_del4' ,'dCH','dBH','dyn','dif', & + longname="dE/dt del4 (dCH-dBH)" ,cslam=use_cslam) + call e_m_budget('dEdt_del4_fric_heat','dAH','dCH','dyn','dif', & + longname="dE/dt del4 frictional heating (dAH-dCH)" ,cslam=use_cslam) + call e_m_budget('dEdt_del4_tot' ,'dAH','dBH','dyn','dif', & + longname="dE/dt del4 + del4 frictional heating (dAH-dBH)",cslam=use_cslam) + call e_m_budget('dEdt_del2_sponge' ,'dAS','dBS','dyn','dif', & + longname="dE/dt del2 sponge (dAS-dBS)" ,cslam=use_cslam) ! ! Register derived budgets ! - call e_m_budget('dEdt_dycore' ,'dEdt_floating_dyn','dEdt_vert_remap' ,'dyn','sum',longname="dE/dt adiabatic dynamics" ,cslam=use_cslam) - call e_m_budget('dEdt_del2_del4_tot' ,'dEdt_del4_tot' ,'dEdt_del2_sponge' ,'dyn','sum',longname="dE/dt explicit diffusion total",cslam=use_cslam) + call e_m_budget('dEdt_dycore' ,'dEdt_floating_dyn','dEdt_vert_remap' ,'dyn','sum', & + longname="dE/dt adiabatic dynamics" ,cslam=use_cslam) + call e_m_budget('dEdt_del2_del4_tot' ,'dEdt_del4_tot' ,'dEdt_del2_sponge' ,'dyn','sum', & + longname="dE/dt explicit diffusion total",cslam=use_cslam) call e_m_budget('dEdt_residual' ,'dEdt_floating_dyn','dEdt_del2_del4_tot','dyn','dif',& - longname="dE/dt residual (dEdt_floating_dyn-dEdt_del2_del4_tot)",cslam=use_cslam) + longname="dE/dt residual (dEdt_floating_dyn-dEdt_del2_del4_tot)",cslam=use_cslam) end if ! ! add dynamical core tracer tendency output diff --git a/src/utils/air_composition.F90 b/src/utils/air_composition.F90 index 1369e93b42..44315559a6 100644 --- a/src/utils/air_composition.F90 +++ b/src/utils/air_composition.F90 @@ -1,4 +1,5 @@ -! air_composition module defines major species of the atmosphere and manages the physical properties that are dependent on the composition of air +! air_composition module defines major species of the atmosphere and manages +! the physical properties that are dependent on the composition of air module air_composition use shr_kind_mod, only: r8 => shr_kind_r8 diff --git a/src/utils/cam_thermo.F90 b/src/utils/cam_thermo.F90 index 7b75ed11d5..f9cccade60 100644 --- a/src/utils/cam_thermo.F90 +++ b/src/utils/cam_thermo.F90 @@ -1307,7 +1307,8 @@ subroutine get_molecular_diff_coef_1hd(temp, get_at_interfaces, sponge_factor, k real(r8), intent(in) :: temp(:,:) ! temperature logical, intent(in) :: get_at_interfaces ! true: compute kmvis and kmcnd at interfaces ! false: compute kmvis and kmcnd at mid-levels - real(r8), intent(in) :: sponge_factor(:) ! multiply kmvis and kmcnd with sponge_factor (for sponge layer) + real(r8), intent(in) :: sponge_factor(:) ! multiply kmvis and kmcnd with sponge_factor + ! (for sponge layer) real(r8), intent(out) :: kmvis(:,:) real(r8), intent(out) :: kmcnd(:,:) real(r8), intent(in) :: tracer(:,:,:) ! tracer array @@ -1383,7 +1384,8 @@ subroutine get_molecular_diff_coef_1hd(temp, get_at_interfaces, sponge_factor, k residual = 1.0_r8 do icnst = 1, dry_air_species_num ispecies = idx_local(icnst) - mm = 0.5_r8 * (tracer(idx, kdx, ispecies) * factor(idx, kdx) + tracer(idx, kdx - 1, ispecies) * factor(idx, kdx-1)) + mm = 0.5_r8 * (tracer(idx, kdx, ispecies) * factor(idx, kdx) + & + tracer(idx, kdx - 1, ispecies) * factor(idx, kdx-1)) kmvis(idx, kdx) = kmvis(idx, kdx) + thermodynamic_active_species_kv(icnst) * & thermodynamic_active_species_mwi(icnst) * mm kmcnd(idx, kdx) = kmcnd(idx, kdx) + thermodynamic_active_species_kc(icnst) * & @@ -1445,7 +1447,8 @@ subroutine get_molecular_diff_coef_2hd(temp, get_at_interfaces, sponge_factor, k real(r8), intent(in) :: temp(:,:,:) ! temperature logical, intent(in) :: get_at_interfaces ! true: compute kmvis and kmcnd at interfaces ! false: compute kmvis and kmcnd at mid-levels - real(r8), intent(in) :: sponge_factor(:) ! multiply kmvis and kmcnd with sponge_factor (for sponge layer) + real(r8), intent(in) :: sponge_factor(:) ! multiply kmvis and kmcnd with sponge_factor + ! (for sponge layer) real(r8), intent(out) :: kmvis(:,:,:) real(r8), intent(out) :: kmcnd(:,:,:) real(r8), intent(in) :: tracer(:,:,:,:) ! tracer array From d457221664eebc8fdf3bdab66b039d5d7d43ece5 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 21 Apr 2023 16:47:11 -0600 Subject: [PATCH 116/140] PR fix for valid tapes numbers --- bld/namelist_files/namelist_definition.xml | 2 +- src/control/budgets.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 7d11589905..a42154efc1 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -5065,7 +5065,7 @@ Default: 4 m/s + group="thermo_budget_nl" valid_values="1,2,3,4,5,6,7,8,9,10" > History tape number thermo budget output is written to. Default: 1 diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index 3dcb3c0281..c294e4c01c 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -165,7 +165,7 @@ subroutine e_m_snapshot (name, pkgtype, longname, cslam) budget_name(budget_num) = trim(name_str) budget_longname(budget_num) = trim(desc_str) - budget_optype(budget_num)='stg' + budget_optype(budget_num)='' budget_pkgtype(budget_num)=pkgtype budget_stagename(budget_num)= trim(name) From d6151af7c74d38928c915e1f0b1815f282e49ad6 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 24 Apr 2023 09:35:28 -0600 Subject: [PATCH 117/140] Update src/utils/cam_thermo.F90 Co-authored-by: Jesse Nusbaumer --- src/utils/cam_thermo.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/utils/cam_thermo.F90 b/src/utils/cam_thermo.F90 index ac83f66ae6..0901540705 100644 --- a/src/utils/cam_thermo.F90 +++ b/src/utils/cam_thermo.F90 @@ -33,9 +33,9 @@ module cam_thermo ! cam_thermo_init: Initialize constituent dependent properties public :: cam_thermo_init - ! cam_thermo_update: Update dry air composition dependent properties + ! cam_thermo_dry_air_update: Update dry air composition dependent properties public :: cam_thermo_dry_air_update - ! cam_thermo_update: Update water dependent properties + ! cam_thermo_water_update: Update water dependent properties public :: cam_thermo_water_update ! get_enthalpy: enthalpy quantity = dp*cp*T public :: get_enthalpy From 4e6d0644c98f25109e603d8fb7768bee4f79e847 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Mon, 24 Apr 2023 10:04:59 -0600 Subject: [PATCH 118/140] PR --- src/utils/air_composition.F90 | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/src/utils/air_composition.F90 b/src/utils/air_composition.F90 index 44315559a6..c5c74cc823 100644 --- a/src/utils/air_composition.F90 +++ b/src/utils/air_composition.F90 @@ -105,8 +105,8 @@ module air_composition real(r8), public, protected, allocatable :: cappav(:,:,:) ! mbarv: composition dependent atmosphere mean mass real(r8), public, protected, allocatable :: mbarv(:,:,:) - - ! cp_or_cv_dycore: composition dependent specific heat at constant pressure + ! cp_or_cv_dycore: enthalpy or internal energy scaling factor for + ! energy consistency real(r8), public, protected, allocatable :: cp_or_cv_dycore(:,:,:) ! ! Interfaces for public routines @@ -350,10 +350,10 @@ subroutine air_composition_init() !------------------------------------------------------------------------ ! Initialize constituent dependent properties !------------------------------------------------------------------------ - cpairv(:pcols, :pver, begchunk:endchunk) = cpair - rairv(:pcols, :pver, begchunk:endchunk) = rair - cappav(:pcols, :pver, begchunk:endchunk) = rair / cpair - mbarv(:pcols, :pver, begchunk:endchunk) = mwdry + cpairv(:pcols, :pver, begchunk:endchunk) = cpair + rairv(:pcols, :pver, begchunk:endchunk) = rair + cappav(:pcols, :pver, begchunk:endchunk) = rair / cpair + mbarv(:pcols, :pver, begchunk:endchunk) = mwdry ! if (dry_air_species_num > 0) then ! @@ -657,6 +657,7 @@ end subroutine dry_air_composition_update subroutine water_composition_update(mmr, lchnk, ncol, vcoord, to_dry_factor) use cam_abortutils, only: endrun + use string_utils, only: int2str use dyn_tests_utils, only: vc_height, vc_moist_pressure, vc_dry_pressure real(r8), intent(in) :: mmr(:,:,:) ! constituents array integer, intent(in) :: lchnk ! Chunk number @@ -678,6 +679,8 @@ subroutine water_composition_update(mmr, lchnk, ncol, vcoord, to_dry_factor) ! cp_or_cv_dycore(:ncol,:,lchnk)=cp_or_cv_dycore(:ncol,:,lchnk)*& (cpairv(:ncol,:,lchnk)-rairv(:ncol,:,lchnk)) /rairv(:ncol,:,lchnk) + else + call endrun(subname//" vertical coordinate not supported; vcoord="// int2str(vcoord)) end if end subroutine water_composition_update From d9f7645ecff3a41a89014d32a804180e0187c4c5 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Mon, 24 Apr 2023 14:21:09 -0600 Subject: [PATCH 119/140] PR commits --- src/control/budgets.F90 | 14 +++++++------- src/control/cam_history.F90 | 20 ++++++++++---------- 2 files changed, 17 insertions(+), 17 deletions(-) diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index c294e4c01c..0b41a393e6 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -40,14 +40,14 @@ module budgets ! Public data - integer, parameter, public :: budget_array_max = 500 ! number of budget diffs + integer, parameter, public :: budget_array_max = 500 ! max number of budgets - integer, public :: budget_num = 0 ! + integer, public :: budget_num = 0 ! current number of defined budgets. character(cl), public, protected :: budget_name(budget_array_max) ! budget names - character(cl), public, protected :: budget_longname(budget_array_max) ! long name of budgets - character(cl), public, protected :: budget_stagename(budget_array_max) ! long name of budgets - character(cl), public, protected :: budget_stg1name(budget_array_max) - character(cl), public, protected :: budget_stg2name(budget_array_max) + character(cl), public, protected :: budget_longname(budget_array_max) ! descriptive name of budget + character(cl), public, protected :: budget_stagename(budget_array_max)! shortname of both of the 3 char snapshot components + character(cl), public, protected :: budget_stg1name(budget_array_max) ! The 1st of 2 snapshots used to calculate a budget + character(cl), public, protected :: budget_stg2name(budget_array_max) ! The 2nd of 2 snapshots used to calculate a budget integer, public :: thermo_budget_histfile_num = 1 logical, public :: thermo_budget_history = .false. @@ -284,7 +284,7 @@ subroutine e_m_budget (name, stg1name, stg2name, pkgtype, optype, longname, csla end if end if call addfld (TRIM(ADJUSTL(name_str)), horiz_only, 'N', TRIM(ADJUSTL(units_str)),TRIM(ADJUSTL(desc_str)), & - gridname=gridname,op=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) + gridname=gridname,optype=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2))) call add_default(TRIM(ADJUSTL(name_str)), thermo_budget_histfile_num, 'N') end do end if diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 5f17efd47f..fadadfb396 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -2057,7 +2057,7 @@ subroutine read_restart_history (File) ierr = pio_get_var(File,fillval_desc, (/f,t/), tape(t)%hlist(f)%field%fillvalue) ierr = pio_get_var(File,meridional_complement_desc, (/f,t/), tape(t)%hlist(f)%field%meridional_complement) ierr = pio_get_var(File,zonal_complement_desc, (/f,t/), tape(t)%hlist(f)%field%zonal_complement) - tape(t)%hlist(f)%field%field_op(1:max_chars) = ' ' + tape(t)%hlist(f)%field%field_op(1:field_op_len) = ' ' ierr = pio_get_var(File,field_op_desc, (/1,f,t/), tape(t)%hlist(f)%field%field_op) call strip_null(tape(t)%hlist(f)%field%field_op) ierr = pio_get_var(File,op_field1_id_desc, (/f,t/), tape(t)%hlist(f)%field%op_field1_id) @@ -5649,7 +5649,7 @@ end subroutine wshist subroutine addfld_1d(fname, vdim_name, avgflag, units, long_name, & gridname, flag_xyfill, sampling_seq, standard_name, fill_value, & - op, op_f1name, op_f2name) + optype, op_f1name, op_f2name) ! !----------------------------------------------------------------------- @@ -5678,7 +5678,7 @@ subroutine addfld_1d(fname, vdim_name, avgflag, units, long_name, & ! every other; only during LW/SW radiation calcs, etc. character(len=*), intent(in), optional :: standard_name ! CF standard name (max_chars) real(r8), intent(in), optional :: fill_value - character(len=*), intent(in), optional :: op ! currently 'dif'/'sum' supported dif ex fname = op_f1name - op_f2name + character(len=*), intent(in), optional :: optype ! currently 'dif' or 'sum' supported character(len=*), intent(in), optional :: op_f1name ! first field to be operated on character(len=*), intent(in), optional :: op_f2name ! second field which is subtracted from or added to first field @@ -5699,13 +5699,13 @@ subroutine addfld_1d(fname, vdim_name, avgflag, units, long_name, & dimnames(1) = trim(vdim_name) end if call addfld(fname, dimnames, avgflag, units, long_name, gridname, & - flag_xyfill, sampling_seq, standard_name, fill_value, op, op_f1name, & + flag_xyfill, sampling_seq, standard_name, fill_value, optype, op_f1name, & op_f2name) end subroutine addfld_1d subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & - gridname, flag_xyfill, sampling_seq, standard_name, fill_value, op, & + gridname, flag_xyfill, sampling_seq, standard_name, fill_value, optype, & op_f1name, op_f2name) ! @@ -5739,7 +5739,7 @@ subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & ! every other; only during LW/SW radiation calcs, etc. character(len=*), intent(in), optional :: standard_name ! CF standard name (max_chars) real(r8), intent(in), optional :: fill_value - character(len=*), intent(in), optional :: op ! currently 'dif'/'sum' supported dif ex fname = op_f1name - op_f2name + character(len=*), intent(in), optional :: optype ! currently 'dif' or 'sum' supported character(len=*), intent(in), optional :: op_f1name ! first field to be operated on character(len=*), intent(in), optional :: op_f2name ! second field which is subtracted from or added to first field @@ -5913,8 +5913,8 @@ subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & call AvgflagToString(avgflag, listentry%time_op(dimcnt)) end do - if (present(op)) then - listentry%field%field_op = op + if (present(optype)) then + listentry%field%field_op = optype if (present(op_f1name).and.present(op_f2name)) then ! Look for the field IDs f1listentry => get_entry_by_name(masterlinkedlist, trim(op_f1name)) @@ -5955,7 +5955,7 @@ end subroutine addfld_nd !####################################################################### - ! field_part_of_vector: Determinie if fname is part of a vector set + ! field_part_of_vector: Determine if fname is part of a vector set ! Optionally fill in the names of the vector set fields logical function field_part_of_vector(fname, meridional_name, zonal_name) @@ -5996,7 +5996,7 @@ logical function field_part_of_vector(fname, meridional_name, zonal_name) end function field_part_of_vector !####################################################################### - ! composed field: Determinie if fname is composed from 2 other + ! composed field: Determine if fname is composed from 2 other ! fields ! Optionally fill in the names of the composing fields logical function composed_field(fname, fname1, fname2) From 14b0adfafd488f5dffa26306a45876fd611a1326 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Mon, 24 Apr 2023 17:13:29 -0600 Subject: [PATCH 120/140] PR update, op to optype in error msg --- src/control/cam_history.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index fadadfb396..f0aedbc7af 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -5105,7 +5105,7 @@ subroutine h_field_op (f, t) tape(t)%hlist(f1)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) + & tape(t)%hlist(f2)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) else - call endrun('h_field_op: ERROR: budget_optype unknown:'//trim(op)) + call endrun('h_field_op: ERROR: budget_optype unknown:'//trim(optype)) end if end do ! Set nsteps for composed fields using value of one of the component fields From bce1fbbe61d04b42c4ec88a9f3f7d0a5d74acf78 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Mon, 24 Apr 2023 17:23:33 -0600 Subject: [PATCH 121/140] PR updates --- src/control/cam_history.F90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index f0aedbc7af..c2698090a4 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -84,9 +84,9 @@ module cam_history character(len=max_fieldname_len) :: zonal_field = '' ! for vector fields character(len=1) :: avgflag(ptapes) ! averaging flag character(len=max_chars) :: time_op(ptapes) ! time operator (e.g. max, min, avg) - character(len=field_op_len) :: field_op = '' ! field derived from sum/dif of field1 and field2 - character(len=max_fieldname_len) :: op_field1 = '' ! first field name to be summed/diffed - character(len=max_fieldname_len) :: op_field2 = '' ! second field name to be summed/diffed + character(len=field_op_len) :: field_op = '' ! field derived from sum or dif of field1 and field2 + character(len=max_fieldname_len) :: op_field1 = '' ! first field name to be operated on + character(len=max_fieldname_len) :: op_field2 = '' ! second field name to be operated on logical :: act_sometape ! Field is active on some tape logical :: actflag(ptapes) ! Per tape active/inactive flag integer :: htapeindx(ptapes)! This field's index on particular history tape @@ -5068,7 +5068,7 @@ subroutine h_field_op (f, t) ! !----------------------------------------------------------------------- ! - ! Purpose: run field sum/dif opperation on all contructed fields + ! Purpose: run field sum or dif opperation on all contructed fields ! ! Method: Loop through fields on the tape ! @@ -5084,23 +5084,23 @@ subroutine h_field_op (f, t) integer :: f1,f2 ! fields to be operated on integer :: begdim1, begdim2, begdim3 ! on-node chunk or lat start index integer :: enddim1, enddim2, enddim3 ! on-node chunk or lat end index - character(len=max_chars) :: op ! field operation currently only sum/diff + character(len=field_op_len) :: optype ! field operation only sum or diff supported call t_startf ('h_field_op') f1 = tape(t)%hlist(f)%field%op_field1_id f2 = tape(t)%hlist(f)%field%op_field2_id - op = trim(adjustl(tape(t)%hlist(f)%field%field_op)) + optype = trim(adjustl(tape(t)%hlist(f)%field%field_op)) begdim3 = tape(t)%hlist(f)%field%begdim3 enddim3 = tape(t)%hlist(f)%field%enddim3 do c = begdim3, enddim3 dimind = tape(t)%hlist(f)%field%get_dims(c) - if (trim(op) == 'dif') then + if (trim(optype) == 'dif') then tape(t)%hlist(f)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) = & tape(t)%hlist(f1)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) - & tape(t)%hlist(f2)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) - else if (trim(op) == 'sum') then + else if (trim(optype) == 'sum') then tape(t)%hlist(f)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) = & tape(t)%hlist(f1)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) + & tape(t)%hlist(f2)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) @@ -5936,12 +5936,12 @@ subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & else if (present(op_f1name)) then write(errormsg, '(3a)') ': creating a composed field using component field 1:',& - trim(op_f1name),' but no field operation (op=sum/dif) has been defined' + trim(op_f1name),' but no field operation (optype=sum or dif) has been defined' call endrun (trim(subname)//errormsg) end if if (present(op_f2name)) then write(errormsg, '(3a)') ': creating a composed field using component field 2:',& - trim(op_f2name),' but no field operation (op=sum/dif) has been defined' + trim(op_f2name),' but no field operation (optype=sum or dif) has been defined' call endrun (trim(subname)//errormsg) end if end if From ebbd4ac19cfd6adfe3560cd7662f25592466bf19 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Tue, 25 Apr 2023 13:56:36 -0600 Subject: [PATCH 122/140] PR mods --- src/utils/cam_thermo.F90 | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/src/utils/cam_thermo.F90 b/src/utils/cam_thermo.F90 index 0901540705..f65649c4ef 100644 --- a/src/utils/cam_thermo.F90 +++ b/src/utils/cam_thermo.F90 @@ -235,29 +235,23 @@ subroutine cam_thermo_init() kmcnd(:pcols, :pver, begchunk:endchunk) = shr_infnan_qnan end subroutine cam_thermo_init - - !=========================================================================== - + ! !*************************************************************************** ! - ! cam_thermo_update: update species dependent constants for physics + ! cam_thermo_dry_air_update: update dry air species dependent constants for physics ! !*************************************************************************** ! subroutine cam_thermo_dry_air_update(mmr, T, lchnk, ncol, to_dry_factor) use air_composition, only: dry_air_composition_update use string_utils, only: int2str - !----------------------------------------------------------------------- - ! Update the physics "constants" that vary - !------------------------------------------------------------------------- - !------------------------------Arguments---------------------------------- - !(mmr = dry mixing ratio, if not use to_moist_factor to convert) + !(mmr = dry mixing ratio, if not use to_dry_factor to convert) real(r8), intent(in) :: mmr(:,:,:) ! constituents array real(r8), intent(in) :: T(:,:) ! temperature integer, intent(in) :: lchnk ! Chunk number integer, intent(in) :: ncol ! number of columns - real(r8), optional, intent(in) :: to_dry_factor(:,:) + real(r8), optional, intent(in) :: to_dry_factor(:,:)!if mmr moist convert ! !---------------------------Local storage------------------------------- real(r8):: sponge_factor(SIZE(mmr, 2)) @@ -275,8 +269,14 @@ subroutine cam_thermo_dry_air_update(mmr, T, lchnk, ncol, to_dry_factor) kmcnd(:ncol,:,lchnk), tracer=mmr(:ncol,:,:), fact=to_dry_factor, & active_species_idx_dycore=thermodynamic_active_species_idx) end subroutine cam_thermo_dry_air_update - - subroutine cam_thermo_water_update(mmr, lchnk, ncol, vcoord, to_dry_factor) + ! + !*************************************************************************** + ! + ! cam_thermo_water+update: update water species dependent constants for physics + ! + !*************************************************************************** + ! + subroutine cam_thermo_water_update(mmr, lchnk, ncol, vcoord, to_dry_factor) use air_composition, only: water_composition_update !----------------------------------------------------------------------- ! Update the physics "constants" that vary @@ -1713,10 +1713,10 @@ subroutine get_hydrostatic_energy_1hd(tracer, moist_mixing_ratio, pdel_in, & po_vint(idx) = (phis(idx) * po_vint(idx) * rga) end do case(vc_height) - if ((.not. present(phis)) .or. (.not. present(phis))) then - write(iulog, *) subname, ' phis and phis must be present for ', & + if (.not. present(phis)) then + write(iulog, *) subname, ' phis must be present for ', & 'heigt-based vertical coordinate' - call endrun(subname//': phis and phis must be present for '// & + call endrun(subname//': phis must be present for '// & 'height-based vertical coordinate') end if po_vint = 0._r8 From bf37e82581bd45500b1b083da860b893d8845d85 Mon Sep 17 00:00:00 2001 From: Peter Hjort Lauritzen Date: Tue, 25 Apr 2023 14:08:29 -0600 Subject: [PATCH 123/140] PR stuff --- src/dynamics/se/dp_coupling.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index 8d0ca47bb0..7dae784315 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -661,7 +661,7 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) zvirv(:,:) = zvir end if ! - ! update cp_dycore in modeule air_composition. + ! update cp_dycore in module air_composition. ! (note: at this point q is dry) ! call cam_thermo_water_update(phys_state(lchnk)%q(1:ncol,:,:), lchnk, ncol, vc_dry_pressure) From 8606bf90eb02d2be28edfef6c093e72a0a08c5d4 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Tue, 25 Apr 2023 16:41:39 -0600 Subject: [PATCH 124/140] PR refactor - comments, rename, added parameters --- src/control/budgets.F90 | 40 ++++---- src/control/cam_history.F90 | 138 ++++++++++++++-------------- src/control/cam_history_support.F90 | 18 ++-- src/dynamics/se/dycore_budget.F90 | 7 +- src/dynamics/se/dyn_comp.F90 | 1 + src/dynamics/se/dyn_grid.F90 | 28 ++++-- src/infrastructure/phys_grid.F90 | 3 +- 7 files changed, 123 insertions(+), 112 deletions(-) diff --git a/src/control/budgets.F90 b/src/control/budgets.F90 index 0b41a393e6..89ec3342e6 100644 --- a/src/control/budgets.F90 +++ b/src/control/budgets.F90 @@ -37,26 +37,23 @@ module budgets budget_readnl, &! read budget namelist setting is_budget ! return logical if budget_defined + ! Private + real(r8) :: dstepsize + integer, parameter :: budget_array_max = 500 ! max number of budgets + character*3 :: budget_optype(budget_array_max) = '' ! allows 'dif' or 'sum' + character*3 :: budget_pkgtype(budget_array_max) = '' ! allows 'phy' or 'dyn' ! Public data + integer, public, protected :: budget_num = 0 ! current number of defined budgets. + character(cl), public, protected :: budget_name(budget_array_max) = '' ! budget names + character(cl), public, protected :: budget_longname(budget_array_max) = '' ! descriptive name of budget + character(cl), public, protected :: budget_stagename(budget_array_max)= '' ! shortname of both of the 3 char snapshot components + character(cl), public, protected :: budget_stg1name(budget_array_max) = '' ! The 1st of 2 snapshots used to calculate a budget + character(cl), public, protected :: budget_stg2name(budget_array_max) = '' ! The 2nd of 2 snapshots used to calculate a budget - integer, parameter, public :: budget_array_max = 500 ! max number of budgets + integer, public, protected :: thermo_budget_histfile_num = 1 ! The history tape number for budget fields + logical, public, protected :: thermo_budget_history = .false. ! Turn budgeting on or off - integer, public :: budget_num = 0 ! current number of defined budgets. - character(cl), public, protected :: budget_name(budget_array_max) ! budget names - character(cl), public, protected :: budget_longname(budget_array_max) ! descriptive name of budget - character(cl), public, protected :: budget_stagename(budget_array_max)! shortname of both of the 3 char snapshot components - character(cl), public, protected :: budget_stg1name(budget_array_max) ! The 1st of 2 snapshots used to calculate a budget - character(cl), public, protected :: budget_stg2name(budget_array_max) ! The 2nd of 2 snapshots used to calculate a budget - - integer, public :: thermo_budget_histfile_num = 1 - logical, public :: thermo_budget_history = .false. - real(r8), private :: dstepsize - ! - ! Constants for each budget - - character*3, public :: budget_optype(budget_array_max)! stage or difference or sum - character*3, public :: budget_pkgtype(budget_array_max)! phy or dyn !============================================================================================== CONTAINS @@ -66,7 +63,7 @@ module budgets subroutine budget_readnl(nlfile) use dycore, only: dycore_is use namelist_utils, only: find_group_name - use spmd_utils, only: mpi_character, mpi_logical, mpi_integer + use spmd_utils, only: mpi_character, mpi_logical, mpi_integer, mpi_success use shr_string_mod, only: shr_string_toUpper use string_utils, only: int2str @@ -94,9 +91,9 @@ subroutine budget_readnl(nlfile) ! Broadcast namelist variables call mpi_bcast(thermo_budget_history , 1 , mpi_logical , masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_history") + if (ierr /= mpi_success) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_history") call mpi_bcast(thermo_budget_histfile_num , 1 , mpi_integer , masterprocid, mpicom, ierr) - if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_histfile_num") + if (ierr /= mpi_success) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_histfile_num") ! Write out thermo_budget options if (masterproc) then @@ -165,7 +162,6 @@ subroutine e_m_snapshot (name, pkgtype, longname, cslam) budget_name(budget_num) = trim(name_str) budget_longname(budget_num) = trim(desc_str) - budget_optype(budget_num)='' budget_pkgtype(budget_num)=pkgtype budget_stagename(budget_num)= trim(name) @@ -359,7 +355,7 @@ subroutine budget_get_global (name, me_idx, global) end if CONTAINS - function budget_ind_byname (name) + pure function budget_ind_byname (name) ! ! Get the index of a budget. Ret -1 for not found !-----------------------------Arguments--------------------------------- @@ -382,7 +378,7 @@ end function budget_ind_byname end subroutine budget_get_global !============================================================================== - function is_budget(name) + pure function is_budget(name) ! Get the index of a budget. diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index c2698090a4..7defafc0ba 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -71,7 +71,7 @@ module cam_history type grid_area_entry integer :: decomp_type = -1 ! type of decomposition (e.g., physics or dynamics) - real(r8), allocatable :: wbuf(:,:,:) ! for area weights + real(r8), allocatable :: wbuf(:,:) ! for area weights end type grid_area_entry type (grid_area_entry), target, allocatable:: grid_wts(:) ! area wts for each decomp type type (grid_area_entry), pointer :: allgrids_wt(:) => null() ! area wts for each decomp type @@ -497,20 +497,16 @@ subroutine intht (model_doi_url_in) end if allgrids_wt(wtidx)%decomp_type=fdecomp areawt => cam_grid_get_areawt(fdecomp) - allocate(allgrids_wt(wtidx(1))%wbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) - allgrids_wt(wtidx(1))%wbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)=0._r8 + allocate(allgrids_wt(wtidx(1))%wbuf(begdim1:enddim1,begdim3:enddim3)) + allgrids_wt(wtidx(1))%wbuf(begdim1:enddim1,begdim3:enddim3)=0._r8 count=0 do c=begdim3,enddim3 dimind = tape(t)%hlist(f)%field%get_dims(c) ib=dimind%beg1 ie=dimind%end1 - jb=dimind%beg2 - je=dimind%end2 - do k=jb,je - do i=ib,ie - count=count+1 - allgrids_wt(wtidx(1))%wbuf(i,k,c)=areawt(count) - end do + do i=ib,ie + count=count+1 + allgrids_wt(wtidx(1))%wbuf(i,c)=areawt(count) end do end do tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf @@ -998,37 +994,37 @@ subroutine define_composed_field_ids(t) character(len=max_fieldname_len) :: field1 character(len=max_fieldname_len) :: field2 character(len=*), parameter :: subname='define_composed_field_ids' + logical :: is_composed - do f = 1, nflds(t) - if (composed_field(trim(tape(t)%hlist(f)%field%name), & - field1, field2)) then - if (len_trim(field1) > 0 .and. len_trim(field2) > 0) then - ! set field1/field2 names for htape from the masterfield list - tape(t)%hlist(f)%op_field1=trim(field1) - tape(t)%hlist(f)%op_field2=trim(field2) - ! find ids for field1/2 - do ff = 1, nflds(t) - if (trim(field1) == trim(tape(t)%hlist(ff)%field%name)) then - tape(t)%hlist(f)%field%op_field1_id = ff - end if - if (trim(field2) == trim(tape(t)%hlist(ff)%field%name)) then - tape(t)%hlist(f)%field%op_field2_id = ff - end if - end do - if (tape(t)%hlist(f)%field%op_field1_id == -1) then - call endrun(trim(subname)//': No op_field1 match for '//trim(tape(t)%hlist(f)%field%name)) + do f = 1, nflds(t) + call composed_field_info(tape(t)%hlist(f)%field%name,is_composed,fname1=field1,fname2=field2) + if (is_composed) then + if (len_trim(field1) > 0 .and. len_trim(field2) > 0) then + ! set field1/field2 names for htape from the masterfield list + tape(t)%hlist(f)%op_field1=trim(field1) + tape(t)%hlist(f)%op_field2=trim(field2) + ! find ids for field1/2 + do ff = 1, nflds(t) + if (trim(field1) == trim(tape(t)%hlist(ff)%field%name)) then + tape(t)%hlist(f)%field%op_field1_id = ff end if - if (tape(t)%hlist(f)%field%op_field2_id == -1) then - call endrun(trim(subname)//': No op_field2 match for '//trim(tape(t)%hlist(f)%field%name)) + if (trim(field2) == trim(tape(t)%hlist(ff)%field%name)) then + tape(t)%hlist(f)%field%op_field2_id = ff end if - else - call endrun(trim(subname)//': Component fields not found for composed field') + end do + if (tape(t)%hlist(f)%field%op_field1_id == -1) then + call endrun(trim(subname)//': No op_field1 match for '//trim(tape(t)%hlist(f)%field%name)) + end if + if (tape(t)%hlist(f)%field%op_field2_id == -1) then + call endrun(trim(subname)//': No op_field2 match for '//trim(tape(t)%hlist(f)%field%name)) end if + else + call endrun(trim(subname)//': Component fields not found for composed field') end if - end do + end if + end do end subroutine define_composed_field_ids - subroutine restart_vars_setnames() ! Local variable @@ -2181,19 +2177,15 @@ subroutine read_restart_history (File) end if allgrids_wt(wtidx)%decomp_type=fdecomp areawt => cam_grid_get_areawt(fdecomp) - allocate(allgrids_wt(wtidx(1))%wbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) + allocate(allgrids_wt(wtidx(1))%wbuf(begdim1:enddim1,begdim3:enddim3)) cnt=0 do c=begdim3,enddim3 dimind = tape(t)%hlist(f)%field%get_dims(c) ib=dimind%beg1 ie=dimind%end1 - jb=dimind%beg2 - je=dimind%end2 - do k=jb,je - do i=ib,ie - cnt=cnt+1 - allgrids_wt(wtidx(1))%wbuf(i,k,c)=areawt(cnt) - end do + do i=ib,ie + cnt=cnt+1 + allgrids_wt(wtidx(1))%wbuf(i,c)=areawt(cnt) end do end do tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf @@ -3549,7 +3541,7 @@ end subroutine subcol_field_avg_handler type (active_entry), pointer :: otape(:) ! Local history_tape pointer real(r8),pointer :: hbuf(:,:) ! history buffer - real(r8),pointer :: wbuf(:,:) ! area weights for field + real(r8),pointer :: wbuf(:) ! area weights for field real(r8),pointer :: sbuf(:,:) ! variance buffer integer, pointer :: nacs(:) ! accumulation counter integer :: begdim2, enddim2, endi @@ -3590,7 +3582,7 @@ end subroutine subcol_field_avg_handler nacs => otape(t)%hlist(f)%nacs(:,c) hbuf => otape(t)%hlist(f)%hbuf(:,:,c) if (associated(tape(t)%hlist(f)%wbuf)) then - wbuf => otape(t)%hlist(f)%wbuf(:,:,c) + wbuf => otape(t)%hlist(f)%wbuf(:,c) endif if (associated(tape(t)%hlist(f)%sbuf)) then sbuf => otape(t)%hlist(f)%sbuf(:,:,c) @@ -5048,7 +5040,7 @@ subroutine h_global (f, t) do j1 = dimind%beg2, dimind%end2 do i1 = dimind%beg1, dimind%end1 count=count+1 - globalarr(count)=globalarr(count)+tape(t)%hlist(f)%hbuf(i1,j1,ie)*tape(t)%hlist(f)%wbuf(i1,j1,ie) + globalarr(count)=globalarr(count)+tape(t)%hlist(f)%hbuf(i1,j1,ie)*tape(t)%hlist(f)%wbuf(i1,ie) end do end do end do @@ -5105,7 +5097,7 @@ subroutine h_field_op (f, t) tape(t)%hlist(f1)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) + & tape(t)%hlist(f2)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) else - call endrun('h_field_op: ERROR: budget_optype unknown:'//trim(optype)) + call endrun('h_field_op: ERROR: composed field operation type unknown:'//trim(optype)) end if end do ! Set nsteps for composed fields using value of one of the component fields @@ -5678,10 +5670,9 @@ subroutine addfld_1d(fname, vdim_name, avgflag, units, long_name, & ! every other; only during LW/SW radiation calcs, etc. character(len=*), intent(in), optional :: standard_name ! CF standard name (max_chars) real(r8), intent(in), optional :: fill_value - character(len=*), intent(in), optional :: optype ! currently 'dif' or 'sum' supported + character(len=*), intent(in), optional :: optype ! currently 'dif' or 'sum' is supported character(len=*), intent(in), optional :: op_f1name ! first field to be operated on character(len=*), intent(in), optional :: op_f2name ! second field which is subtracted from or added to first field - ! ! Local workspace ! @@ -5996,46 +5987,51 @@ logical function field_part_of_vector(fname, meridional_name, zonal_name) end function field_part_of_vector !####################################################################### - ! composed field: Determine if fname is composed from 2 other - ! fields - ! Optionally fill in the names of the composing fields - logical function composed_field(fname, fname1, fname2) + ! composed field_info: Determine if a field is derived from a mathematical + ! operation using 2 other defined fields. Optionally, + ! retrieve names of the composing fields + subroutine composed_field_info(fname, is_composed, fname1, fname2) ! Dummy arguments character(len=*), intent(in) :: fname + logical, intent(out) :: is_composed character(len=*), optional, intent(out) :: fname1 character(len=*), optional, intent(out) :: fname2 ! Local variables type(master_entry), pointer :: listentry + character(len=128) :: errormsg + character(len=*), parameter :: subname='composed_field_info' listentry => get_entry_by_name(masterlinkedlist, fname) if (associated(listentry)) then if ( (len_trim(listentry%op_field1) > 0) .or. & (len_trim(listentry%op_field2) > 0)) then - composed_field = .true. - if (present(fname1)) then - fname1 = listentry%op_field1 - end if - if (present(fname2)) then - fname2 = listentry%op_field2 - end if + is_composed = .true. else - composed_field = .false. - end if - else - composed_field = .false. - end if - if (.not. composed_field) then - if (present(fname1)) then - fname1 = '' + is_composed = .false. end if - if (present(fname2)) then - fname2 = '' + if (is_composed) then + if (present(fname1)) then + fname1=trim(listentry%op_field1) + end if + if (present(fname2)) then + fname2=trim(listentry%op_field2) + end if + else + if (present(fname1)) then + fname1 = '' + end if + if (present(fname2)) then + fname2 = '' + end if end if - end if + else + write(errormsg, '(3a)') ': Field:',trim(fname),' not defined in masterlist' + call endrun (trim(subname)//errormsg) + end if - end function composed_field + end subroutine composed_field_info ! register_vector_field: Register a pair of history field names as diff --git a/src/control/cam_history_support.F90 b/src/control/cam_history_support.F90 index dacb3c554d..495ce7b519 100644 --- a/src/control/cam_history_support.F90 +++ b/src/control/cam_history_support.F90 @@ -119,8 +119,8 @@ module cam_history_support integer :: zonal_complement ! zonal field id or -1 character(len=field_op_len) :: field_op = '' ! 'sum' or 'dif' - integer :: op_field1_id ! first field id to be summed/diffed or -1 - integer :: op_field2_id ! second field id to be summed/diffed or -1 + integer :: op_field1_id ! first field id or -1 + integer :: op_field2_id ! second field id or -1 character(len=max_fieldname_len) :: name ! field name character(len=max_chars) :: long_name ! long name @@ -161,14 +161,14 @@ module cam_history_support type (field_info) :: field ! field information character(len=1) :: avgflag ! averaging flag character(len=max_chars) :: time_op ! time operator (e.g. max, min, avg) - character(len=max_fieldname_len) :: op_field1 ! field1 name for sum/dif operation - character(len=max_fieldname_len) :: op_field2 ! field2 name for sum/dif operation + character(len=max_fieldname_len) :: op_field1 ! field1 name for sum or dif operation + character(len=max_fieldname_len) :: op_field2 ! field2 name for sum or dif operation integer :: hwrt_prec ! history output precision real(r8), pointer :: hbuf(:,:,:) => NULL() real(r8), private :: hbuf_integral ! area weighted integral of active field real(r8), pointer :: sbuf(:,:,:) => NULL() ! for standard deviation - real(r8), pointer :: wbuf(:,:,:) => NULL() ! pointer to area weights + real(r8), pointer :: wbuf(:,:) => NULL() ! pointer to area weights type(var_desc_t), pointer :: varid(:) => NULL() ! variable ids integer, pointer :: nacs(:,:) => NULL() ! accumulation counter type(var_desc_t), pointer :: nacs_varid => NULL() @@ -451,9 +451,11 @@ type(dim_index_3d) function field_info_get_dims_3d(this) result(dims) end function field_info_get_dims_3d ! field_info_is_composed: Return whether this field is composed of two other fields - logical function field_info_is_composed(this) - class(field_info) :: this - field_info_is_composed = (trim(adjustl(this%field_op))=='sum' .or. trim(adjustl(this%field_op))=='dif') + pure logical function field_info_is_composed(this) + class(field_info), intent(IN) :: this + + field_info_is_composed = ((trim(adjustl(this%field_op))=='sum' .or. trim(adjustl(this%field_op))=='dif') .and. & + this%op_field1_id /= -1 .and. this%op_field2_id /= -1) end function field_info_is_composed ! field_info_get_shape: Return a pointer to the field's global shape. diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index d344295bc6..6749bc72ce 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -370,9 +370,10 @@ subroutine print_budget(hstwr) write(iulog,*) " physics total = parameterizations + efix + dry-mass adjustment" write(iulog,*) " " end do - if (ftype==1) then - call endrun(subname//"Physics-dynamics coupling error. See atm.log") - end if +! Temporarily disable endrun until energy bias for consistancy check 2 is better understood. +! if (ftype==1) then +! call endrun(subname//"Physics-dynamics coupling error. See atm.log") +! end if end if else write(iulog,'(a47,F6.2,a6)')" dE/dt physics tendency in dynamics (dBD-dAF) ",dEdt_phys_total_in_dyn(1)," W/M^2" diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index ec666cb402..708822f752 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -84,6 +84,7 @@ module dyn_comp real(r8), parameter :: rad2deg = 180.0_r8 / pi real(r8), parameter :: deg2rad = pi / 180.0_r8 +real(r8), parameter :: rarea_sphere = 1.0_r8 / (4.0_r8*PI) !=============================================================================== contains diff --git a/src/dynamics/se/dyn_grid.F90 b/src/dynamics/se/dyn_grid.F90 index b20bdad4c4..766fb893d7 100644 --- a/src/dynamics/se/dyn_grid.F90 +++ b/src/dynamics/se/dyn_grid.F90 @@ -735,8 +735,6 @@ subroutine define_cam_grids() use shr_const_mod, only: PI => SHR_CONST_PI ! Local variables - real(r8), parameter :: area_sphere = 4.0_r8*PI - integer :: i, ii, j, k, ie, mapind character(len=8) :: latname, lonname, ncolname, areaname @@ -746,8 +744,8 @@ subroutine define_cam_grids() real(r8), allocatable :: pelat_deg(:) ! pe-local latitudes (degrees) real(r8), allocatable :: pelon_deg(:) ! pe-local longitudes (degrees) - real(r8), pointer :: pearea(:) => null() ! pe-local areas - real(r8), pointer :: pearea_wt(:) => null() ! pe-local areas + real(r8), pointer :: pearea(:) ! pe-local areas + real(r8), pointer :: pearea_wt(:) ! pe-local areas normalized for unit sphere integer(iMap) :: fdofP_local(npsq,nelemd) ! pe-local map for dynamics decomp integer(iMap), allocatable :: pemap(:) ! pe-local map for PIO decomp @@ -762,8 +760,24 @@ subroutine define_cam_grids() real(r8), pointer :: physgrid_area(:) real(r8), pointer :: physgrid_areawt(:) integer(iMap), pointer :: physgrid_map(:) + + real(r8), parameter :: rarea_unit_sphere = 1.0_r8 / (4.0_r8*PI) + !---------------------------------------------------------------------------- + !----------------------- + ! initialize pointers to null + !----------------------- + nullify(pearea_wt) + nullify(pearea) + nullify(fvm_area) + nullify(fvm_areawt) + nullify(fvm_map) + nullify(physgrid_area) + nullify(physgrid_areawt) + nullify(physgrid_map) + nullify(grid_map) + !----------------------- ! Create GLL grid object !----------------------- @@ -791,7 +805,7 @@ subroutine define_cam_grids() do j = 1, np do i = 1, np pearea(ii) = elem(ie)%mp(i,j)*elem(ie)%metdet(i,j) - pearea_wt(ii) = pearea(ii)/area_sphere + pearea_wt(ii) = pearea(ii)*rarea_unit_sphere pelat_deg(ii) = elem(ie)%spherep(i,j)%lat * rad2deg pelon_deg(ii) = elem(ie)%spherep(i,j)%lon * rad2deg ii = ii + 1 @@ -901,7 +915,7 @@ subroutine define_cam_grids() fvm_coord(mapind) = fvm(ie)%center_cart(i,j)%lon*rad2deg fvm_map(mapind) = k + ((elem(ie)%GlobalId-1) * nc * nc) fvm_area(mapind) = fvm(ie)%area_sphere(i,j) - fvm_areawt(mapind) = fvm_area(mapind)/area_sphere + fvm_areawt(mapind) = fvm_area(mapind)*rarea_unit_sphere k = k + 1 end do end do @@ -976,7 +990,7 @@ subroutine define_cam_grids() physgrid_coord(mapind) = fvm(ie)%center_cart_physgrid(i,j)%lon*rad2deg physgrid_map(mapind) = k + ((elem(ie)%GlobalId-1) * fv_nphys * fv_nphys) physgrid_area(mapind) = fvm(ie)%area_sphere_physgrid(i,j) - physgrid_areawt(mapind) = physgrid_area(mapind)/area_sphere + physgrid_areawt(mapind) = physgrid_area(mapind)*rarea_unit_sphere k = k + 1 end do end do diff --git a/src/infrastructure/phys_grid.F90 b/src/infrastructure/phys_grid.F90 index ea5b5ccc5e..3426c86f27 100644 --- a/src/infrastructure/phys_grid.F90 +++ b/src/infrastructure/phys_grid.F90 @@ -216,6 +216,7 @@ subroutine phys_grid_init() character(len=hclen), pointer :: copy_attributes(:) character(len=hclen) :: copy_gridname character(len=*), parameter :: subname = 'phys_grid_init: ' + real(r8), parameter :: rarea_sphere = 1.0_r8 / (4.0_r8*PI) nullify(lonvals) nullify(latvals) @@ -422,7 +423,7 @@ subroutine phys_grid_init() allocate(areawt_d(size(grid_map, 2))) do col_index = 1, columns_on_task - areawt_d(col_index) = phys_columns(col_index)%weight/(4.0_r8*PI) + areawt_d(col_index) = phys_columns(col_index)%weight*rarea_sphere end do call cam_grid_attribute_register('physgrid', 'areawt', & 'physics column area weight', 'ncol', areawt_d, map=grid_map(3,:)) From 89bd77035cb6e1468f6a85519d4f03415c7f9fc8 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Wed, 26 Apr 2023 11:59:11 -0600 Subject: [PATCH 125/140] rename file/module budgets to cam_budget along with external subroutines --- src/control/{budgets.F90 => cam_budget.F90} | 52 +++++++++---------- src/control/cam_history.F90 | 5 ++ src/control/runtime_opts.F90 | 4 +- src/dynamics/eul/dycore_budget.F90 | 2 +- src/dynamics/fv/dycore_budget.F90 | 2 +- src/dynamics/fv3/dycore_budget.F90 | 2 +- src/dynamics/mpas/dp_coupling.F90 | 2 +- src/dynamics/mpas/dycore_budget.F90 | 2 +- src/dynamics/mpas/dyn_comp.F90 | 12 ++--- src/dynamics/se/dycore/prim_advance_mod.F90 | 2 +- src/dynamics/se/dycore_budget.F90 | 56 ++++++++++----------- src/dynamics/se/dyn_comp.F90 | 25 ++++----- src/physics/cam/cam_diagnostics.F90 | 24 ++++----- src/physics/cam/check_energy.F90 | 2 +- src/physics/cam/physpkg.F90 | 4 +- src/physics/cam_dev/physpkg.F90 | 6 +-- src/physics/simple/physpkg.F90 | 6 +-- 17 files changed, 107 insertions(+), 101 deletions(-) rename src/control/{budgets.F90 => cam_budget.F90} (92%) diff --git a/src/control/budgets.F90 b/src/control/cam_budget.F90 similarity index 92% rename from src/control/budgets.F90 rename to src/control/cam_budget.F90 index 89ec3342e6..75d89250f5 100644 --- a/src/control/budgets.F90 +++ b/src/control/cam_budget.F90 @@ -1,16 +1,16 @@ -module budgets +module cam_budget !---------------------------------------------------------------------------- ! ! Adds support for energy and mass snapshots and budgets using cam_history api. ! ! Public functions/subroutines: ! - ! budget_init - ! e_m_snapshot - ! e_m_budget + ! cam_budget_init + ! cam_budget_em_snapshot + ! cam_budget_em_budget + ! cam_budget_get_global + ! cam_budget_readnl ! budget_ind_byname - ! budget_get_global - ! budget_readnl ! is_budget !----------------------------------------------------------------------- @@ -30,11 +30,11 @@ module budgets ! Public interfaces public :: & - budget_init, &! initialize budget variables - e_m_snapshot, &! define a snapshot and add to history buffer - e_m_budget, &! define a budget and add to history buffer - budget_get_global, &! get global budget from history buffer - budget_readnl, &! read budget namelist setting + cam_budget_init, &! initialize budget variables + cam_budget_em_snapshot, &! define a snapshot and add to history buffer + cam_budget_em_budget, &! define a budget and add to history buffer + cam_budget_get_global, &! get global budget from history buffer + cam_budget_readnl, &! read budget namelist setting is_budget ! return logical if budget_defined ! Private @@ -60,7 +60,7 @@ module budgets !============================================================================================== ! ! Read namelist variables. - subroutine budget_readnl(nlfile) + subroutine cam_budget_readnl(nlfile) use dycore, only: dycore_is use namelist_utils, only: find_group_name use spmd_utils, only: mpi_character, mpi_logical, mpi_integer, mpi_success @@ -72,7 +72,7 @@ subroutine budget_readnl(nlfile) ! Local variables integer :: unitn, ierr - character(len=*), parameter :: subname = 'budget_readnl :: ' + character(len=*), parameter :: subname = 'cam_budget_readnl :: ' namelist /thermo_budget_nl/ thermo_budget_history, thermo_budget_histfile_num !----------------------------------------------------------------------- @@ -106,20 +106,20 @@ subroutine budget_readnl(nlfile) end if end if end if - end subroutine budget_readnl + end subroutine cam_budget_readnl !============================================================================================== - subroutine budget_init() + subroutine cam_budget_init() use time_manager, only: get_step_size dstepsize=get_step_size() - end subroutine budget_init + end subroutine cam_budget_init !============================================================================================== - subroutine e_m_snapshot (name, pkgtype, longname, cslam) + subroutine cam_budget_em_snapshot (name, pkgtype, longname, cslam) use dycore, only: dycore_is character(len=*), intent(in) :: & @@ -137,7 +137,7 @@ subroutine e_m_snapshot (name, pkgtype, longname, cslam) character (cl) :: gridname logical :: cslamtr ! using cslam transport for mass tracers integer :: ivars - character(len=*), parameter :: sub='e_m_snapshot' + character(len=*), parameter :: sub='cam_budget_em_snapshot' !----------------------------------------------------------------------- if (thermo_budget_history) then @@ -186,11 +186,11 @@ subroutine e_m_snapshot (name, pkgtype, longname, cslam) call add_default(TRIM(ADJUSTL(name_str)), thermo_budget_histfile_num, 'N') end do end if - end subroutine e_m_snapshot + end subroutine cam_budget_em_snapshot !============================================================================== - subroutine e_m_budget (name, stg1name, stg2name, pkgtype, optype, longname, cslam) + subroutine cam_budget_em_budget (name, stg1name, stg2name, pkgtype, optype, longname, cslam) use dycore, only: dycore_is @@ -211,7 +211,7 @@ subroutine e_m_budget (name, stg1name, stg2name, pkgtype, optype, longname, csla logical, intent(in), optional :: & cslam ! true => use cslam to transport mass variables - character(len=*), parameter :: sub='e_m_budget' + character(len=*), parameter :: sub='cam_budget_em_budget' character(cl) :: errmsg character(len=1) :: opchar character (len=max_fieldname_len) :: name_str @@ -284,11 +284,11 @@ subroutine e_m_budget (name, stg1name, stg2name, pkgtype, optype, longname, csla call add_default(TRIM(ADJUSTL(name_str)), thermo_budget_histfile_num, 'N') end do end if - end subroutine e_m_budget + end subroutine cam_budget_em_budget !============================================================================== - subroutine budget_get_global (name, me_idx, global) + subroutine cam_budget_get_global (name, me_idx, global) use cam_history, only: get_field_properties use cam_history_support, only: active_entry,ptapes @@ -312,7 +312,7 @@ subroutine budget_get_global (name, me_idx, global) integer :: m ! budget index logical :: found ! true if global integral found - character(len=*), parameter :: sub='budget_get_global' + character(len=*), parameter :: sub='cam_budget_get_global' !----------------------------------------------------------------------- ! Initialize tape pointer here to avoid initialization only on first invocation nullify(tape) @@ -375,7 +375,7 @@ pure function budget_ind_byname (name) end if end do end function budget_ind_byname - end subroutine budget_get_global + end subroutine cam_budget_get_global !============================================================================== pure function is_budget(name) @@ -404,4 +404,4 @@ end function is_budget !=========================================================================== -end module budgets +end module cam_budget diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 7defafc0ba..c3dd6de35a 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -5905,6 +5905,11 @@ subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & end do if (present(optype)) then + ! make sure optype is "sum" or "dif" + if (.not.(trim(optype) == 'dif' .or. trim(optype) == 'sum')) then + write(errormsg, '(2a)')': Fatal : optype must be "sum" or "dif" not ',trim(optype) + call endrun (trim(subname)//errormsg) + end if listentry%field%field_op = optype if (present(op_f1name).and.present(op_f2name)) then ! Look for the field IDs diff --git a/src/control/runtime_opts.F90 b/src/control/runtime_opts.F90 index e55243cbd9..55120a894b 100644 --- a/src/control/runtime_opts.F90 +++ b/src/control/runtime_opts.F90 @@ -97,7 +97,7 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) use qneg_module, only: qneg_readnl use lunar_tides, only: lunar_tides_readnl use upper_bc, only: ubc_readnl - use budgets, only: budget_readnl + use cam_budget, only: cam_budget_readnl use phys_grid_ctem, only: phys_grid_ctem_readnl !---------------------------Arguments----------------------------------- @@ -197,7 +197,7 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) call dyn_readnl(nlfilename) call ionosphere_readnl(nlfilename) call qneg_readnl(nlfilename) - call budget_readnl(nlfilename) + call cam_budget_readnl(nlfilename) call phys_grid_ctem_readnl(nlfilename) end subroutine read_namelist diff --git a/src/dynamics/eul/dycore_budget.F90 b/src/dynamics/eul/dycore_budget.F90 index e89a167a20..7531d69ac7 100644 --- a/src/dynamics/eul/dycore_budget.F90 +++ b/src/dynamics/eul/dycore_budget.F90 @@ -11,7 +11,7 @@ subroutine print_budget(hstwr) use spmd_utils, only: masterproc use cam_abortutils, only: endrun - use budgets, only: thermo_budget_history,thermo_budget_histfile_num + use cam_budget, only: thermo_budget_history,thermo_budget_histfile_num ! arguments logical, intent(in) :: hstwr(:) diff --git a/src/dynamics/fv/dycore_budget.F90 b/src/dynamics/fv/dycore_budget.F90 index 1f976a4708..a672fef9cc 100644 --- a/src/dynamics/fv/dycore_budget.F90 +++ b/src/dynamics/fv/dycore_budget.F90 @@ -11,7 +11,7 @@ subroutine print_budget(hstwr) use spmd_utils, only: masterproc use cam_abortutils, only: endrun - use budgets, only: thermo_budget_histfile_num, thermo_budget_history + use cam_budget, only: thermo_budget_histfile_num, thermo_budget_history ! arguments logical, intent(in) :: hstwr(:) diff --git a/src/dynamics/fv3/dycore_budget.F90 b/src/dynamics/fv3/dycore_budget.F90 index bf8901248e..0645edb251 100644 --- a/src/dynamics/fv3/dycore_budget.F90 +++ b/src/dynamics/fv3/dycore_budget.F90 @@ -12,7 +12,7 @@ subroutine print_budget(hstwr) use spmd_utils, only: masterproc use cam_abortutils, only: endrun - use budgets, only: thermo_budget_histfile_num, thermo_budget_history + use cam_budget, only: thermo_budget_histfile_num, thermo_budget_history ! arguments logical, intent(in) :: hstwr(:) diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index 7cd1ce936d..792a7d54b0 100644 --- a/src/dynamics/mpas/dp_coupling.F90 +++ b/src/dynamics/mpas/dp_coupling.F90 @@ -47,7 +47,7 @@ subroutine d_p_coupling(phys_state, phys_tend, pbuf2d, dyn_out) ! dry air mass. use cam_history, only : hist_fld_active use mpas_constants, only : Rv_over_Rd => rvord - use budgets, only : thermo_budget_history + use cam_budget, only : thermo_budget_history ! arguments type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index da11d617de..f78cf28c20 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -13,7 +13,7 @@ module dycore_budget subroutine print_budget(hstwr) - use budgets, only: budget_get_global, thermo_budget_histfile_num, thermo_budget_history + use cam_budget, only: cam_budget_get_global, thermo_budget_histfile_num, thermo_budget_history use spmd_utils, only: masterproc use cam_logfile, only: iulog use cam_abortutils, only: endrun diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index ec729d1ea3..755dbcc64f 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -40,7 +40,7 @@ module dyn_comp use mpas_timekeeping, only : MPAS_TimeInterval_type use cam_mpas_subdriver, only: cam_mpas_global_sum_real -use budgets, only: e_m_snapshot, e_m_budget +use cam_budget, only: cam_budget_em_snapshot, cam_budget_em_budget implicit none @@ -316,7 +316,7 @@ subroutine dyn_init(dyn_in, dyn_out) use dyn_tests_utils, only : vc_dycore, vc_height, string_vc, vc_str_lgth use constituents, only : cnst_get_ind use phys_control, only: phys_getopts - use budgets, only: thermo_budget_history + use cam_budget, only: thermo_budget_history ! arguments: type(dyn_import_t), intent(inout) :: dyn_in @@ -537,17 +537,17 @@ subroutine dyn_init(dyn_in, dyn_out) ! Define energy/mass snapshots using stage structure do istage = 1, num_stages - call e_m_snapshot(TRIM(ADJUSTL(stage(istage))), 'dyn', longname=TRIM(ADJUSTL(stage_txt(istage)))) + call cam_budget_em_snapshot(TRIM(ADJUSTL(stage(istage))), 'dyn', longname=TRIM(ADJUSTL(stage_txt(istage)))) end do ! ! initialize MPAS energy budgets ! add budgets that are derived from stages ! - call e_m_budget('dEdt_param_efix_in_dyn','dAP','dBF',pkgtype='dyn',optype='dif', & + call cam_budget_em_budget('dEdt_param_efix_in_dyn','dAP','dBF',pkgtype='dyn',optype='dif', & longname="dE/dt parameterizations+efix in dycore (dparam)(dAP-dBF)") - call e_m_budget('dEdt_dme_adjust_in_dyn','dAM','dAP',pkgtype='dyn',optype='dif', & + call cam_budget_em_budget('dEdt_dme_adjust_in_dyn','dAM','dAP',pkgtype='dyn',optype='dif', & longname="dE/dt dry mass adjustment in dycore (dAM-dAP)") - call e_m_budget('dEdt_phys_total_in_dyn','dAM','dBF',pkgtype='dyn',optype='dif', & + call cam_budget_em_budget('dEdt_phys_total_in_dyn','dAM','dBF',pkgtype='dyn',optype='dif', & longname="dE/dt physics total in dycore (phys) (dAM-dBF)") end if diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index 211fa06324..c9f1ac194b 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -1454,7 +1454,7 @@ subroutine tot_energy_dyn(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suffix) use air_composition, only: thermodynamic_active_species_ice_num,thermodynamic_active_species_ice_idx use dimensions_mod, only: cnst_name_gll use dyn_tests_utils, only: vcoord=>vc_dry_pressure - use budgets, only: thermo_budget_history + use cam_budget, only: thermo_budget_history !------------------------------Arguments-------------------------------- type (element_t) , intent(inout) :: elem(:) diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index 6749bc72ce..af9bf1d1b0 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -18,7 +18,7 @@ subroutine print_budget(hstwr) use spmd_utils, only: masterproc use cam_abortutils, only: endrun use cam_logfile, only: iulog - use budgets, only: budget_get_global, is_budget, thermo_budget_histfile_num, thermo_budget_history + use cam_budget, only: cam_budget_get_global, is_budget, thermo_budget_histfile_num, thermo_budget_history use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv, & teidx, seidx, keidx, poidx use dimensions_mod, only: use_cslam @@ -111,35 +111,35 @@ subroutine print_budget(hstwr) ! ! CAM physics energy tendencies ! - call budget_get_global('phAP-phBP',idx(i),dEdt_param_physE(i)) - call budget_get_global('phBP-phBF',idx(i),dEdt_efix_physE(i)) - call budget_get_global('phAM-phAP',idx(i),dEdt_dme_adjust_physE(i)) - call budget_get_global('phAP-phBF',idx(i),dEdt_param_efix_physE(i)) + call cam_budget_get_global('phAP-phBP',idx(i),dEdt_param_physE(i)) + call cam_budget_get_global('phBP-phBF',idx(i),dEdt_efix_physE(i)) + call cam_budget_get_global('phAM-phAP',idx(i),dEdt_dme_adjust_physE(i)) + call cam_budget_get_global('phAP-phBF',idx(i),dEdt_param_efix_physE(i)) ! ! CAM physics energy tendencies using dycore energy formula scaling ! temperature tendencies for consistency with CAM physics ! - call budget_get_global('dyAP-dyBP',idx(i),dEdt_param_dynE(i)) - call budget_get_global('dyBP-dyBF',idx(i),dEdt_efix_dynE(i)) - call budget_get_global('dyAM-dyAP',idx(i),dEdt_dme_adjust_dynE(i)) - call budget_get_global('dyAP-dyBF',idx(i),dEdt_param_efix_dynE(i)) - call budget_get_global('dyAM-dyBF',idx(i),dEdt_phys_total_dynE(i)) - call budget_get_global('dyBF' ,idx(i),E_dyBF(i))!state beginning physics + call cam_budget_get_global('dyAP-dyBP',idx(i),dEdt_param_dynE(i)) + call cam_budget_get_global('dyBP-dyBF',idx(i),dEdt_efix_dynE(i)) + call cam_budget_get_global('dyAM-dyAP',idx(i),dEdt_dme_adjust_dynE(i)) + call cam_budget_get_global('dyAP-dyBF',idx(i),dEdt_param_efix_dynE(i)) + call cam_budget_get_global('dyAM-dyBF',idx(i),dEdt_phys_total_dynE(i)) + call cam_budget_get_global('dyBF' ,idx(i),E_dyBF(i))!state beginning physics ! ! CAM physics energy tendencies in dynamical core ! - call budget_get_global('dBD-dAF',idx(i),dEdt_phys_total_in_dyn(i)) - call budget_get_global('dBF' ,idx(i),E_dBF(i)) !state passed to physics + call cam_budget_get_global('dBD-dAF',idx(i),dEdt_phys_total_in_dyn(i)) + call cam_budget_get_global('dBF' ,idx(i),E_dBF(i)) !state passed to physics end do - call budget_get_global('dAD-dBD',teidx,dEdt_floating_dyn) - call budget_get_global('dAR-dAD',teidx,dEdt_vert_remap) + call cam_budget_get_global('dAD-dBD',teidx,dEdt_floating_dyn) + call cam_budget_get_global('dAR-dAD',teidx,dEdt_vert_remap) dEdt_dycore_dyn = dEdt_floating_dyn+dEdt_vert_remap - call budget_get_global('dCH-dBH',teidx,dEdt_del4) - call budget_get_global('dAH-dCH',teidx,dEdt_del4_fric_heat) - call budget_get_global('dAH-dBH',teidx,dEdt_del4_tot) - call budget_get_global('dAS-dBS',teidx,dEdt_del2_sponge) + call cam_budget_get_global('dCH-dBH',teidx,dEdt_del4) + call cam_budget_get_global('dAH-dCH',teidx,dEdt_del4_fric_heat) + call cam_budget_get_global('dAH-dBH',teidx,dEdt_del4_tot) + call cam_budget_get_global('dAS-dBS',teidx,dEdt_del2_sponge) dEdt_del2_del4_tot = dEdt_del4_tot+dEdt_del2_sponge dEdt_residual = dEdt_floating_dyn-dEdt_del2_del4_tot @@ -425,10 +425,10 @@ subroutine print_budget(hstwr) if (thermo_budget_vars_massv(m_cnst)) then write(iulog,*)thermo_budget_vars_descriptor(m_cnst) write(iulog,*)"------------------------------" - call budget_get_global('phBP-phBF',m_cnst,dMdt_efix) - call budget_get_global('phAM-phAP',m_cnst,dMdt_dme_adjust) - call budget_get_global('phAP-phBP',m_cnst,dMdt_parameterizations) - call budget_get_global('phAM-phBF',m_cnst,dMdt_phys_total) + call cam_budget_get_global('phBP-phBF',m_cnst,dMdt_efix) + call cam_budget_get_global('phAM-phAP',m_cnst,dMdt_dme_adjust) + call cam_budget_get_global('phAP-phBP',m_cnst,dMdt_parameterizations) + call cam_budget_get_global('phAM-phBF',m_cnst,dMdt_phys_total) ! ! total energy fixer should not affect mass - checking ! @@ -459,8 +459,8 @@ subroutine print_budget(hstwr) ! detailed mass budget in dynamical core ! if (is_budget('dAD').and.is_budget('dBD').and.is_budget('dAR').and.is_budget('dCH')) then - call budget_get_global('dAD-dBD',m_cnst,dMdt_floating_dyn) - call budget_get_global('dAR-dAD',m_cnst,dMdt_vert_remap) + call cam_budget_get_global('dAD-dBD',m_cnst,dMdt_floating_dyn) + call cam_budget_get_global('dAR-dAD',m_cnst,dMdt_vert_remap) tmp = dMdt_floating_dyn+dMdt_vert_remap diff = abs_diff(tmp,0.0_r8,pf=pf) write(iulog,fmtm)" dMASS/dt total adiabatic dynamics ",diff,pf @@ -477,8 +477,8 @@ subroutine print_budget(hstwr) write(iulog,*)" " write(iulog,*)"Breakdown of 2D dynamics:" write(iulog,*)" " - call budget_get_global('dAH-dCH',m_cnst,dMdt_del4_fric_heat) - call budget_get_global('dAH-dBH',m_cnst,dMdt_del4_tot) + call cam_budget_get_global('dAH-dCH',m_cnst,dMdt_del4_fric_heat) + call cam_budget_get_global('dAH-dBH',m_cnst,dMdt_del4_tot) write(iulog,*)"dMASS/dt hypervis (dAH-dBH) ",dMdt_del4_tot," Pa/m^2/s" write(iulog,*)"dMASS/dt frictional heating (dAH-dCH) ",dMdt_del4_fric_heat," Pa/m^2/s" dMdt_residual = dMdt_floating_dyn-dMdt_del4_tot @@ -489,7 +489,7 @@ subroutine print_budget(hstwr) ! ! check if mass change in physics is the same as dynamical core ! - call budget_get_global('dBD-dAF',m_cnst,dMdt_phys_total_in_dyn) + call cam_budget_get_global('dBD-dAF',m_cnst,dMdt_phys_total_in_dyn) dMdt_PDC = dMdt_phys_total-dMdt_phys_total_in_dyn write(iulog,fmtm)" Mass physics-dynamics coupling error ",dMdt_PDC," Pa/m^2/s" write(iulog,*)" " diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 708822f752..fdcff2a4e2 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -597,7 +597,7 @@ subroutine dyn_init(dyn_in, dyn_out) use control_mod, only: vert_remap_uvTq_alg, vert_remap_tracer_alg use std_atm_profile, only: std_atm_height use dyn_tests_utils, only: vc_dycore, vc_dry_pressure, string_vc, vc_str_lgth - use budgets, only: e_m_snapshot, e_m_budget, thermo_budget_history + use cam_budget, only: cam_budget_em_snapshot, cam_budget_em_budget, thermo_budget_history ! Dummy arguments: type(dyn_import_t), intent(out) :: dyn_in @@ -894,33 +894,34 @@ subroutine dyn_init(dyn_in, dyn_out) if (thermo_budget_history) then ! Register stages for budgets do istage = 1, num_stages - call e_m_snapshot(TRIM(ADJUSTL(stage(istage))), 'dyn', longname=TRIM(ADJUSTL(stage_txt(istage))), cslam=use_cslam) + call cam_budget_em_snapshot(TRIM(ADJUSTL(stage(istage))), 'dyn', & + longname=TRIM(ADJUSTL(stage_txt(istage))), cslam=use_cslam) end do ! ! Register tendency (difference) budgets ! - call e_m_budget('dEdt_floating_dyn' ,'dAD','dBD','dyn','dif', & + call cam_budget_em_budget('dEdt_floating_dyn' ,'dAD','dBD','dyn','dif', & longname="dE/dt floating dynamics (dAD-dBD)" ,cslam=use_cslam) - call e_m_budget('dEdt_vert_remap' ,'dAR','dAD','dyn','dif', & + call cam_budget_em_budget('dEdt_vert_remap' ,'dAR','dAD','dyn','dif', & longname="dE/dt vertical remapping (dAR-dAD)" ,cslam=use_cslam) - call e_m_budget('dEdt_phys_tot_in_dyn','dBD','dAF','dyn','dif', & + call cam_budget_em_budget('dEdt_phys_tot_in_dyn','dBD','dAF','dyn','dif', & longname="dE/dt physics tendency in dynamics (dBD-dAF)" ,cslam=use_cslam) - call e_m_budget('dEdt_del4' ,'dCH','dBH','dyn','dif', & + call cam_budget_em_budget('dEdt_del4' ,'dCH','dBH','dyn','dif', & longname="dE/dt del4 (dCH-dBH)" ,cslam=use_cslam) - call e_m_budget('dEdt_del4_fric_heat','dAH','dCH','dyn','dif', & + call cam_budget_em_budget('dEdt_del4_fric_heat','dAH','dCH','dyn','dif', & longname="dE/dt del4 frictional heating (dAH-dCH)" ,cslam=use_cslam) - call e_m_budget('dEdt_del4_tot' ,'dAH','dBH','dyn','dif', & + call cam_budget_em_budget('dEdt_del4_tot' ,'dAH','dBH','dyn','dif', & longname="dE/dt del4 + del4 frictional heating (dAH-dBH)",cslam=use_cslam) - call e_m_budget('dEdt_del2_sponge' ,'dAS','dBS','dyn','dif', & + call cam_budget_em_budget('dEdt_del2_sponge' ,'dAS','dBS','dyn','dif', & longname="dE/dt del2 sponge (dAS-dBS)" ,cslam=use_cslam) ! ! Register derived budgets ! - call e_m_budget('dEdt_dycore' ,'dEdt_floating_dyn','dEdt_vert_remap' ,'dyn','sum', & + call cam_budget_em_budget('dEdt_dycore' ,'dEdt_floating_dyn','dEdt_vert_remap' ,'dyn','sum', & longname="dE/dt adiabatic dynamics" ,cslam=use_cslam) - call e_m_budget('dEdt_del2_del4_tot' ,'dEdt_del4_tot' ,'dEdt_del2_sponge' ,'dyn','sum', & + call cam_budget_em_budget('dEdt_del2_del4_tot' ,'dEdt_del4_tot' ,'dEdt_del2_sponge' ,'dyn','sum', & longname="dE/dt explicit diffusion total",cslam=use_cslam) - call e_m_budget('dEdt_residual' ,'dEdt_floating_dyn','dEdt_del2_del4_tot','dyn','dif',& + call cam_budget_em_budget('dEdt_residual' ,'dEdt_floating_dyn','dEdt_del2_del4_tot','dyn','dif',& longname="dE/dt residual (dEdt_floating_dyn-dEdt_del2_del4_tot)",cslam=use_cslam) end if ! diff --git a/src/physics/cam/cam_diagnostics.F90 b/src/physics/cam/cam_diagnostics.F90 index 96c3ae0f0c..2d511a6946 100644 --- a/src/physics/cam/cam_diagnostics.F90 +++ b/src/physics/cam/cam_diagnostics.F90 @@ -190,7 +190,7 @@ subroutine diag_init_dry(pbuf2d) use cam_history, only: addfld, add_default, horiz_only use cam_history, only: register_vector_field use tidal_diag, only: tidal_diag_init - use budgets, only: e_m_snapshot, e_m_budget, thermo_budget_history + use cam_budget, only: cam_budget_em_snapshot, cam_budget_em_budget, thermo_budget_history type(physics_buffer_desc), pointer, intent(in) :: pbuf2d(:,:) @@ -399,21 +399,21 @@ subroutine diag_init_dry(pbuf2d) ! energy diagnostics addflds for vars_stage combinations plus e_m_snapshots ! do istage = 1, num_stages - call e_m_snapshot(TRIM(ADJUSTL(stage(istage))),'phy',longname=TRIM(ADJUSTL(stage_txt(istage)))) + call cam_budget_em_snapshot(TRIM(ADJUSTL(stage(istage))),'phy',longname=TRIM(ADJUSTL(stage_txt(istage)))) end do ! Create budgets that are a sum/dif of 2 stages - call e_m_budget('dEdt_param_efix_physE','phAP','phBF','phy','dif',longname='dE/dt CAM physics + energy fixer using physics E formula (phAP-phBF)') - call e_m_budget('dEdt_param_efix_dynE' ,'dyAP','dyBF','phy','dif',longname='dE/dt CAM physics + energy fixer using dycore E formula (dyAP-dyBF)') - call e_m_budget('dEdt_param_physE' ,'phAP','phBP','phy','dif',longname='dE/dt CAM physics using physics E formula (phAP-phBP)') - call e_m_budget('dEdt_param_dynE' ,'dyAP','dyBP','phy','dif',longname='dE/dt CAM physics using dycore E (dyAP-dyBP)') - call e_m_budget('dEdt_dme_adjust_physE','phAM','phAP','phy','dif',longname='dE/dt dry mass adjustment using physics E formula (phAM-phAP)') - call e_m_budget('dEdt_dme_adjust_dynE' ,'dyAM','dyAP','phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)') - call e_m_budget('dEdt_efix_physE' ,'phBP','phBF','phy','dif',longname='dE/dt energy fixer using physics E formula (phBP-phBF)') - call e_m_budget('dEdt_efix_dynE' ,'dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E formula (dyBP-dyBF)') - call e_m_budget('dEdt_phys_tot_physE' ,'phAM','phBF','phy','dif',longname='dE/dt physics total using physics E formula (phAM-phBF)') - call e_m_budget('dEdt_phys_tot_dynE' ,'dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)') + call cam_budget_em_budget('dEdt_param_efix_physE','phAP','phBF','phy','dif',longname='dE/dt CAM physics + energy fixer using physics E formula (phAP-phBF)') + call cam_budget_em_budget('dEdt_param_efix_dynE' ,'dyAP','dyBF','phy','dif',longname='dE/dt CAM physics + energy fixer using dycore E formula (dyAP-dyBF)') + call cam_budget_em_budget('dEdt_param_physE' ,'phAP','phBP','phy','dif',longname='dE/dt CAM physics using physics E formula (phAP-phBP)') + call cam_budget_em_budget('dEdt_param_dynE' ,'dyAP','dyBP','phy','dif',longname='dE/dt CAM physics using dycore E (dyAP-dyBP)') + call cam_budget_em_budget('dEdt_dme_adjust_physE','phAM','phAP','phy','dif',longname='dE/dt dry mass adjustment using physics E formula (phAM-phAP)') + call cam_budget_em_budget('dEdt_dme_adjust_dynE' ,'dyAM','dyAP','phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)') + call cam_budget_em_budget('dEdt_efix_physE' ,'phBP','phBF','phy','dif',longname='dE/dt energy fixer using physics E formula (phBP-phBF)') + call cam_budget_em_budget('dEdt_efix_dynE' ,'dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E formula (dyBP-dyBF)') + call cam_budget_em_budget('dEdt_phys_tot_physE' ,'phAM','phBF','phy','dif',longname='dE/dt physics total using physics E formula (phAM-phBF)') + call cam_budget_em_budget('dEdt_phys_tot_dynE' ,'dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)') endif end subroutine diag_init_dry diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 7b2c0ada05..7615f0e432 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -826,7 +826,7 @@ subroutine tot_energy_phys(state, outfld_name_suffix,vc) use cam_abortutils, only: endrun use cam_history_support, only: max_fieldname_len - use budgets, only: thermo_budget_history + use cam_budget, only: thermo_budget_history !------------------------------Arguments-------------------------------- type(physics_state), intent(inout) :: state diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index ae7ed24509..95fd2196f2 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -771,7 +771,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use cam_history, only: addfld, register_vector_field, add_default use phys_control, only: phys_getopts use phys_grid_ctem, only: phys_grid_ctem_init - use budgets, only: budget_init + use cam_budget, only: cam_budget_init ! Input/output arguments type(physics_state), pointer :: phys_state(:) @@ -1392,7 +1392,7 @@ subroutine tphysac (ztodt, cam_in, & use cam_snapshot_common,only: cam_snapshot_ptend_outfld use lunar_tides, only: lunar_tides_tend use cam_thermo, only: cam_thermo_water_update - use budgets, only: thermo_budget_history + use cam_budget, only: thermo_budget_history use dyn_tests_utils, only: vc_dycore, vc_height, vc_dry_pressure use air_composition, only: cpairv, cp_or_cv_dycore ! diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index 4f7c89f2bc..b07066df0d 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -753,7 +753,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use nudging, only: Nudge_Model, nudging_init use cam_snapshot, only: cam_snapshot_init use cam_history, only: addfld, register_vector_field, add_default - use budgets, only: budget_init + use cam_budget, only: cam_budget_init use phys_grid_ctem, only: phys_grid_ctem_init ! Input/output arguments @@ -941,7 +941,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) call cam_snapshot_init(cam_in, cam_out, pbuf2d, begchunk) ! Initialize the budget capability - call budget_init() + call cam_budget_init() ! addfld calls for U, V tendency budget variables that are output in ! tphysac, tphysbc @@ -1369,7 +1369,7 @@ subroutine tphysac (ztodt, cam_in, & use carma_flags_mod, only: carma_do_cldice, carma_do_cldliq, carma_do_wetdep use dyn_tests_utils, only: vc_dycore use cam_thermo, only: cam_thermo_water_update - use budgets, only: thermo_budget_history + use cam_budget, only: thermo_budget_history use dyn_tests_utils, only: vc_dycore, vc_height, vc_dry_pressure use air_composition, only: cpairv, cp_or_cv_dycore ! diff --git a/src/physics/simple/physpkg.F90 b/src/physics/simple/physpkg.F90 index 0c43ec3eb2..9c1e4c61bf 100644 --- a/src/physics/simple/physpkg.F90 +++ b/src/physics/simple/physpkg.F90 @@ -202,7 +202,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use phys_debug_util, only: phys_debug_init use qneg_module, only: qneg_init use cam_snapshot, only: cam_snapshot_init - use budgets, only: budget_init + use cam_budget, only: cam_budget_init ! Input/output arguments type(physics_state), pointer :: phys_state(:) @@ -273,7 +273,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) call cam_snapshot_init(cam_in, cam_out, pbuf2d, begchunk) ! Initialize energy budgets - call budget_init() + call cam_budget_init() end subroutine phys_init @@ -480,7 +480,7 @@ subroutine tphysac (ztodt, cam_in, cam_out, state, tend, pbuf) use check_energy, only: tot_energy_phys use cam_history, only: hist_fld_active use cam_thermo, only: cam_thermo_water_update - use budgets, only: thermo_budget_history + use cam_budget, only: thermo_budget_history use dyn_tests_utils, only: vc_dycore, vc_height, vc_dry_pressure use air_composition, only: cpairv, cp_or_cv_dycore ! Arguments From cf6fc5cad78cd0a9ff68d71c7d3bea4a04b95ee6 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Wed, 26 Apr 2023 18:03:13 -0600 Subject: [PATCH 126/140] add some changed files that were missing --- doc/ChangeLog | 59 +++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 43 insertions(+), 16 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index e565fc61b8..62a2ce9c36 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -37,17 +37,17 @@ Purpose of changes (include the issue number and title text for each relevant Gi running the physics. An energy budget is created, logged and written to the budget history tape in four steps - 1) call e_m_snapshot to define multiple energy/mass snapshots - 2) call e_m_budget to define a budget as the difference/sum of two snapshots. + 1) call cam_budget_em_snapshot to define multiple energy/mass snapshots + 2) call cam_budget_em_budget to define a budget as the difference/sum of two snapshots. 3) call tot_energy_phys (or tot_energy_dyn) for each named snapshot 4) setting namelist variables thermo_budget_history, thermo_budget_histfile_num, nhtfrq Energy and mass snapshots are defined and added to the history - buffer via the e_m_snapshot subroutine. The e_m_snapshot routine + buffer via the cam_budget_em_snapshot subroutine. The cam_budget_em_snapshot routine creates a set of vertically integrated energy and mass history output fields based on the snapshot name parameter prepended with the types of energy and mass that are carried in cam and defined - in cam_thermo.F90 For example calling e_m_snapshot with a name of + in cam_thermo.F90 For example calling cam_budget_em_snapshot with a name of 'dAP', perhaps standing for an energy snapshot after physics is called, will create a set of fields that contain kinetic (KE_dAP), sensible (SE_dAP), potential (PO_dAP) and total (TE_dap) energies @@ -57,10 +57,10 @@ Purpose of changes (include the issue number and title text for each relevant Gi will calculate and outfld the 9 or so specific energy and mass snapshots. - The e_m_budget routine defines a named budget composed of the - difference or sum of two snapshots. As with e_m_shapshot the + The cam_budget_em_budget routine defines a named budget composed of the + difference or sum of two snapshots. As with cam_budget_em_shapshot the budget name is prepended with the same energies identifiers as - e_m_snapshot. All energy/mass snapshots as well as the budgets are + cam_budget_em_snapshot. All energy/mass snapshots as well as the budgets are saved to the history buffer and written to the budget history file. tot_energy_phys and tot_energy_dyn routines exists for both physics and dynamics to allow snapshots tailored to thermodynamic @@ -90,14 +90,11 @@ Code reviewed by: List all files eliminated: N/A List all files added and what they do: - A src/cam/control/budget.F90 + A src/cam/control/cam_budget.F90 provides support for energy/mass budgeting using cam_history infrastructure. List all existing files that have been modified, and describe the changes: - M Externals.cfg - - update to include ctsm tag supporting MPAS defaults - M bld/build_namelist - Remove se_lcp_moist and se_phys_dyn_cp namelist flags @@ -132,6 +129,9 @@ List all existing files that have been modified, and describe the changes: M atm_comp_nuopc.F90 - bug fix, support for E/W formatted initial data longitudes spanning -180:180 + M cpl/nuopc/atm_stream_ndep.F90 + - bug fix to allow opening instance version of atm_in namelist. + M eul/dp_coupling.F90 - update calling parameters @@ -167,13 +167,16 @@ List all existing files that have been modified, and describe the changes: M mpas/dyn_grid.F90 - register area weights for mpas grids + M se/advect_tend.F90 + - refactor statements checking for use of cslam + M se/dp_coupling.F90 - science updates - all water constitutents added to pressure - mods to further reduce bias in energy budget - M se/global_norms_mod.F90 - - new interface for calculating both elem and fvm global integrals (fvm added) + M se/dycore/control_mod.F90 + - remove phys_dyn_cp energy scaling flag M se/dycore/control_mod.F90 - thermal energy scaling of T @@ -181,6 +184,18 @@ List all existing files that have been modified, and describe the changes: M se/dycore/dimensions_mod.F90 - get rid of lcp_moist now namelist variable + M se/dycore/fvm_mod.F90 + - add use_cslam logical in place of if ntrac>0 + + M se/dycore/global_norms_mod.F90 + - new interface for calculating both elem and fvm global integrals (fvm added) + + M se/dycore/hybrid_mod.F90 + - add use_cslam logical in place of if ntrac>0 + + M se/dycore/namelist_mod.F90 + - add use_cslam logical in place of if ntrac>0 + M se/dycore/prim_advance_mod.F90 - science updates to close energy budget - refactor energy calc routine. @@ -192,6 +207,12 @@ List all existing files that have been modified, and describe the changes: M se/dycore/prim_driver_mod.F90 - rename routine to calculate total energy + M se/dycore/prim_state_mod.F90 + - add use_cslam logical in place of if ntrac>0 + + M se/dycore/viscosity.F90 + - add use_cslam logical in place of if ntrac>0 + M se/dycore_budget.F90 - Routine for printing SE energy/mass budgets @@ -205,6 +226,15 @@ List all existing files that have been modified, and describe the changes: M se/dyn_grid.F90 - consistent naming of routine that calculates total energy + M se/restart_dynamics.F90 + - add use_cslam logical in place of if ntrac>0 + + M se/stepon.F90 + - update name calc_tot_energy_dynamics to tot_energy_dyn + + M se/test_fvm_mapping.F90 + - add use_cslam logical in place of if ntrac>0 + M infrastructure/phys_grid.F90 - register area weights for physic grid - call budget_add for all SE energy/mass budget fields. @@ -252,9 +282,6 @@ List all existing files that have been modified, and describe the changes: M utils/cam_thermo.F90 - energy and mass budget variables and descriptions. - M cpl/nuopc/atm_stream_ndep.F90 - - bug fix to allow opening instance version of atm_in namelist. - 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 34b3b4810f4f9e43ea8557714951d9c43ab3ee5d Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 27 Apr 2023 11:05:41 -0600 Subject: [PATCH 127/140] added vcoord_moist_pressure ifelse to water_update for FV core --- src/utils/air_composition.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/utils/air_composition.F90 b/src/utils/air_composition.F90 index c5c74cc823..6046ffebf1 100644 --- a/src/utils/air_composition.F90 +++ b/src/utils/air_composition.F90 @@ -679,6 +679,8 @@ subroutine water_composition_update(mmr, lchnk, ncol, vcoord, to_dry_factor) ! cp_or_cv_dycore(:ncol,:,lchnk)=cp_or_cv_dycore(:ncol,:,lchnk)*& (cpairv(:ncol,:,lchnk)-rairv(:ncol,:,lchnk)) /rairv(:ncol,:,lchnk) + else if (vcoord==vc_moist_pressure) then + ! no update needed for moist pressure vcoord else call endrun(subname//" vertical coordinate not supported; vcoord="// int2str(vcoord)) end if From e4e149cb3cec91bd94fb2b063d302c8c05c17011 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 27 Apr 2023 12:54:45 -0600 Subject: [PATCH 128/140] rename is_budget to is_cam_budget and cam_budget_em_budget to cam_budget_em_register --- src/control/cam_budget.F90 | 24 ++++++++++++------------ src/dynamics/mpas/dyn_comp.F90 | 8 ++++---- src/dynamics/se/dycore_budget.F90 | 6 +++--- src/dynamics/se/dyn_comp.F90 | 22 +++++++++++----------- src/physics/cam/cam_diagnostics.F90 | 22 +++++++++++----------- 5 files changed, 41 insertions(+), 41 deletions(-) diff --git a/src/control/cam_budget.F90 b/src/control/cam_budget.F90 index 75d89250f5..0f9dfab32e 100644 --- a/src/control/cam_budget.F90 +++ b/src/control/cam_budget.F90 @@ -7,11 +7,11 @@ module cam_budget ! ! cam_budget_init ! cam_budget_em_snapshot - ! cam_budget_em_budget + ! cam_budget_em_register ! cam_budget_get_global ! cam_budget_readnl ! budget_ind_byname - ! is_budget + ! is_cam_budget !----------------------------------------------------------------------- use cam_abortutils, only: endrun @@ -32,10 +32,10 @@ module cam_budget public :: & cam_budget_init, &! initialize budget variables cam_budget_em_snapshot, &! define a snapshot and add to history buffer - cam_budget_em_budget, &! define a budget and add to history buffer + cam_budget_em_register, &! define a budget and add to history buffer cam_budget_get_global, &! get global budget from history buffer cam_budget_readnl, &! read budget namelist setting - is_budget ! return logical if budget_defined + is_cam_budget ! return logical if budget_defined ! Private real(r8) :: dstepsize @@ -190,7 +190,7 @@ end subroutine cam_budget_em_snapshot !============================================================================== - subroutine cam_budget_em_budget (name, stg1name, stg2name, pkgtype, optype, longname, cslam) + subroutine cam_budget_em_register (name, stg1name, stg2name, pkgtype, optype, longname, cslam) use dycore, only: dycore_is @@ -211,7 +211,7 @@ subroutine cam_budget_em_budget (name, stg1name, stg2name, pkgtype, optype, long logical, intent(in), optional :: & cslam ! true => use cslam to transport mass variables - character(len=*), parameter :: sub='cam_budget_em_budget' + character(len=*), parameter :: sub='cam_budget_em_register' character(cl) :: errmsg character(len=1) :: opchar character (len=max_fieldname_len) :: name_str @@ -284,7 +284,7 @@ subroutine cam_budget_em_budget (name, stg1name, stg2name, pkgtype, optype, long call add_default(TRIM(ADJUSTL(name_str)), thermo_budget_histfile_num, 'N') end do end if - end subroutine cam_budget_em_budget + end subroutine cam_budget_em_register !============================================================================== @@ -378,7 +378,7 @@ end function budget_ind_byname end subroutine cam_budget_get_global !============================================================================== - pure function is_budget(name) + pure function is_cam_budget(name) ! Get the index of a budget. @@ -386,21 +386,21 @@ pure function is_budget(name) character(len=*), intent(in) :: name ! budget name !---------------------------Local workspace----------------------------- - logical :: is_budget ! function return + logical :: is_cam_budget ! function return integer :: m ! budget index !----------------------------------------------------------------------- ! Find budget name in list of defined budgets - is_budget = .false. + is_cam_budget = .false. do m = 1, budget_num if (trim(adjustl(name)) == trim(adjustl(budget_name(m))).or. & trim(adjustl(name)) == trim(adjustl(budget_stagename(m)))) then - is_budget = .true. + is_cam_budget = .true. return end if end do - end function is_budget + end function is_cam_budget !=========================================================================== diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index 755dbcc64f..7b27c4521e 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -40,7 +40,7 @@ module dyn_comp use mpas_timekeeping, only : MPAS_TimeInterval_type use cam_mpas_subdriver, only: cam_mpas_global_sum_real -use cam_budget, only: cam_budget_em_snapshot, cam_budget_em_budget +use cam_budget, only: cam_budget_em_snapshot, cam_budget_em_register implicit none @@ -543,11 +543,11 @@ subroutine dyn_init(dyn_in, dyn_out) ! initialize MPAS energy budgets ! add budgets that are derived from stages ! - call cam_budget_em_budget('dEdt_param_efix_in_dyn','dAP','dBF',pkgtype='dyn',optype='dif', & + call cam_budget_em_register('dEdt_param_efix_in_dyn','dAP','dBF',pkgtype='dyn',optype='dif', & longname="dE/dt parameterizations+efix in dycore (dparam)(dAP-dBF)") - call cam_budget_em_budget('dEdt_dme_adjust_in_dyn','dAM','dAP',pkgtype='dyn',optype='dif', & + call cam_budget_em_register('dEdt_dme_adjust_in_dyn','dAM','dAP',pkgtype='dyn',optype='dif', & longname="dE/dt dry mass adjustment in dycore (dAM-dAP)") - call cam_budget_em_budget('dEdt_phys_total_in_dyn','dAM','dBF',pkgtype='dyn',optype='dif', & + call cam_budget_em_register('dEdt_phys_total_in_dyn','dAM','dBF',pkgtype='dyn',optype='dif', & longname="dE/dt physics total in dycore (phys) (dAM-dBF)") end if diff --git a/src/dynamics/se/dycore_budget.F90 b/src/dynamics/se/dycore_budget.F90 index af9bf1d1b0..d2bfe0fceb 100644 --- a/src/dynamics/se/dycore_budget.F90 +++ b/src/dynamics/se/dycore_budget.F90 @@ -18,7 +18,7 @@ subroutine print_budget(hstwr) use spmd_utils, only: masterproc use cam_abortutils, only: endrun use cam_logfile, only: iulog - use cam_budget, only: cam_budget_get_global, is_budget, thermo_budget_histfile_num, thermo_budget_history + use cam_budget, only: cam_budget_get_global, is_cam_budget, thermo_budget_histfile_num, thermo_budget_history use cam_thermo, only: thermo_budget_vars_descriptor, thermo_budget_num_vars, thermo_budget_vars_massv, & teidx, seidx, keidx, poidx use dimensions_mod, only: use_cslam @@ -458,7 +458,7 @@ subroutine print_budget(hstwr) ! ! detailed mass budget in dynamical core ! - if (is_budget('dAD').and.is_budget('dBD').and.is_budget('dAR').and.is_budget('dCH')) then + if (is_cam_budget('dAD').and.is_cam_budget('dBD').and.is_cam_budget('dAR').and.is_cam_budget('dCH')) then call cam_budget_get_global('dAD-dBD',m_cnst,dMdt_floating_dyn) call cam_budget_get_global('dAR-dAD',m_cnst,dMdt_vert_remap) tmp = dMdt_floating_dyn+dMdt_vert_remap @@ -485,7 +485,7 @@ subroutine print_budget(hstwr) write(iulog,*)"dMASS/dt residual (time truncation errors)",dMdt_residual," Pa/m^2/s" end if end if - if (is_budget('dBD').and.is_budget('dAF')) then + if (is_cam_budget('dBD').and.is_cam_budget('dAF')) then ! ! check if mass change in physics is the same as dynamical core ! diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index fdcff2a4e2..0f9a229c6b 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -597,7 +597,7 @@ subroutine dyn_init(dyn_in, dyn_out) use control_mod, only: vert_remap_uvTq_alg, vert_remap_tracer_alg use std_atm_profile, only: std_atm_height use dyn_tests_utils, only: vc_dycore, vc_dry_pressure, string_vc, vc_str_lgth - use cam_budget, only: cam_budget_em_snapshot, cam_budget_em_budget, thermo_budget_history + use cam_budget, only: cam_budget_em_snapshot, cam_budget_em_register, thermo_budget_history ! Dummy arguments: type(dyn_import_t), intent(out) :: dyn_in @@ -900,28 +900,28 @@ subroutine dyn_init(dyn_in, dyn_out) ! ! Register tendency (difference) budgets ! - call cam_budget_em_budget('dEdt_floating_dyn' ,'dAD','dBD','dyn','dif', & + call cam_budget_em_register('dEdt_floating_dyn' ,'dAD','dBD','dyn','dif', & longname="dE/dt floating dynamics (dAD-dBD)" ,cslam=use_cslam) - call cam_budget_em_budget('dEdt_vert_remap' ,'dAR','dAD','dyn','dif', & + call cam_budget_em_register('dEdt_vert_remap' ,'dAR','dAD','dyn','dif', & longname="dE/dt vertical remapping (dAR-dAD)" ,cslam=use_cslam) - call cam_budget_em_budget('dEdt_phys_tot_in_dyn','dBD','dAF','dyn','dif', & + call cam_budget_em_register('dEdt_phys_tot_in_dyn','dBD','dAF','dyn','dif', & longname="dE/dt physics tendency in dynamics (dBD-dAF)" ,cslam=use_cslam) - call cam_budget_em_budget('dEdt_del4' ,'dCH','dBH','dyn','dif', & + call cam_budget_em_register('dEdt_del4' ,'dCH','dBH','dyn','dif', & longname="dE/dt del4 (dCH-dBH)" ,cslam=use_cslam) - call cam_budget_em_budget('dEdt_del4_fric_heat','dAH','dCH','dyn','dif', & + call cam_budget_em_register('dEdt_del4_fric_heat','dAH','dCH','dyn','dif', & longname="dE/dt del4 frictional heating (dAH-dCH)" ,cslam=use_cslam) - call cam_budget_em_budget('dEdt_del4_tot' ,'dAH','dBH','dyn','dif', & + call cam_budget_em_register('dEdt_del4_tot' ,'dAH','dBH','dyn','dif', & longname="dE/dt del4 + del4 frictional heating (dAH-dBH)",cslam=use_cslam) - call cam_budget_em_budget('dEdt_del2_sponge' ,'dAS','dBS','dyn','dif', & + call cam_budget_em_register('dEdt_del2_sponge' ,'dAS','dBS','dyn','dif', & longname="dE/dt del2 sponge (dAS-dBS)" ,cslam=use_cslam) ! ! Register derived budgets ! - call cam_budget_em_budget('dEdt_dycore' ,'dEdt_floating_dyn','dEdt_vert_remap' ,'dyn','sum', & + call cam_budget_em_register('dEdt_dycore' ,'dEdt_floating_dyn','dEdt_vert_remap' ,'dyn','sum', & longname="dE/dt adiabatic dynamics" ,cslam=use_cslam) - call cam_budget_em_budget('dEdt_del2_del4_tot' ,'dEdt_del4_tot' ,'dEdt_del2_sponge' ,'dyn','sum', & + call cam_budget_em_register('dEdt_del2_del4_tot' ,'dEdt_del4_tot' ,'dEdt_del2_sponge' ,'dyn','sum', & longname="dE/dt explicit diffusion total",cslam=use_cslam) - call cam_budget_em_budget('dEdt_residual' ,'dEdt_floating_dyn','dEdt_del2_del4_tot','dyn','dif',& + call cam_budget_em_register('dEdt_residual' ,'dEdt_floating_dyn','dEdt_del2_del4_tot','dyn','dif',& longname="dE/dt residual (dEdt_floating_dyn-dEdt_del2_del4_tot)",cslam=use_cslam) end if ! diff --git a/src/physics/cam/cam_diagnostics.F90 b/src/physics/cam/cam_diagnostics.F90 index 2d511a6946..580ffdf67f 100644 --- a/src/physics/cam/cam_diagnostics.F90 +++ b/src/physics/cam/cam_diagnostics.F90 @@ -190,7 +190,7 @@ subroutine diag_init_dry(pbuf2d) use cam_history, only: addfld, add_default, horiz_only use cam_history, only: register_vector_field use tidal_diag, only: tidal_diag_init - use cam_budget, only: cam_budget_em_snapshot, cam_budget_em_budget, thermo_budget_history + use cam_budget, only: cam_budget_em_snapshot, cam_budget_em_register, thermo_budget_history type(physics_buffer_desc), pointer, intent(in) :: pbuf2d(:,:) @@ -404,16 +404,16 @@ subroutine diag_init_dry(pbuf2d) ! Create budgets that are a sum/dif of 2 stages - call cam_budget_em_budget('dEdt_param_efix_physE','phAP','phBF','phy','dif',longname='dE/dt CAM physics + energy fixer using physics E formula (phAP-phBF)') - call cam_budget_em_budget('dEdt_param_efix_dynE' ,'dyAP','dyBF','phy','dif',longname='dE/dt CAM physics + energy fixer using dycore E formula (dyAP-dyBF)') - call cam_budget_em_budget('dEdt_param_physE' ,'phAP','phBP','phy','dif',longname='dE/dt CAM physics using physics E formula (phAP-phBP)') - call cam_budget_em_budget('dEdt_param_dynE' ,'dyAP','dyBP','phy','dif',longname='dE/dt CAM physics using dycore E (dyAP-dyBP)') - call cam_budget_em_budget('dEdt_dme_adjust_physE','phAM','phAP','phy','dif',longname='dE/dt dry mass adjustment using physics E formula (phAM-phAP)') - call cam_budget_em_budget('dEdt_dme_adjust_dynE' ,'dyAM','dyAP','phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)') - call cam_budget_em_budget('dEdt_efix_physE' ,'phBP','phBF','phy','dif',longname='dE/dt energy fixer using physics E formula (phBP-phBF)') - call cam_budget_em_budget('dEdt_efix_dynE' ,'dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E formula (dyBP-dyBF)') - call cam_budget_em_budget('dEdt_phys_tot_physE' ,'phAM','phBF','phy','dif',longname='dE/dt physics total using physics E formula (phAM-phBF)') - call cam_budget_em_budget('dEdt_phys_tot_dynE' ,'dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)') + call cam_budget_em_register('dEdt_param_efix_physE','phAP','phBF','phy','dif',longname='dE/dt CAM physics + energy fixer using physics E formula (phAP-phBF)') + call cam_budget_em_register('dEdt_param_efix_dynE' ,'dyAP','dyBF','phy','dif',longname='dE/dt CAM physics + energy fixer using dycore E formula (dyAP-dyBF)') + call cam_budget_em_register('dEdt_param_physE' ,'phAP','phBP','phy','dif',longname='dE/dt CAM physics using physics E formula (phAP-phBP)') + call cam_budget_em_register('dEdt_param_dynE' ,'dyAP','dyBP','phy','dif',longname='dE/dt CAM physics using dycore E (dyAP-dyBP)') + call cam_budget_em_register('dEdt_dme_adjust_physE','phAM','phAP','phy','dif',longname='dE/dt dry mass adjustment using physics E formula (phAM-phAP)') + call cam_budget_em_register('dEdt_dme_adjust_dynE' ,'dyAM','dyAP','phy','dif',longname='dE/dt dry mass adjustment using dycore E (dyAM-dyAP)') + call cam_budget_em_register('dEdt_efix_physE' ,'phBP','phBF','phy','dif',longname='dE/dt energy fixer using physics E formula (phBP-phBF)') + call cam_budget_em_register('dEdt_efix_dynE' ,'dyBP','dyBF','phy','dif',longname='dE/dt energy fixer using dycore E formula (dyBP-dyBF)') + call cam_budget_em_register('dEdt_phys_tot_physE' ,'phAM','phBF','phy','dif',longname='dE/dt physics total using physics E formula (phAM-phBF)') + call cam_budget_em_register('dEdt_phys_tot_dynE' ,'dyAM','dyBF','phy','dif',longname='dE/dt physics total using dycore E (dyAM-dyBF)') endif end subroutine diag_init_dry From 4a60ca74da7c6ab677b33730d82367be9c756846 Mon Sep 17 00:00:00 2001 From: Cheryl Craig Date: Thu, 27 Apr 2023 13:37:30 -0600 Subject: [PATCH 129/140] Update FLTHIST compset and finish implementing initial FMTHIST compset --- bld/namelist_files/use_cases/hist_cam_mt.xml | 56 ++++++++++++++++++-- cime_config/config_compsets.xml | 8 +-- 2 files changed, 57 insertions(+), 7 deletions(-) diff --git a/bld/namelist_files/use_cases/hist_cam_mt.xml b/bld/namelist_files/use_cases/hist_cam_mt.xml index 9ffc5b48e8..9f8ae88ec8 100644 --- a/bld/namelist_files/use_cases/hist_cam_mt.xml +++ b/bld/namelist_files/use_cases/hist_cam_mt.xml @@ -1,9 +1,59 @@ - 'atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc' +19790101 - - 1850-2000 + +atm/cam/solar/SolarForcingCMIP6_18491230-23000102_c20200615.nc + + +atm/cam/inic/se/L93_ne30pg3_ne30pg3_mg17_450_short.cam.i.1979-01-07-00000.nc + + +atm/cam/topo/se/ne30pg3_gmted2010_modis_bedmachine_nc3000_Laplace0100_20230105.nc + + +atm/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc +'SERIAL' +'CO2','CH4','N2O','CFC11','CFC12','CFC11eq' + + + 'atm/cam/ozone_strataero' + 'ozone_strataero_WACCM_L70_zm5day_18500101-20150103_CMIP6ensAvg_c180923.nc' + 'O3' + SERIAL + + + .true. + 'atm/cam/ozone_strataero' + 'ozone_strataero_WACCM_L70_zm5day_18500101-20150103_CMIP6ensAvg_c180923.nc' + SERIAL + + + 'atm/cam/tracer_cnst' + 'tracer_cnst_halons_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc' + 'O3','OH','NO3','HO2','HALONS' + INTERP_MISSING_MONTHS + '' + + +INTERP_MISSING_MONTHS + + +INTERP_MISSING_MONTHS +SERIAL + + + 6 + 3 + 3 + + + .false. + .true. + .true. + + .true. + 1.E6 diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index a5496fd83e..a474d0c313 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -62,13 +62,13 @@ - FLTHIST_v0a - HIST_CAM%DEV%LT%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + FLTHIST_v0b + HIST_CAM%DEV%LT%GHGMAM4_CLM51%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV - FMTHIST_v0a - HIST_CAM%DEV%MT_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV + FMTHIST_v0b + HIST_CAM%DEV%MT_CLM51%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV From 3d1fe8ecdf3676a743fff581b85919cf083b2ce7 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 27 Apr 2023 16:56:36 -0600 Subject: [PATCH 130/140] remove extra cslam argument for snapshot and budget register --- src/control/cam_budget.F90 | 41 ++++++++++++++---------------------- src/dynamics/se/dyn_comp.F90 | 22 +++++++++---------- 2 files changed, 27 insertions(+), 36 deletions(-) diff --git a/src/control/cam_budget.F90 b/src/control/cam_budget.F90 index 0f9dfab32e..1ae7fd20f4 100644 --- a/src/control/cam_budget.F90 +++ b/src/control/cam_budget.F90 @@ -119,8 +119,9 @@ end subroutine cam_budget_init !============================================================================================== - subroutine cam_budget_em_snapshot (name, pkgtype, longname, cslam) - use dycore, only: dycore_is + subroutine cam_budget_em_snapshot (name, pkgtype, longname) + use dycore, only: dycore_is + use cam_grid_support, only: cam_grid_id character(len=*), intent(in) :: & name ! budget name used as variable name in history file output (8 char max) @@ -128,24 +129,20 @@ subroutine cam_budget_em_snapshot (name, pkgtype, longname, cslam) pkgtype ! budget type either phy or dyn character(len=*), intent(in) :: & longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) - logical, intent(in), optional :: & - cslam ! true => CSLAM used to transport mass tracers character (cl) :: errmsg character (len=max_fieldname_len) :: name_str character (cl) :: desc_str, units_str character (cl) :: gridname - logical :: cslamtr ! using cslam transport for mass tracers integer :: ivars character(len=*), parameter :: sub='cam_budget_em_snapshot' + logical :: use_cslam ! using cslam transport for mass tracers !----------------------------------------------------------------------- if (thermo_budget_history) then - if (present(cslam)) then - cslamtr=cslam - else - cslamtr = .false. - end if + ! FVM grid is only registered when using cslam + use_cslam=cam_grid_id('FVM')>0 + do ivars=1, thermo_budget_num_vars write(name_str,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(name)) write(desc_str,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & @@ -169,7 +166,7 @@ subroutine cam_budget_em_snapshot (name, pkgtype, longname, cslam) gridname='physgrid' else if (dycore_is('SE')) then - if (cslamtr .and. thermo_budget_vars_massv(ivars)) then + if (use_cslam .and. thermo_budget_vars_massv(ivars)) then gridname='FVM' else gridname='GLL' @@ -182,7 +179,7 @@ subroutine cam_budget_em_snapshot (name, pkgtype, longname, cslam) end if end if call addfld (TRIM(ADJUSTL(name_str)), horiz_only, 'N', TRIM(ADJUSTL(units_str)), & - TRIM(ADJUSTL(desc_str)), gridname=gridname) + TRIM(ADJUSTL(desc_str)), gridname=trim(gridname)) call add_default(TRIM(ADJUSTL(name_str)), thermo_budget_histfile_num, 'N') end do end if @@ -190,9 +187,9 @@ end subroutine cam_budget_em_snapshot !============================================================================== - subroutine cam_budget_em_register (name, stg1name, stg2name, pkgtype, optype, longname, cslam) - use dycore, only: dycore_is - + subroutine cam_budget_em_register (name, stg1name, stg2name, pkgtype, optype, longname) + use dycore, only: dycore_is + use cam_grid_support, only: cam_grid_id ! Register a budget. @@ -208,9 +205,6 @@ subroutine cam_budget_em_register (name, stg1name, stg2name, pkgtype, optype, lo character(len=*), intent(in) :: & longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) - logical, intent(in), optional :: & - cslam ! true => use cslam to transport mass variables - character(len=*), parameter :: sub='cam_budget_em_register' character(cl) :: errmsg character(len=1) :: opchar @@ -219,15 +213,12 @@ subroutine cam_budget_em_register (name, stg1name, stg2name, pkgtype, optype, lo character (cl) :: gridname character (cl) :: strstg1, strstg2 integer :: ivars - logical :: cslamtr ! using cslam transport for mass tracers + logical :: use_cslam ! true => use cslam to transport mass variables !----------------------------------------------------------------------- if (thermo_budget_history) then - if (present(cslam)) then - cslamtr=cslam - else - cslamtr = .false. - end if + ! the FVM gridname is only defined when use_cslam is true. + use_cslam=cam_grid_id('FVM')>0 ! register history budget variables do ivars=1, thermo_budget_num_vars @@ -267,7 +258,7 @@ subroutine cam_budget_em_register (name, stg1name, stg2name, pkgtype, optype, lo gridname='physgrid' else if (dycore_is('SE')) then - if (cslamtr .and. thermo_budget_vars_massv(ivars)) then + if (use_cslam .and. thermo_budget_vars_massv(ivars)) then gridname='FVM' else gridname='GLL' diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index 0f9a229c6b..6504eb75cd 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -895,34 +895,34 @@ subroutine dyn_init(dyn_in, dyn_out) ! Register stages for budgets do istage = 1, num_stages call cam_budget_em_snapshot(TRIM(ADJUSTL(stage(istage))), 'dyn', & - longname=TRIM(ADJUSTL(stage_txt(istage))), cslam=use_cslam) + longname=TRIM(ADJUSTL(stage_txt(istage)))) end do ! ! Register tendency (difference) budgets ! call cam_budget_em_register('dEdt_floating_dyn' ,'dAD','dBD','dyn','dif', & - longname="dE/dt floating dynamics (dAD-dBD)" ,cslam=use_cslam) + longname="dE/dt floating dynamics (dAD-dBD)" ) call cam_budget_em_register('dEdt_vert_remap' ,'dAR','dAD','dyn','dif', & - longname="dE/dt vertical remapping (dAR-dAD)" ,cslam=use_cslam) + longname="dE/dt vertical remapping (dAR-dAD)" ) call cam_budget_em_register('dEdt_phys_tot_in_dyn','dBD','dAF','dyn','dif', & - longname="dE/dt physics tendency in dynamics (dBD-dAF)" ,cslam=use_cslam) + longname="dE/dt physics tendency in dynamics (dBD-dAF)" ) call cam_budget_em_register('dEdt_del4' ,'dCH','dBH','dyn','dif', & - longname="dE/dt del4 (dCH-dBH)" ,cslam=use_cslam) + longname="dE/dt del4 (dCH-dBH)" ) call cam_budget_em_register('dEdt_del4_fric_heat','dAH','dCH','dyn','dif', & - longname="dE/dt del4 frictional heating (dAH-dCH)" ,cslam=use_cslam) + longname="dE/dt del4 frictional heating (dAH-dCH)" ) call cam_budget_em_register('dEdt_del4_tot' ,'dAH','dBH','dyn','dif', & - longname="dE/dt del4 + del4 frictional heating (dAH-dBH)",cslam=use_cslam) + longname="dE/dt del4 + del4 frictional heating (dAH-dBH)" ) call cam_budget_em_register('dEdt_del2_sponge' ,'dAS','dBS','dyn','dif', & - longname="dE/dt del2 sponge (dAS-dBS)" ,cslam=use_cslam) + longname="dE/dt del2 sponge (dAS-dBS)" ) ! ! Register derived budgets ! call cam_budget_em_register('dEdt_dycore' ,'dEdt_floating_dyn','dEdt_vert_remap' ,'dyn','sum', & - longname="dE/dt adiabatic dynamics" ,cslam=use_cslam) + longname="dE/dt adiabatic dynamics" ) call cam_budget_em_register('dEdt_del2_del4_tot' ,'dEdt_del4_tot' ,'dEdt_del2_sponge' ,'dyn','sum', & - longname="dE/dt explicit diffusion total",cslam=use_cslam) + longname="dE/dt explicit diffusion total" ) call cam_budget_em_register('dEdt_residual' ,'dEdt_floating_dyn','dEdt_del2_del4_tot','dyn','dif',& - longname="dE/dt residual (dEdt_floating_dyn-dEdt_del2_del4_tot)",cslam=use_cslam) + longname="dE/dt residual (dEdt_floating_dyn-dEdt_del2_del4_tot)" ) end if ! ! add dynamical core tracer tendency output From b51b6325fc49f03d2ff66569f1b66ea48282fcb2 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 27 Apr 2023 18:30:37 -0600 Subject: [PATCH 131/140] reset --soft HEAD^ to remove last commit in error --- Externals.cfg | 2 +- bld/build-namelist | 31 +- bld/namelist_files/namelist_definition.xml | 14 +- doc/ChangeLog | 232 +++++++++++ src/chemistry/mozart/chemistry.F90 | 10 - src/chemistry/mozart/mo_chemini.F90 | 9 - src/chemistry/mozart/mo_lightning.F90 | 429 +++++++++++++-------- src/chemistry/mozart/ocean_emis.F90 | 395 ++++++++++--------- src/control/camsrfexch.F90 | 12 +- src/control/runtime_opts.F90 | 2 + src/cpl/nuopc/atm_import_export.F90 | 23 +- src/physics/cam/physpkg.F90 | 12 +- src/physics/cam_dev/physpkg.F90 | 12 +- 13 files changed, 784 insertions(+), 399 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 13ddc8f76e..dc66b3c485 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -21,7 +21,7 @@ externals = Externals.cfg required = True [cmeps] -tag = cmeps0.14.18 +tag = cmeps0.14.24 protocol = git repo_url = https://github.com/ESCOMP/CMEPS.git local_path = components/cmeps diff --git a/bld/build-namelist b/bld/build-namelist index 3d5da9f0cc..2cec1b4a51 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)/) { @@ -4109,6 +4111,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 @@ -4125,16 +4142,8 @@ 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'}) { - if ($rad_prog_ozone) { - add_default($nl, 'atm_ozone_frequency', 'val'=>'subdaily'); - } else { - add_default($nl, 'atm_ozone_frequency', 'val'=>'multiday_average'); - } -} $outfile = "$opts{'dir'}/drv_flds_in"; $nl->write($outfile, 'groups'=>\@comp_groups); if ($print>=1) { diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index a42154efc1..14b0dcfc8c 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -6210,14 +6210,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. @@ -7325,6 +7319,12 @@ coarser temporal resolution. Default: set by build-namelist. + +If TRUE atmosphere model will provide prognosed lightning flash frequency. +Default: FALSE + + 0 .and. cldbot_ndx>0 + + if (.not.calc_lightning) return + + calc_nox_prod = lght_no_prd_factor>0._r8 + + if (calc_nox_prod) then + + 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,*) prefix, 'failed to allocate prod_no; error = ',astat + call endrun(prefix//'failed to allocate prod_no') + end if + geo_factor = ngcols_p/(4._r8*pi) + + 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 + 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 - call phys_getopts( history_cesm_forcing_out = history_cesm_forcing ) - - no_ndx = get_spc_ndx('NO') - xno_ndx = get_spc_ndx('XNO') - - has_no_lightning_prod = no_ndx>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) - - - 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 + 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 + call addfld( 'LGHTNG_CLD2GRND', horiz_only, 'I', 'min-1', 'clound-to-ground lightning flash rate') ! clound to ground flash frequency + end subroutine lightning_init + + !------------------------------------------------------------------------- + !------------------------------------------------------------------------- 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 use shr_reprosum_mod, only : shr_reprosum_calc - use mo_constants, only : rearth, d2r - implicit none + use mo_constants, only : rearth, d2r !---------------------------------------------------------------------- ! ... 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 integer :: cldbind ! level index for cloud base > 273k integer :: k, kk, zlow_ind, zhigh_ind, itype @@ -162,16 +227,20 @@ 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) + real(r8) :: flash_freq(pcols,begchunk:endchunk) + !---------------------------------------------------------------------- ! ... parameters to determine cg/ic ratio [price and rind, 1993] !---------------------------------------------------------------------- @@ -184,26 +253,29 @@ 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 :: cld2grnd_flash_freq(:) + + if (.not.calc_lightning) return - if (.not.has_no_lightning_prod) return + nullify(cld2grnd_flash_freq) !---------------------------------------------------------------------- ! ... 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 - cldtop_ndx = pbuf_get_index('CLDTOP') - cldbot_ndx = pbuf_get_index('CLDBOT') + if (calc_nox_prod) then + prod_no(:,:,:) = 0._r8 + prod_no_col(:,:) = 0._r8 + glob_prod_no_col(:,:) = 0._r8 + end if !-------------------------------------------------------------------------------- ! ... estimate flash frequency and resulting no emissions @@ -223,29 +295,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 @@ -254,58 +327,77 @@ 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 !-------------------------------------------------------------------------------- - ! ... compute cg/ic ratio - ! cgic = proportion of cg flashes (=pg from ppp paper) + ! cgic = proportion of cloud-to-ground flashes + ! NOx from lightning 1. Global distribution based on lightning physics, C Price et al + ! JOURNAL OF GEOPHYSICAL RESEARCH, VOL. 102, NO. D5, PAGES 5929-5941, MARCH 20, 1997 + ! (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 - !-------------------------------------------------------------------------------- - ! ... 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 + 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 + !-------------------------------------------------------------------------------- + ! ... compute flash energy (cg*6.7e9 + ic*6.7e8) + ! and convert to total energy per second + ! set ic = cg + !-------------------------------------------------------------------------------- + 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(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(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: + ! 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(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 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 + !-------------------------------------------------------------------------------- ! ... Accumulate global total, convert to flashes per second ! ... Accumulate global NO production rate @@ -325,29 +417,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 @@ -355,11 +447,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 @@ -370,15 +462,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( '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 ) + 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 diff --git a/src/chemistry/mozart/ocean_emis.F90 b/src/chemistry/mozart/ocean_emis.F90 index 26819fd846..289cafeb77 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,22 @@ 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 + ! fill in missing values with climatology for modern-day + 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 +259,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 +280,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 +292,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 +307,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 +323,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 +363,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 +383,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 +415,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 +439,8 @@ Subroutine SaltLibInitialization() ! --------------------------------------------- End Subroutine SaltLibInitialization + !-------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------- Function SpeciesIndex(SpeciesName) ! ============================================== ! This function is to look for the species index @@ -439,7 +449,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 +458,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 +475,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 +527,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 +581,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 +634,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 +690,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 +738,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 +757,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 +794,7 @@ subroutine cseawater_ini() character(len=*), parameter :: subname = 'cseawater_ini' - ! ======================================================== + ! ======================================================== ! Read sea water concentration specifier from the namelist ! ======================================================== @@ -827,7 +855,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 +926,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 +960,4 @@ subroutine cseawater_ini() end subroutine cseawater_ini - end module ocean_emis diff --git a/src/control/camsrfexch.F90 b/src/control/camsrfexch.F90 index f978e4923c..de1ea4ce6e 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) ! cloud-to-ground 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 @@ -423,7 +425,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(:) @@ -436,6 +438,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 @@ -453,6 +456,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) @@ -512,6 +516,12 @@ 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/control/runtime_opts.F90 b/src/control/runtime_opts.F90 index 55120a894b..f09554244d 100644 --- a/src/control/runtime_opts.F90 +++ b/src/control/runtime_opts.F90 @@ -99,6 +99,7 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) use upper_bc, only: ubc_readnl use cam_budget, only: cam_budget_readnl use phys_grid_ctem, only: phys_grid_ctem_readnl + use mo_lightning, only: lightning_readnl !---------------------------Arguments----------------------------------- @@ -166,6 +167,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 3c0cbba542..8c28b120fa 100644 --- a/src/cpl/nuopc/atm_import_export.F90 +++ b/src/cpl/nuopc/atm_import_export.F90 @@ -60,7 +60,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__ @@ -79,6 +80,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' @@ -88,6 +90,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 @@ -203,6 +206,11 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) ! Assume that 2 fields are always sent as part of Faxa_ndep call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_ndep', ungridded_lbound=1, ungridded_ubound=2) + ! lightning flash freq + if (atm_provides_lightning) then + call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_lightning') + end if + ! Now advertise above export fields if (masterproc) write(iulog,*) trim(subname)//' advertise export fields' do n = 1,fldsFrAtm_num @@ -917,6 +925,7 @@ subroutine export_fields( gcomp, model_mesh, model_clock, 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)' !--------------------------------------------------------------------------- @@ -1046,6 +1055,18 @@ subroutine export_fields( gcomp, model_mesh, model_clock, cam_out, rc) end do end if + 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 + do c = begchunk,endchunk + do i = 1,get_ncols_p(c) + fldptr_lght(g) = cam_out(c)%lightning_flash_freq(i) ! cloud-to-ground lightning flash frequency (/min) + 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 95fd2196f2..e1e781b4ed 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -115,6 +115,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 @@ -269,6 +270,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() @@ -715,6 +719,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 @@ -856,6 +861,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() @@ -1246,9 +1254,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) diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index b07066df0d..7452f9e115 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -112,6 +112,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 @@ -257,6 +258,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() @@ -703,6 +707,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 @@ -837,6 +842,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() @@ -1204,9 +1212,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 a78865e7b06bb2ccbecda4d0bf5edcc1fb9b0370 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 27 Apr 2023 19:45:39 -0600 Subject: [PATCH 132/140] reverting to 3253718 --- Externals.cfg | 2 +- bld/build-namelist | 31 +- bld/namelist_files/namelist_definition.xml | 14 +- doc/ChangeLog | 232 ----------- src/chemistry/mozart/chemistry.F90 | 10 + src/chemistry/mozart/mo_chemini.F90 | 9 + src/chemistry/mozart/mo_lightning.F90 | 429 ++++++++------------- src/chemistry/mozart/ocean_emis.F90 | 395 +++++++++---------- src/control/camsrfexch.F90 | 12 +- src/control/runtime_opts.F90 | 2 - src/cpl/nuopc/atm_import_export.F90 | 23 +- src/physics/cam/physpkg.F90 | 12 +- src/physics/cam_dev/physpkg.F90 | 12 +- 13 files changed, 399 insertions(+), 784 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index dc66b3c485..13ddc8f76e 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -21,7 +21,7 @@ externals = Externals.cfg required = True [cmeps] -tag = cmeps0.14.24 +tag = cmeps0.14.18 protocol = git repo_url = https://github.com/ESCOMP/CMEPS.git local_path = components/cmeps diff --git a/bld/build-namelist b/bld/build-namelist index 2cec1b4a51..3d5da9f0cc 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3475,16 +3475,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')) { - # set scaling of lightning NOx production - add_default($nl, 'lght_no_prd_factor' ); -} # Seasalt emissions tuning factor if ($chem =~ /_mam(\d)/) { @@ -4111,21 +4109,6 @@ 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 @@ -4142,8 +4125,16 @@ 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 lightning_coupling_nl); +@comp_groups = qw(drydep_inparm megan_emis_nl fire_emis_nl carma_inparm ndep_inparm ozone_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'); + } +} $outfile = "$opts{'dir'}/drv_flds_in"; $nl->write($outfile, 'groups'=>\@comp_groups); if ($print>=1) { diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 14b0dcfc8c..a42154efc1 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -6210,8 +6210,14 @@ 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="chem_inparm" valid_values="" > Multiplication factor applied to the lighting NOx production Default: 1.0. @@ -7319,12 +7325,6 @@ coarser temporal resolution. Default: set by build-namelist. - -If TRUE atmosphere model will provide prognosed lightning flash frequency. -Default: FALSE - - 0 .and. cldbot_ndx>0 - - if (.not.calc_lightning) return - - calc_nox_prod = lght_no_prd_factor>0._r8 - - if (calc_nox_prod) then - - 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,*) prefix, 'failed to allocate prod_no; error = ',astat - call endrun(prefix//'failed to allocate prod_no') - end if - geo_factor = ngcols_p/(4._r8*pi) - - 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 - 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 phys_getopts( history_cesm_forcing_out = history_cesm_forcing ) + + no_ndx = get_spc_ndx('NO') + xno_ndx = get_spc_ndx('XNO') + + has_no_lightning_prod = no_ndx>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 - 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 - call addfld( 'LGHTNG_CLD2GRND', horiz_only, 'I', 'min-1', 'clound-to-ground lightning flash rate') ! clound to ground flash frequency + !---------------------------------------------------------------------- + ! ... 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) + + + 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_init + end subroutine lightning_inti - !------------------------------------------------------------------------- - !------------------------------------------------------------------------- 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 use shr_reprosum_mod, only : shr_reprosum_calc - use mo_constants, only : rearth, d2r + use mo_constants, only : rearth, d2r + implicit none !---------------------------------------------------------------------- ! ... 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 integer :: cldbind ! level index for cloud base > 273k integer :: k, kk, zlow_ind, zhigh_ind, itype @@ -227,20 +162,16 @@ 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 ! chunk index + integer :: lchnk ! columns per chunk 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) ! column latitudes in chunks + 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] !---------------------------------------------------------------------- @@ -253,29 +184,26 @@ 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 :: cld2grnd_flash_freq(:) - - if (.not.calc_lightning) return - nullify(cld2grnd_flash_freq) + 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') !-------------------------------------------------------------------------------- ! ... estimate flash frequency and resulting no emissions @@ -295,30 +223,29 @@ 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 lchnk = begchunk,endchunk - ncol = state(lchnk)%ncol - call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk), flsh_frq_ndx, cld2grnd_flash_freq ) + Chunk_loop : do c = begchunk,endchunk + ncol = state(c)%ncol + lchnk = state(c)%lchnk 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(lchnk)%phis(:ncol)*rga - call get_wght_all_p(lchnk, pcols, wght) + 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) do k = 1,pver - zmid(:ncol,k) = state(lchnk)%zm(:ncol,k) + zsurf(:ncol) - zint(:ncol,k,lchnk) = state(lchnk)%zi(:ncol,k) + zsurf(:ncol) + zmid(:ncol,k) = state(c)%zm(:ncol,k) + zsurf(:ncol) + zint(:ncol,k,c) = state(c)%zi(:ncol,k) + zsurf(:ncol) end do - zint(:ncol,pver+1,lchnk) = state(lchnk)%zi(:ncol,pver+1) + zsurf(:ncol) - - cld2grnd_flash_freq(:) = 0.0_r8 + zint(:ncol,pver+1,c) = state(c)%zi(:ncol,pver+1) + zsurf(:ncol) - col_loop : do icol = 1,ncol + col_loop : do i = 1,ncol !-------------------------------------------------------------------------------- ! ... find cloud top and bottom level above 273k !-------------------------------------------------------------------------------- - cldtind = nint( cldtop(icol) ) - cldbind = nint( cldbot(icol) ) + cldtind = nint( cldtop(i) ) + cldbind = nint( cldbot(i) ) do - if( cldbind <= cldtind .or. state(lchnk)%t(icol,cldbind) < t0 ) then + if( cldbind <= cldtind .or. state(c)%t(i,cldbind) < t0 ) then exit end if cldbind = cldbind - 1 @@ -327,77 +254,58 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) !-------------------------------------------------------------------------------- ! ... compute cloud top height and depth of charging zone !-------------------------------------------------------------------------------- - cldhgt(icol,lchnk) = m2km*max( 0._r8,zint(icol,cldtind,lchnk) ) - dchgz = cldhgt(icol,lchnk) - m2km*zmid(icol,cldbind) - dchgzone(icol,lchnk) = dchgz + cldhgt(i,c) = m2km*max( 0._r8,zint(i,cldtind,c) ) + dchgz = cldhgt(i,c) - m2km*zmid(i,cldbind) + dchgzone(i,c) = dchgz !-------------------------------------------------------------------------------- ! ... compute flash frequency for given cloud top height ! (flashes storm^-1 min^-1) !-------------------------------------------------------------------------------- - 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 + 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 !-------------------------------------------------------------------------------- - ! cgic = proportion of cloud-to-ground flashes - ! NOx from lightning 1. Global distribution based on lightning physics, C Price et al - ! JOURNAL OF GEOPHYSICAL RESEARCH, VOL. 102, NO. D5, PAGES 5929-5941, MARCH 20, 1997 - ! (https://agupubs.onlinelibrary.wiley.com/doi/epdf/10.1029/96JD03504) - ! eq 14 + ! ... compute cg/ic ratio + ! cgic = proportion of cg flashes (=pg from ppp paper) !-------------------------------------------------------------------------------- - cgic(icol,lchnk) = 1._r8/((((ca*dchgz + cb)*dchgz + cc) *dchgz + cd)*dchgz + ce) + cgic(i,c) = 1._r8/((((ca*dchgz + cb)*dchgz + cc) *dchgz + cd)*dchgz + ce) if( dchgz < 5.5_r8 ) then - cgic(icol,lchnk) = 0._r8 + cgic(i,c) = 0._r8 else if( dchgz > 14._r8 ) then - cgic(icol,lchnk) = .02_r8 + 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 - 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 - !-------------------------------------------------------------------------------- - ! ... compute flash energy (cg*6.7e9 + ic*6.7e8) - ! and convert to total energy per second - ! set ic = cg - !-------------------------------------------------------------------------------- - 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(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(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: - ! 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(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 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 - !-------------------------------------------------------------------------------- ! ... Accumulate global total, convert to flashes per second ! ... Accumulate global NO production rate @@ -417,29 +325,29 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) !-------------------------------------------------------------------------------- ! ... Distribute production up to cloud top [Pickering et al., 1998 (JGR)] !-------------------------------------------------------------------------------- - do lchnk = begchunk,endchunk - call get_rlat_all_p(lchnk, pcols, rlats) - ncol = state(lchnk)%ncol + do c = begchunk,endchunk + ncol = state(c)%ncol + lchnk = state(c)%lchnk call pbuf_get_field(pbuf_get_chunk(pbuf2d,lchnk), cldtop_ndx, cldtop ) - 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 + 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 else - itype = 2 ! topical marine + itype = 2 ! topical marine end if frac_sum = 0._r8 do k = cldtind,pver - 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 + 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 do kk = zlow_ind,zhigh_ind wrk = kk wrk1 = kk - 1 @@ -447,11 +355,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(icol,k,lchnk) = prod_no(icol,k,lchnk) & ! sum the fraction of column NOx in layer k + prod_no(i,k,c) = prod_no(i,k,c) & ! sum the fraction of column NOx in layer k + fraction*vdist(kk,itype)*.01_r8 end do - 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 + 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 end do end if end if @@ -462,10 +370,15 @@ subroutine lightning_no_prod( state, pbuf2d, cam_in ) !-------------------------------------------------------------------------------- ! ... output lightning no production to history file !-------------------------------------------------------------------------------- - 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 ) + 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( '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/mozart/ocean_emis.F90 b/src/chemistry/mozart/ocean_emis.F90 index 289cafeb77..26819fd846 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,7 +225,6 @@ subroutine ocean_emis_init() endif allocate(salinity(pcols,begchunk:endchunk)) - salinity = 0._r8 do c=begchunk,endchunk @@ -236,22 +235,17 @@ 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 - ! fill in missing values with climatology for modern-day - 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 @@ -259,17 +253,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 @@ -280,7 +274,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 @@ -292,12 +286,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 @@ -307,13 +301,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 :: i, m, isec, SpeciesID - real(r8) :: Csw_col(ncol) - real(r8) :: MW_species - real(r8) :: oceanflux_kg_m2_s(ncol) + integer :: 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 ! ================================================== @@ -323,30 +317,28 @@ 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 - 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 + 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 ! =========================================================================== - ! 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) @@ -363,8 +355,10 @@ 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 @@ -383,7 +377,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, & @@ -415,12 +409,10 @@ 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 @@ -439,8 +431,6 @@ Subroutine SaltLibInitialization() ! --------------------------------------------- End Subroutine SaltLibInitialization - !-------------------------------------------------------------------------------- - !-------------------------------------------------------------------------------- Function SpeciesIndex(SpeciesName) ! ============================================== ! This function is to look for the species index @@ -449,7 +439,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 @@ -458,15 +448,13 @@ Function SpeciesIndex(SpeciesName) End Do End Function SpeciesIndex - !-------------------------------------------------------------------------------- - !-------------------------------------------------------------------------------- - 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) + 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) ! =========================================================================== ! 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 @@ -475,51 +463,52 @@ Real(r8) Function Flux_kg_m2_s(SpeciesName,Cgas_ppt,Cwater_nM,T_air_K,u10_m_s,P_ ! - 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) ! =========================================================================== - 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 + 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 - Integer :: SpeciesID - Real(r8) :: H_gas_over_liquid_dimless, kt_m_s + where(Salinity_PartsPerThousand .lt. 0.0_r8) Salinity_PartsPerThousand = 33.0_r8 - SpeciesID = SpeciesIndex(SpeciesName) - H_gas_over_liquid_dimless = 1.0_r8/(Henry_M_atm(SpeciesID,T_water_K,Salinity_PartsPerThousand)*& + SpeciesID = SpeciesIndex(SpeciesName) + H_gas_over_liquid_dimless = 1.0_r8/(Henry_M_atm(SpeciesID,T_water_K,Salinity_PartsPerThousand,ncol)*& 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) & - + 1.0_r8/k_air_m_s(SpeciesID, u10_m_s, T_air_K, P_atm)& + 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)& /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) & - + 1.0_r8/k_air_m_s(SpeciesID, u10_m_s, T_air_K, P_atm)/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, 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) 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 - !-------------------------------------------------------------------------------- - !-------------------------------------------------------------------------------- - Real(r8) Function k_air_m_s(SpeciesIndex, u10_m_s, T_air_K, P_atm) + + Function k_air_m_s(SpeciesIndex, u10_m_s, T_air_K, P_atm, ncol) 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 ,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 + 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 ! 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) @@ -527,53 +516,53 @@ Real(r8) Function k_air_m_s(SpeciesIndex, u10_m_s, T_air_K, P_atm) 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) - SchmidtNumberInAir = DynamicViscosityAir_kg_m_s / DensityAir_kg_m3 / (DiffusivityInAir/10000.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) 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 - !-------------------------------------------------------------------------------- - !-------------------------------------------------------------------------------- - Real(r8) Function k_water_m_s(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, u10_m_s) + + + + Function k_water_m_s(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, u10_m_s, ncol) ! ================================================================================ ! Water-side transfer velocity. Ref: Nightingale et al (2000). Salinity considered ! ================================================================================ - Integer ,intent(in) :: SpeciesIndex - Real(r8),intent(in) :: T_water_K, Salinity_PartsPerThousand, u10_m_s - - Real(r8) :: DiffusivityInWater, SchmidtNumberInWater - Real(r8) :: SchmidtNumberInWater_CO2ref - + 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 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) - 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) + 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) 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 - !-------------------------------------------------------------------------------- - !-------------------------------------------------------------------------------- - Real(r8) Function k_water_m_s_bubble(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, u10_m_s, Cgas_ppt, P_atm, T_air_K) + + + + Function k_water_m_s_bubble(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, u10_m_s, Cgas_ppt, P_atm, T_air_K, ncol) ! ============================================================== ! Water-side transfer velocity. Ref: Asher and Wanninkhof (1998). ! ============================================================== - 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) + 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) 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)) & @@ -581,46 +570,40 @@ Real(r8) Function k_water_m_s_bubble(SpeciesIndex, T_water_K, Salinity_PartsPerT + 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 - !-------------------------------------------------------------------------------- - !-------------------------------------------------------------------------------- - Real(r8) Function DiffusivityInAir_cm2_s(SpeciesIndex, T_air_K, P_atm) + + + + Function DiffusivityInAir_cm2_s(SpeciesIndex, T_air_K, P_atm, ncol) ! ============================ ! Ref: Johnson Ocean Sci. 2010 ! ============================ - Integer ,intent(in) :: SpeciesIndex - Real(r8),intent(in) :: T_air_K, P_atm - + Integer :: ncol, SpeciesIndex + Real(r8), Dimension(ncol) :: DiffusivityInAir_cm2_s, 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 - !-------------------------------------------------------------------------------- - !-------------------------------------------------------------------------------- - Real(r8) Function DiffusivityInWater_cm2_s(SpeciesIndex, T_water_K, Salinity_PartsPerThousand) + + + Function DiffusivityInWater_cm2_s(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, ncol) ! ================================================= ! Ref: Johnson Ocean Sci. 2010. Salinity considered ! ================================================= - Integer, intent(in) :: SpeciesIndex - Real(r8),intent(in) :: T_water_K, Salinity_PartsPerThousand - + Integer :: ncol, SpeciesIndex + Real(r8), Dimension(ncol) :: DiffusivityInWater_cm2_s, DynamicViscosityWater, T_water_K, Salinity_PartsPerThousand Real(r8), parameter :: AssociationFactor = 2.6_r8 ! ... for water - Real(r8) :: DynamicViscosityWater, Vb, MW_species - + Real(r8) :: Vb, MW_species Vb = LiquidMolarVolume_cm3_mol(SpeciesIndex) MW_species = MolecularWeight(SpeciesIndex) - - DynamicViscosityWater = DynamicViscosityWater_g_m_s(T_water_K, Salinity_PartsPerThousand) + DynamicViscosityWater = DynamicViscosityWater_g_m_s(T_water_K, Salinity_PartsPerThousand, ncol) ! ------------------------------------------------- ! Wilke and Chang 1955: this seems to be a bit high ! ------------------------------------------------- @@ -634,51 +617,47 @@ Real(r8) Function DiffusivityInWater_cm2_s(SpeciesIndex, T_water_K, Salinity_Par End Function DiffusivityInWater_cm2_s - !-------------------------------------------------------------------------------- - !-------------------------------------------------------------------------------- - Real(r8) Function DynamicViscosityWater_g_m_s(T_water_K, Salinity_PartsPerThousand) + + Function DynamicViscosityWater_g_m_s(T_water_K, Salinity_PartsPerThousand, ncol) ! ================================================= ! Ref: Johnson Ocean Sci. 2010. Salinity considered ! ================================================= - Real(r8),intent(in) :: T_water_K, Salinity_PartsPerThousand - - Real(r8) :: MassFrac_water, DynamicViscosityPureWater_g_m_s, SaltViscosity, sum_w_ln_SaltViscosity - Integer :: n - + 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 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) - - If (Salinity_PartsPerThousand == 0.0_r8) Then ! pure water - DynamicViscosityWater_g_m_s = DynamicViscosityPureWater_g_m_s + / (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) Else ! salty water Do n = 1, HowManySalts - SaltViscosity = exp((SaltList(n)%SaltProperties(2) * & - (Salinity_PartsPerThousand/1000.0_r8)**SaltList(n)%SaltProperties(3) & + SaltViscosity(j) = exp((SaltList(n)%SaltProperties(2) * & + (Salinity_PartsPerThousand(j)/1000.0_r8)**SaltList(n)%SaltProperties(3) & + SaltList(n)%SaltProperties(4)) & - / (SaltList(n)%SaltProperties(5)*(T_water_K-273.15_r8) + 1.0_r8)) & - / (SaltList(n)%SaltProperties(6) * (Salinity_PartsPerThousand / & + / (SaltList(n)%SaltProperties(5)*(T_water_K(j)-273.15_r8) + 1.0_r8)) & + / (SaltList(n)%SaltProperties(6) * (Salinity_PartsPerThousand(j) / & 1000.0_r8)**SaltList(n)%SaltProperties(7) + 1.0_r8) - sum_w_ln_SaltViscosity = sum_w_ln_SaltViscosity + (Salinity_PartsPerThousand/1000.0_r8) & - * SaltList(n)%SaltProperties(1) * log(SaltViscosity) + sum_w_ln_SaltViscosity(j) = sum_w_ln_SaltViscosity(j) + (Salinity_PartsPerThousand(j)/1000.0_r8) & + * SaltList(n)%SaltProperties(1) * log(SaltViscosity(j)) End Do - DynamicViscosityWater_g_m_s = exp(MassFrac_water & - * log(DynamicViscosityPureWater_g_m_s) + sum_w_ln_SaltViscosity) + DynamicViscosityWater_g_m_s(j) = exp(MassFrac_water(j) & + * log(DynamicViscosityPureWater_g_m_s(j)) + sum_w_ln_SaltViscosity(j)) Endif - + End Do End Function DynamicViscosityWater_g_m_s - !-------------------------------------------------------------------------------- - !-------------------------------------------------------------------------------- - Real(r8) Function DensityWater_kg_m3(T_water_K, Salinity_PartsPerThousand) + + Function DensityWater_kg_m3(T_water_K, Salinity_PartsPerThousand, ncol) ! ==================================================== ! Ref: Millero and Poisson (1981). Salinity considered ! ==================================================== - Real(r8), intent(in) :: T_water_K, Salinity_PartsPerThousand - - Real(r8) :: DensityPureWater_kg_m3, FactorA, FactorB, FactorC - + Integer :: ncol + Real(r8), Dimension(ncol) :: DensityWater_kg_m3, T_water_K, Salinity_PartsPerThousand + Real(r8), Dimension(ncol) :: 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) & @@ -690,46 +669,41 @@ Real(r8) Function DensityWater_kg_m3(T_water_K, Salinity_PartsPerThousand) 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 - !-------------------------------------------------------------------------------- - !-------------------------------------------------------------------------------- - Real(r8) Function Henry_M_atm(SpeciesIndex, T_water_K, Salinity_PartsPerThousand) + + Function Henry_M_atm(SpeciesIndex, T_water_K, Salinity_PartsPerThousand, ncol) ! ========================================================================================= ! Ref: Sander compilation 2015. Salt-in or salt-out estimated based on Setschenow constants ! ========================================================================================= - Integer, intent(in) :: SpeciesIndex - Real(r8), intent(in) :: T_water_K, Salinity_PartsPerThousand - - Real(r8) :: Heff_M_atm_PureWater, Setschenow, Heff_M_atm_SaltyWater - + 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 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)) - - 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 - + 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 - !-------------------------------------------------------------------------------- - !-------------------------------------------------------------------------------- + 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) @@ -738,7 +712,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 @@ -757,20 +731,18 @@ 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) @@ -794,7 +766,7 @@ subroutine cseawater_ini() character(len=*), parameter :: subname = 'cseawater_ini' - ! ======================================================== + ! ======================================================== ! Read sea water concentration specifier from the namelist ! ======================================================== @@ -855,7 +827,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)) @@ -926,9 +898,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) @@ -960,4 +932,5 @@ subroutine cseawater_ini() end subroutine cseawater_ini + end module ocean_emis diff --git a/src/control/camsrfexch.F90 b/src/control/camsrfexch.F90 index de1ea4ce6e..f978e4923c 100644 --- a/src/control/camsrfexch.F90 +++ b/src/control/camsrfexch.F90 @@ -61,7 +61,6 @@ 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) ! cloud-to-ground 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 @@ -303,7 +302,6 @@ 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 @@ -425,7 +423,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, lightning_idx + integer :: srf_ozone_idx real(r8), pointer :: psl(:) @@ -438,7 +436,6 @@ 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 @@ -456,7 +453,6 @@ 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) @@ -516,12 +512,6 @@ 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/control/runtime_opts.F90 b/src/control/runtime_opts.F90 index f09554244d..55120a894b 100644 --- a/src/control/runtime_opts.F90 +++ b/src/control/runtime_opts.F90 @@ -99,7 +99,6 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) use upper_bc, only: ubc_readnl use cam_budget, only: cam_budget_readnl use phys_grid_ctem, only: phys_grid_ctem_readnl - use mo_lightning, only: lightning_readnl !---------------------------Arguments----------------------------------- @@ -167,7 +166,6 @@ 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 8c28b120fa..3c0cbba542 100644 --- a/src/cpl/nuopc/atm_import_export.F90 +++ b/src/cpl/nuopc/atm_import_export.F90 @@ -60,8 +60,7 @@ 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 - logical :: atm_provides_lightning = .false. ! cld to grnd lightning flash freq (min-1) + integer, public :: ndep_nflds = -huge(1) ! number of nitrogen deposition fields from atm->lnd/ocn 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__ @@ -80,7 +79,6 @@ 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' @@ -90,7 +88,6 @@ 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 @@ -206,11 +203,6 @@ subroutine advertise_fields(gcomp, flds_scalar_name, rc) ! Assume that 2 fields are always sent as part of Faxa_ndep call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_ndep', ungridded_lbound=1, ungridded_ubound=2) - ! lightning flash freq - if (atm_provides_lightning) then - call fldlist_add(fldsFrAtm_num, fldsFrAtm, 'Sa_lightning') - end if - ! Now advertise above export fields if (masterproc) write(iulog,*) trim(subname)//' advertise export fields' do n = 1,fldsFrAtm_num @@ -925,7 +917,6 @@ subroutine export_fields( gcomp, model_mesh, model_clock, 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)' !--------------------------------------------------------------------------- @@ -1055,18 +1046,6 @@ subroutine export_fields( gcomp, model_mesh, model_clock, cam_out, rc) end do end if - 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 - do c = begchunk,endchunk - do i = 1,get_ncols_p(c) - fldptr_lght(g) = cam_out(c)%lightning_flash_freq(i) ! cloud-to-ground lightning flash frequency (/min) - 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 e1e781b4ed..95fd2196f2 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -115,7 +115,6 @@ 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 @@ -270,9 +269,6 @@ 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() @@ -719,7 +715,6 @@ 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 @@ -861,9 +856,6 @@ 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() @@ -1254,9 +1246,9 @@ subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, & ! call get_met_srf2( cam_in ) #endif - ! lightning flash freq and prod rate of NOx + ! 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 ) call t_stopf ('lightning_no_prod') call t_barrierf('sync_ac_physics', mpicom) diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index 7452f9e115..b07066df0d 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -112,7 +112,6 @@ 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 @@ -258,9 +257,6 @@ 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() @@ -707,7 +703,6 @@ 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 @@ -842,9 +837,6 @@ 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() @@ -1212,9 +1204,9 @@ subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, & ! call get_met_srf2( cam_in ) #endif - ! lightning flash freq and prod rate of NOx + ! 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 ) call t_stopf ('lightning_no_prod') call t_barrierf('sync_ac_physics', mpicom) From 176b0884e4656e3ad6d8d9a0a44d11fdc6c3aa45 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 28 Apr 2023 00:34:54 -0600 Subject: [PATCH 133/140] forgot to rename cam_budget_init in cam/physpkg --- src/physics/cam/physpkg.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index e1e781b4ed..371cab1c13 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -980,7 +980,7 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) call cam_snapshot_init(cam_in, cam_out, pbuf2d, begchunk) ! Initialize the budget capability - call budget_init() + call cam_budget_init() ! addfld calls for U, V tendency budget variables that are output in ! tphysac, tphysbc From e846d0fc6fe8ef5ed23f605b2ff12e53561643e4 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 28 Apr 2023 09:44:09 -0600 Subject: [PATCH 134/140] FINDLOC not supported in NAG versions < 7.0 replaced with MAXLOC --- src/control/cam_history.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index c3dd6de35a..655ebc42e9 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -485,7 +485,7 @@ subroutine intht (model_doi_url_in) if (tape(t)%hlist(f)%avgflag .eq. 'N') then ! set up areawt weight buffer fdecomp = tape(t)%hlist(f)%field%decomp_type if (any(allgrids_wt(:)%decomp_type == fdecomp)) then - wtidx=FINDLOC(allgrids_wt(:)%decomp_type, fdecomp) + wtidx=MAXLOC(allgrids_wt(:)%decomp_type, fdecomp) tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf else ! area weights not found for this grid, then create them @@ -2165,7 +2165,7 @@ subroutine read_restart_history (File) nullify(tape(t)%hlist(f)%wbuf) if (any(allgrids_wt(:)%decomp_type == tape(t)%hlist(f)%field%decomp_type)) then - wtidx=FINDLOC(allgrids_wt(:)%decomp_type, fdecomp) + wtidx=MAXLOC(allgrids_wt(:)%decomp_type, fdecomp) tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf else ! area weights not found for this grid, then create them From abd0cf5f7dcc10a5cc7ca6e6832bbf54b38d52a4 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 28 Apr 2023 13:27:03 -0600 Subject: [PATCH 135/140] bugfix for MAXLOC doesnt affect regression tests as no globals tested yet --- src/control/cam_history.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 655ebc42e9..677544bdc3 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -485,7 +485,7 @@ subroutine intht (model_doi_url_in) if (tape(t)%hlist(f)%avgflag .eq. 'N') then ! set up areawt weight buffer fdecomp = tape(t)%hlist(f)%field%decomp_type if (any(allgrids_wt(:)%decomp_type == fdecomp)) then - wtidx=MAXLOC(allgrids_wt(:)%decomp_type, fdecomp) + wtidx=MAXLOC(allgrids_wt(:)%decomp_type, MASK = allgrids_wt(:)%decomp_type .EQ. fdecomp) tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf else ! area weights not found for this grid, then create them @@ -2165,7 +2165,7 @@ subroutine read_restart_history (File) nullify(tape(t)%hlist(f)%wbuf) if (any(allgrids_wt(:)%decomp_type == tape(t)%hlist(f)%field%decomp_type)) then - wtidx=MAXLOC(allgrids_wt(:)%decomp_type, fdecomp) + wtidx=MAXLOC(allgrids_wt(:)%decomp_type, MASK = allgrids_wt(:)%decomp_type .EQ. fdecomp) tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf else ! area weights not found for this grid, then create them From f4742d8fa9729cce343b196ffad1535da8e45ad4 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 28 Apr 2023 14:15:15 -0600 Subject: [PATCH 136/140] corrected subroutine renames - only executed when budgets are turned on - no regression test side effects. --- src/dynamics/mpas/dycore_budget.F90 | 40 ++++++++++++++--------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 index f78cf28c20..18dd0e1375 100644 --- a/src/dynamics/mpas/dycore_budget.F90 +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -92,29 +92,29 @@ subroutine print_budget(hstwr) ! ! CAM physics energy tendencies ! - call budget_get_global('phAP-phBP',idx(i),dEdt_param_physE(i)) - call budget_get_global('phBP-phBF',idx(i),dEdt_efix_physE(i)) - call budget_get_global('phAM-phAP',idx(i),dEdt_dme_adjust_physE(i)) - call budget_get_global('phAP-phBF',idx(i),dEdt_param_efix_physE(i)) + call cam_budget_get_global('phAP-phBP',idx(i),dEdt_param_physE(i)) + call cam_budget_get_global('phBP-phBF',idx(i),dEdt_efix_physE(i)) + call cam_budget_get_global('phAM-phAP',idx(i),dEdt_dme_adjust_physE(i)) + call cam_budget_get_global('phAP-phBF',idx(i),dEdt_param_efix_physE(i)) ! ! CAM physics energy tendencies using dycore energy formula scaling ! temperature tendencies for consistency with CAM physics ! - call budget_get_global('dyAP-dyBP',idx(i),dEdt_param_dynE(i)) - call budget_get_global('dyBP-dyBF',idx(i),dEdt_efix_dynE(i)) - call budget_get_global('dyAM-dyAP',idx(i),dEdt_dme_adjust_dynE(i)) - call budget_get_global('dyAP-dyBF',idx(i),dEdt_param_efix_dynE(i)) - call budget_get_global('dyAM-dyBF',idx(i),dEdt_phys_total_dynE(i)) - call budget_get_global('dyBF' ,idx(i),E_dyBF(i))!state beginning physics + call cam_budget_get_global('dyAP-dyBP',idx(i),dEdt_param_dynE(i)) + call cam_budget_get_global('dyBP-dyBF',idx(i),dEdt_efix_dynE(i)) + call cam_budget_get_global('dyAM-dyAP',idx(i),dEdt_dme_adjust_dynE(i)) + call cam_budget_get_global('dyAP-dyBF',idx(i),dEdt_param_efix_dynE(i)) + call cam_budget_get_global('dyAM-dyBF',idx(i),dEdt_phys_total_dynE(i)) + call cam_budget_get_global('dyBF' ,idx(i),E_dyBF(i))!state beginning physics ! ! CAM physics energy tendencies in dynamical core ! - call budget_get_global('dAP-dBF',teidx,dEdt_param_efix_in_dyn(i)) - call budget_get_global('dAM-dAP',teidx,dEdt_dme_adjust_in_dyn(i)) - call budget_get_global('dAM-dBF',teidx,dEdt_param_efix_in_dyn(i)) + call cam_budget_get_global('dAP-dBF',teidx,dEdt_param_efix_in_dyn(i)) + call cam_budget_get_global('dAM-dAP',teidx,dEdt_dme_adjust_in_dyn(i)) + call cam_budget_get_global('dAM-dBF',teidx,dEdt_param_efix_in_dyn(i)) - call budget_get_global('dAM-dBF',idx(i),dEdt_phys_total_in_dyn(i)) - call budget_get_global('dBF' ,idx(i),E_dBF(i)) !state passed to physics + call cam_budget_get_global('dAM-dBF',idx(i),dEdt_phys_total_in_dyn(i)) + call cam_budget_get_global('dBF' ,idx(i),E_dBF(i)) !state passed to physics end do write(iulog,*)" " write(iulog,*)"======================================================================" @@ -336,10 +336,10 @@ subroutine print_budget(hstwr) if (thermo_budget_vars_massv(m_cnst)) then write(iulog,*)thermo_budget_vars_descriptor(m_cnst) write(iulog,*)"------------------------------" - call budget_get_global('phBP-phBF',m_cnst,dMdt_efix) - call budget_get_global('phAM-phAP',m_cnst,dMdt_dme_adjust) - call budget_get_global('phAP-phBP',m_cnst,dMdt_parameterizations) - call budget_get_global('phAM-phBF',m_cnst,dMdt_phys_total) + call cam_budget_get_global('phBP-phBF',m_cnst,dMdt_efix) + call cam_budget_get_global('phAM-phAP',m_cnst,dMdt_dme_adjust) + call cam_budget_get_global('phAP-phBP',m_cnst,dMdt_parameterizations) + call cam_budget_get_global('phAM-phBF',m_cnst,dMdt_phys_total) ! ! total energy fixer should not affect mass - checking ! @@ -369,7 +369,7 @@ subroutine print_budget(hstwr) ! ! check if mass change in physics is the same as dynamical core ! - call budget_get_global('dAM-dBF',m_cnst,dMdt_phys_total_in_dyn) + call cam_budget_get_global('dAM-dBF',m_cnst,dMdt_phys_total_in_dyn) dMdt_PDC = dMdt_phys_total-dMdt_phys_total_in_dyn write(iulog,fmtm)" Mass physics-dynamics coupling error ",dMdt_PDC," Pa/m^2/s" write(iulog,*)" " From 65d277fd05f9f710e68063617f2a5899a843414b Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 28 Apr 2023 15:56:15 -0600 Subject: [PATCH 137/140] update Changelog for tag --- doc/ChangeLog | 199 +++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 190 insertions(+), 9 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index da5dde0cd7..03c5a4e1d9 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,10 +1,10 @@ =============================================================== -Tag name: cam6_3_XXX +Tag name: cam6_3_109 Originator(s): pel, jet -Date: 8 March 2023 +Date: 28 April 2023 One-line Summary: Science and infrastructure updates for inline energy/mass budgets -Github PR URL: https://github.com/ESCOMP/CAM/pull/ +Github PR URL: https://github.com/ESCOMP/CAM/pull/761 Purpose of changes (include the issue number and title text for each relevant GitHub issue): @@ -74,9 +74,14 @@ Describe any changes made to the namelist: follows existing functionality to outfld standard diagnostics for budgeting and diagnosis. + se_lcp_moist + se_phys_dyn_cp + - removed + thermo_budget_histfile_num: integer identifing which history file will contain - additional budgeting diagnostic fields + additional budgeting diagnostic fields thermo_budget_history: logical that turns history budgeting on and off. + - added List any changes to the defaults for the boundary datasets: N/A @@ -85,7 +90,7 @@ Describe any substantial timing or memory changes: written to the history file. The budgeting diagnostics are not meant to be enabled during a production run. -Code reviewed by: +Code reviewed by: cacraigucar nusbaume brian-eaton fvitt pel List all files eliminated: N/A @@ -293,13 +298,189 @@ 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: Expecting namelist and baseline failures +cheyenne/intel/aux_cam: Expecting namelist and baseline failures (SE,MPAS,FV3 climate changing, others roundoff) + + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 (Overall: FAIL) + - pre-existing failure + + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) + ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.cheyenne_intel.cam-co2rmp_usecase (Overall: DIFF) + ERP_D_Ln9_Vmct.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9_Vmct.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) + ERP_Ln9_Vmct.f09_f09_mg17.2000_CAM60_CLM50%SP_CICE5%PRES_DOCN%DOM_MOSART_SGLC_SWAV.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined (Overall: DIFF) + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) + - expecting climate changing differences in SE,MPAS,FV3 + - verified FV,EUL differences are roundoff + + FAIL ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase NLCOMP + FAIL ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 NLCOMP + FAIL ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 NLCOMP + FAIL ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s_wcm_ne30 NLCOMP + FAIL ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined NLCOMP + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc_P720x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s NLCOMP + FAIL SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d NLCOMP + FAIL SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d NLCOMP + - expected NLCOMP failures due to removal of se_lcp_moist, se_phys_dyn_cp namelist variables for SE runs + - expected NLCOMP failures from addition of GRAUPEL to water species for cam_dev and FV3 runs izumi/nag/aux_cam: Expecting namelist and baseline failures + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - pre-existing failure + + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: DIFF) + ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) + ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) + ERI_D_Ln18_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) + ERI_D_Ln18_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) + ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) + ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: DIFF) + ERS_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: DIFF) + PEM_D_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: DIFF) + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) + SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) + SMS_D_Ln9_P1x1_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) + SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) + TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) + - expecting climate changing differences in SE,MPAS,FV3 + - verified FV,EUL differences are roundoff + + FAIL ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac NLCOMP + FAIL ERI_D_Ln18_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic NLCOMP + FAIL ERI_D_Ln18_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic NLCOMP + FAIL ERP_Ln9_Vmct.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf NLCOMP + FAIL ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf NLCOMP + FAIL ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s NLCOMP + FAIL ERS_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s NLCOMP + FAIL PEM_D_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 NLCOMP + FAIL SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s NLCOMP + FAIL SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem NLCOMP + FAIL SMS_D_Ln9_P1x1_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s NLCOMP + - expected NLCOMP failures due to removal of se_lcp_moist, se_phys_dyn_cp namelist variables for SE runs + izumi/gnu/aux_cam: Expecting namelist and baseline failures + ERC_D_Ln9_Vnuopc.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: DIFF) + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) + ERC_D_Ln9_Vnuopc.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) + ERP_Ln9_Vnuopc.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: DIFF) + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) + PEM_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) + SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: DIFF) + 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) + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: DIFF) + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) + - expecting climate changing differences in SE,MPAS,FV3 + - verified FV,EUL differences are roundoff + + FAIL ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s NLCOMP + FAIL ERC_D_Ln9_Vnuopc.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s NLCOMP + FAIL ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC3.izumi_gnu.cam-outfrq3s_usecase NLCOMP + FAIL ERP_Ln9_Vnuopc.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s NLCOMP + FAIL ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s NLCOMP + FAIL PEM_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 NLCOMP + FAIL PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 NLCOMP + FAIL SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s NLCOMP + FAIL SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac NLCOMP + - expected NLCOMP failures due to removal of se_lcp_moist, se_phys_dyn_cp namelist variables for SE runs + - expected NLCOMP failures from addition of GRAUPEL to water species for cam_dev and FV3 runs + - expected NLCOMP failures due to change in format of water_species_in_air for EUL runs -Summarize any changes to answers: climate changing +Summarize any changes to answers: climate changing for SE,MPAS due to science updates + climate changing for FV3 due to addition of GRAUPEL + roundoff for FV and EUL =============================================================== =============================================================== @@ -542,9 +723,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 From a054f198af2fdd274a9bfae481ac23ffd3e7907f Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 28 Apr 2023 16:10:47 -0600 Subject: [PATCH 138/140] add extra issues also included in this PR --- doc/ChangeLog | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 03c5a4e1d9..c84c11f8a2 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -11,8 +11,11 @@ Purpose of changes (include the issue number and title text for each relevant Gi Add inline energy/mass budgets support. (#519) Science changes are included that help close the mass and energy budgets of physics and the SE/MPAS dycores (#521) as well as adding all water - constituents to atmospheric mass (pressure) (#520). Lastly, - a bugfix to corectly open an instance version of atm_in (#790). + constituents to atmospheric mass (pressure) (#520). + + Extra items also included in this PR: + - Bugfix to corectly open an instance version of atm_in (ndep issue #790) + - Update FLTHIST compset and finish implementing initial FMTHIST compset. As of this commit energy/mass budgets have been roughed in for physics and the SE and MPAS dycores. Similar to amwg_diagnostic From da6f9aed13099de3c3fcd104429a0672a1e4066b Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 28 Apr 2023 16:14:00 -0600 Subject: [PATCH 139/140] spelling... --- doc/ChangeLog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index c84c11f8a2..a0e281c040 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -14,7 +14,7 @@ Purpose of changes (include the issue number and title text for each relevant Gi constituents to atmospheric mass (pressure) (#520). Extra items also included in this PR: - - Bugfix to corectly open an instance version of atm_in (ndep issue #790) + - Bugfix to correctly open an instance version of atm_in (ndep issue #790) - Update FLTHIST compset and finish implementing initial FMTHIST compset. As of this commit energy/mass budgets have been roughed in for From 4043cb899f1857ebc0bbd1c6b8870346940849b6 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 28 Apr 2023 16:18:12 -0600 Subject: [PATCH 140/140] added issue #789 --- doc/ChangeLog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index a0e281c040..b4e95641bf 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -15,7 +15,7 @@ Purpose of changes (include the issue number and title text for each relevant Gi Extra items also included in this PR: - Bugfix to correctly open an instance version of atm_in (ndep issue #790) - - Update FLTHIST compset and finish implementing initial FMTHIST compset. + - Update FLTHIST compset and finish implementing initial FMTHIST compset (#789) As of this commit energy/mass budgets have been roughed in for physics and the SE and MPAS dycores. Similar to amwg_diagnostic