diff --git a/bld/build-namelist b/bld/build-namelist index c63c36cbbc..2cec1b4a51 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3860,7 +3860,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 @@ -3888,7 +3887,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 8414d3b7aa..3444771dae 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2863,14 +2863,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' +'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' @@ -2968,8 +2970,6 @@ 2 - .true. - .true. 3.22D0 @@ -2997,8 +2997,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 0457b3e499..14b0dcfc8c 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -1733,7 +1733,7 @@ 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: @@ -1741,6 +1741,7 @@ series. Valid values are: B ==> GMT 00:00:00 average I ==> Instantaneous M ==> Minimum + N ==> average over nsteps X ==> Maximum L ==> Local-time S ==> Standard deviation @@ -1832,6 +1833,7 @@ are: B ==> GMT 00:00:00 average I ==> Instantaneous M ==> Minimum + N ==> average over nsteps X ==> Maximum L ==> Local-time S ==> Standard deviation @@ -5062,6 +5064,17 @@ Default: 4 m/s + +History tape number thermo budget output is written to. +Default: 1 + + + +Produce output for the energy budget diagnostic package. +Default: .false. + @@ -7671,16 +7684,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]. @@ -7746,17 +7749,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/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 diff --git a/doc/ChangeLog b/doc/ChangeLog index 054da12e4b..b4e95641bf 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,493 @@ =============================================================== +Tag name: cam6_3_109 +Originator(s): pel, jet +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/761 + +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). + + 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 (#789) + + 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 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 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 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 + 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 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 + 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 + 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. + + se_lcp_moist + se_phys_dyn_cp + - removed + + 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. + - added + +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: cacraigucar nusbaume brian-eaton fvitt pel + +List all files eliminated: N/A + +List all files added and what they do: + 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 bld/namelist_files/use_cases/hist_cam_mt.xml + - update FLTHIST for coupled runs + + M bld/build_namelist + - Remove 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. + + 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 cime_config/config_compsets.xml + - update FLTHIST for coupled runs + + 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 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 + + 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/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/dycore/control_mod.F90 + - remove phys_dyn_cp energy scaling flag + + 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/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. + - 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/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 + + 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 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. + + 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 (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 for SE,MPAS due to science updates + climate changing for FV3 due to addition of GRAUPEL + roundoff for FV and EUL + +=============================================================== +=============================================================== + Tag name: cam6_3_108 Originator(s): fvitt Date: 27 Apr 2023 diff --git a/src/control/cam_budget.F90 b/src/control/cam_budget.F90 new file mode 100644 index 0000000000..1ae7fd20f4 --- /dev/null +++ b/src/control/cam_budget.F90 @@ -0,0 +1,398 @@ +module cam_budget + !---------------------------------------------------------------------------- + ! + ! Adds support for energy and mass snapshots and budgets using cam_history api. + ! + ! Public functions/subroutines: + ! + ! cam_budget_init + ! cam_budget_em_snapshot + ! cam_budget_em_register + ! cam_budget_get_global + ! cam_budget_readnl + ! budget_ind_byname + ! is_cam_budget + !----------------------------------------------------------------------- + + use cam_abortutils, only: endrun + use cam_history, only: addfld, add_default, horiz_only + 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 + 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 + private + save + + ! Public interfaces + public :: & + cam_budget_init, &! initialize budget variables + cam_budget_em_snapshot, &! define a snapshot 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_cam_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, 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 + + + !============================================================================================== +CONTAINS + !============================================================================================== + ! + ! Read namelist variables. + 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 + use shr_string_mod, only: shr_string_toUpper + use string_utils, only: int2str + + ! Dummy argument: filepath for file containing namelist input + character(len=*), intent(in) :: nlfile + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'cam_budget_readnl :: ' + + 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, 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 /= 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 /= mpi_success) 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 cam_budget_readnl + + !============================================================================================== + + subroutine cam_budget_init() + use time_manager, only: get_step_size + + dstepsize=get_step_size() + + end subroutine cam_budget_init + + !============================================================================================== + + 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) + character(len=*), intent(in) :: & + 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) + + character (cl) :: errmsg + character (len=max_fieldname_len) :: name_str + character (cl) :: desc_str, units_str + character (cl) :: gridname + integer :: ivars + character(len=*), parameter :: sub='cam_budget_em_snapshot' + logical :: use_cslam ! using cslam transport for mass tracers + !----------------------------------------------------------------------- + + if (thermo_budget_history) then + ! 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)))," ", & + TRIM(ADJUSTL(longname)) + write(units_str,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) + + 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) + + budget_pkgtype(budget_num)=pkgtype + budget_stagename(budget_num)= trim(name) + + if (pkgtype=='phy') then + gridname='physgrid' + else + if (dycore_is('SE')) then + if (use_cslam .and. thermo_budget_vars_massv(ivars)) then + gridname='FVM' + else + gridname='GLL' + end if + else if (dycore_is('MPAS')) then + gridname='mpas_cell' + else + write(errmsg, *) sub, ': budget_add is only supported for MPAS and SE dycores' + 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=trim(gridname)) + call add_default(TRIM(ADJUSTL(name_str)), thermo_budget_histfile_num, 'N') + end do + end if + end subroutine cam_budget_em_snapshot + + !============================================================================== + + 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. + + 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 + + character(len=*), intent(in) :: & + longname ! value for long_name attribute in netcdf output (128 char max, defaults to name) + + character(len=*), parameter :: sub='cam_budget_em_register' + character(cl) :: errmsg + character(len=1) :: opchar + character (len=max_fieldname_len) :: name_str + character (cl) :: desc_str, units_str + character (cl) :: gridname + character (cl) :: strstg1, strstg2 + integer :: ivars + logical :: use_cslam ! true => use cslam to transport mass variables + !----------------------------------------------------------------------- + + if (thermo_budget_history) then + ! 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 + 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(desc_str,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", & + TRIM(ADJUSTL(longname)) + write(units_str,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars))) + + 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') 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)) + 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 + gridname='physgrid' + else + if (dycore_is('SE')) then + if (use_cslam .and. thermo_budget_vars_massv(ivars)) then + gridname='FVM' + else + gridname='GLL' + end if + else if (dycore_is('MPAS')) then + gridname='mpas_cell' + else + write(errmsg, *) sub, ': budget_add is only supported for MPAS and SE dycores' + 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,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 + end subroutine cam_budget_em_register + + !============================================================================== + + subroutine cam_budget_get_global (name, me_idx, global) + + use cam_history, only: get_field_properties + use cam_history_support, only: active_entry,ptapes + use cam_thermo, only: thermo_budget_vars_massv + + ! 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(:) ! history tapes + character (len=max_fieldname_len) :: name_str + 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='cam_budget_get_global' + !----------------------------------------------------------------------- + ! Initialize tape pointer here to avoid initialization only on first invocation + nullify(tape) + + name_str='' + write(name_str,*) TRIM(ADJUSTL(name)) + + 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 + if (idx /= 0 .and. (midx==0 .or. pidx==0)) then + 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(name_str, '_') + if (uidx == 0) then + !This is a stage name need to append the type of thermo variable using input index + write(name_str,*) TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//trim(adjustl(name_str(1:))) + end if + + 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(name_str))) + + 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=m_ind, f_out=h_ind) + + 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 + write(errmsg,*) sub, ': FATAL: name not found: ', trim(name) + call endrun(errmsg) + end if + + CONTAINS + pure 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_num + 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 cam_budget_get_global + !============================================================================== + + pure function is_cam_budget(name) + + ! Get the index of a budget. + + !-----------------------------Arguments--------------------------------- + character(len=*), intent(in) :: name ! budget name + + !---------------------------Local workspace----------------------------- + logical :: is_cam_budget ! function return + integer :: m ! budget index + !----------------------------------------------------------------------- + + ! Find budget name in list of defined budgets + + 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_cam_budget = .true. + return + end if + end do + end function is_cam_budget + + !=========================================================================== + +end module cam_budget 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 5b0e6f47f2..677544bdc3 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -49,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 @@ -68,19 +69,28 @@ 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 :: 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 ! ! 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) - 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 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 + 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 @@ -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 = 45 integer, parameter :: restartdimcnt = 10 type(rvar_id) :: restartvars(restartvarcnt) type(rdim_id) :: restartdims(restartdimcnt) @@ -177,8 +187,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=9), parameter :: HIST_AVG_FLAGS = ' ABILMNSX' character(len=22) ,parameter :: LT_DESC = 'mean (over local time)' ! local time description logical :: collect_column_output(ptapes) @@ -349,6 +358,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_areawt + use cam_history_support, only: dim_index_2d ! !----------------------------------------------------------------------- ! @@ -367,8 +378,13 @@ 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 :: 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 ! @@ -466,12 +482,43 @@ subroutine intht (model_doi_url_in) 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. '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) + tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf + else + ! area weights not found for this grid, then create them + ! 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,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 + 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 + 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)) else allocate (tape(t)%hlist(f)%nacs(1,begdim3:enddim3)) end if tape(t)%hlist(f)%nacs(:,:) = 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 @@ -937,6 +984,47 @@ 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' + logical :: is_composed + + 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 (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)) + 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 if + end do + end subroutine define_composed_field_ids + subroutine restart_vars_setnames() ! Local variable @@ -1077,6 +1165,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 @@ -1217,6 +1324,48 @@ 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) = max_chars_dim_ind + 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 + + 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() @@ -1366,6 +1515,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 @@ -1378,6 +1529,11 @@ 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 + type(var_desc_t), pointer :: op_field1_desc + type(var_desc_t), pointer :: op_field2_desc integer, allocatable :: allmdims(:,:,:) integer, allocatable :: xyfill(:,:) @@ -1385,7 +1541,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)) @@ -1479,6 +1635,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') @@ -1497,6 +1655,12 @@ 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') + op_field1_desc => restartvar_getdesc('op_field1') + op_field2_desc => restartvar_getdesc('op_field2') + mdims_desc => restartvar_getdesc('mdims') mdimname_desc => restartvar_getdesc('mdimnames') fillval_desc => restartvar_getdesc('fillvalue') @@ -1519,6 +1683,9 @@ 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) + 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) ierr = pio_put_var(File, longname_desc,startc,tape(t)%hlist(f)%field%long_name) @@ -1528,6 +1695,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,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 @@ -1591,11 +1763,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 ! !----------------------------------------------------------------------- ! @@ -1619,8 +1793,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(:,:) ! accumulation counter + integer, pointer :: nacs(:,:) ! outfld 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 @@ -1635,7 +1812,15 @@ 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 + 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(:,:) @@ -1658,6 +1843,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 @@ -1735,33 +1922,38 @@ 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(tmpprec(maxnflds,mtapes)) + ierr = pio_inq_varid(File, 'hbuf_integral',vdesc) + allocate(tmpintegral(maxnflds,mtapes)) + ierr = pio_get_var(File, vdesc, tmpintegral(:,:)) + + ierr = pio_inq_varid(File, 'hwrt_prec',vdesc) + allocate(tmpprec(maxnflds,mtapes)) ierr = pio_get_var(File, vdesc, tmpprec(:,:)) - allocate(xyfill(maxnflds,mtapes)) + ierr = pio_inq_varid(File, 'beg_nstep',vdesc) + allocate(tmpbeg_nstep(maxnflds,mtapes)) + ierr = pio_get_var(File, vdesc, tmpbeg_nstep(:,:)) + 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 @@ -1816,6 +2008,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) @@ -1826,6 +2025,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 +2053,11 @@ 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: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) + 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) @@ -1871,11 +2078,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)%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.) @@ -1892,11 +2104,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, tmpintegral) 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 @@ -1943,7 +2158,39 @@ 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) + tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf + else + ! area weights not found for this grid, then create them + ! 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,begdim3:enddim3)) + cnt=0 + do c=begdim3,enddim3 + dimind = tape(t)%hlist(f)%field%get_dims(c) + ib=dimind%beg1 + ie=dimind%end1 + 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 + endif + endif end do end do ! @@ -2050,6 +2297,9 @@ 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) + end do ! ! Done reading this history restart file @@ -2210,6 +2460,8 @@ subroutine AvgflagToString(avgflag, time_op) time_op(:) = 'mean' case ('B') time_op(:) = 'mean00z' + case ('N') + time_op(:) = 'mean_over_nsteps' case ('I') time_op(:) = ' ' case ('X') @@ -2430,6 +2682,8 @@ subroutine fldlst () end if + allocate(grid_wts(cam_grid_num_grids() + 1)) + allgrids_wt => grid_wts allocate(gridsontape(cam_grid_num_grids() + 1, ptapes)) gridsontape = -1 @@ -2510,6 +2764,7 @@ 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)%varid) end do @@ -2580,6 +2835,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) @@ -3283,6 +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 :: sbuf(:,:) ! variance buffer integer, pointer :: nacs(:) ! accumulation counter integer :: begdim2, enddim2, endi @@ -3322,6 +3581,9 @@ end subroutine subcol_field_avg_handler avgflag = otape(t)%hlist(f)%avgflag 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) + endif if (associated(tape(t)%hlist(f)%sbuf)) then sbuf => otape(t)%hlist(f)%sbuf(:,:,c) endif @@ -3395,6 +3657,10 @@ end subroutine subcol_field_avg_handler call hbuf_accum_add00z(hbuf, ufield, nacs, dimind, pcols, & flag_xyfill, fillvalue) + case ('N') ! Time average over nsteps + call hbuf_accum_add(hbuf, ufield, nacs, dimind, pcols, & + flag_xyfill, fillvalue) + case ('X') ! Maximum over time call hbuf_accum_max (hbuf, ufield, nacs, dimind, pcols, & flag_xyfill, fillvalue) @@ -3433,6 +3699,10 @@ end subroutine subcol_field_avg_handler call hbuf_accum_add00z(hbuf, field, nacs, dimind, idim, & flag_xyfill, fillvalue) + case ('N') ! Time average over nsteps + call hbuf_accum_add (hbuf, field, nacs, dimind, idim, & + flag_xyfill, fillvalue) + case ('X') ! Maximum over time call hbuf_accum_max (hbuf, field, nacs, dimind, idim, & flag_xyfill, fillvalue) @@ -3464,7 +3734,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 ! @@ -3487,6 +3757,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 @@ -3515,6 +3786,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 @@ -3548,8 +3822,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 @@ -3834,15 +4112,16 @@ 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 + 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 @@ -4547,6 +4826,7 @@ end subroutine h_define subroutine h_normalize (f, t) use cam_history_support, only: dim_index_2d + use time_manager, only: get_nstep ! !----------------------------------------------------------------------- @@ -4572,10 +4852,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') @@ -4620,6 +4903,20 @@ subroutine h_normalize (f, t) end do end if end if + currstep=get_nstep() + if (avgflag == 'N' .and. currstep > 0) then + 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) & + / nsteps + end do + else + 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 ! standard deviation ... ! from http://www.johndcook.com/blog/standard_deviation/ @@ -4647,6 +4944,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 ! !----------------------------------------------------------------------- ! @@ -4679,6 +4977,9 @@ subroutine h_zero (f, t) end do tape(t)%hlist(f)%nacs(:,:) = 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') return @@ -4686,6 +4987,127 @@ 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 ! 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 + 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,ie) + end do + end do + end do + ! 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') + end subroutine h_global + + subroutine h_field_op (f, t) + use cam_history_support, only: dim_index_2d + ! + !----------------------------------------------------------------------- + ! + ! Purpose: run field sum or 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 + ! + ! Local workspace + ! + type (dim_index_2d) :: dimind ! 2-D dimension index + integer :: c ! chunk index + 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=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 + 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(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(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) + else + 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 + 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') + 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 @@ -5158,13 +5580,23 @@ subroutine wshist (rgnht_in) 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) - ! Normalized averaged fields - if (tape(t)%hlist(f)%avgflag /= 'I') then - call h_normalize (f, t) - end if - end do + !$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 do + end if + + 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 do end if ! ! Write field to history tape. Note that this is NOT threaded due to netcdf limitations @@ -5175,11 +5607,14 @@ subroutine wshist (rgnht_in) end do call t_stopf ('dump_field') ! + ! Calculate globals + ! + do f=1,nflds(t) + call h_global(f, t) + end do + ! ! 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 +5640,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, & + optype, op_f1name, op_f2name) ! !----------------------------------------------------------------------- @@ -5234,7 +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' 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 ! @@ -5252,12 +5690,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, 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) + gridname, flag_xyfill, sampling_seq, standard_name, fill_value, optype, & + op_f1name, op_f2name) ! !----------------------------------------------------------------------- @@ -5272,7 +5712,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 @@ -5290,6 +5730,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 :: 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 ! ! Local workspace @@ -5299,10 +5742,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 +5798,11 @@ 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%op_field1 = '' + listentry%op_field2 = '' listentry%htapeindx(:) = -1 listentry%act_sometape = .false. listentry%actflag(:) = .false. @@ -5453,6 +5904,45 @@ subroutine addfld_nd(fname, dimnames, avgflag, units, long_name, & call AvgflagToString(avgflag, listentry%time_op(dimcnt)) 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 + 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) + 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 (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 (optype=sum or dif) has been defined' + call endrun (trim(subname)//errormsg) + end if + end if + + nullify(listentry%next_entry) call add_entry_to_master(listentry) @@ -5461,7 +5951,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) @@ -5501,6 +5991,53 @@ logical function field_part_of_vector(fname, meridional_name, zonal_name) end function field_part_of_vector + !####################################################################### + ! 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 + is_composed = .true. + else + is_composed = .false. + end if + 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 + else + write(errormsg, '(3a)') ': Field:',trim(fname),' not defined in masterlist' + call endrun (trim(subname)//errormsg) + end if + + end subroutine composed_field_info + ! 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..b26162753c 100644 --- a/src/control/cam_history_buffers.F90 +++ b/src/control/cam_history_buffers.F90 @@ -111,6 +111,7 @@ subroutine hbuf_accum_add (buf8, field, nacs, dimind, idim, flag_xyfill, fillval end subroutine hbuf_accum_add !####################################################################### + 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..495ce7b519 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 @@ -25,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 @@ -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=field_op_len) :: field_op = '' ! 'sum' or 'dif' + 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 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 @@ -153,17 +158,27 @@ 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 or dif operation + character(len=max_fieldname_len) :: op_field2 ! field2 name for sum or dif operation - integer :: hwrt_prec ! history output precision + 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 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 + 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() + contains + procedure :: get_global => hentry_get_global + procedure :: put_global => hentry_put_global end type hentry !--------------------------------------------------------------------------- @@ -435,6 +450,14 @@ 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 + 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. ! Calculate it first if necessary subroutine field_info_get_shape(this, shape_out, rank_out) @@ -503,6 +526,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_integral + + end subroutine hentry_get_global + + subroutine hentry_put_global(this, gval) + + ! Dummy arguments + class(hentry) :: this + real(r8), intent(in) :: gval + + this%hbuf_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) @@ -651,16 +694,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 @@ -957,6 +992,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/control/runtime_opts.F90 b/src/control/runtime_opts.F90 index f8f182c30b..f09554244d 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 cam_budget, only: cam_budget_readnl use phys_grid_ctem, only: phys_grid_ctem_readnl use mo_lightning, only: lightning_readnl @@ -198,6 +199,7 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) call dyn_readnl(nlfilename) call ionosphere_readnl(nlfilename) call qneg_readnl(nlfilename) + call cam_budget_readnl(nlfilename) call phys_grid_ctem_readnl(nlfilename) end subroutine read_namelist diff --git a/src/cpl/nuopc/atm_comp_nuopc.F90 b/src/cpl/nuopc/atm_comp_nuopc.F90 index e3fc6cb127..8b2ba903d0 100644 --- a/src/cpl/nuopc/atm_comp_nuopc.F90 +++ b/src/cpl/nuopc/atm_comp_nuopc.F90 @@ -724,7 +724,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() 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) 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/eul/dycore_budget.F90 b/src/dynamics/eul/dycore_budget.F90 new file mode 100644 index 0000000000..7531d69ac7 --- /dev/null +++ b/src/dynamics/eul/dycore_budget.F90 @@ -0,0 +1,27 @@ +module dycore_budget +implicit none + +public :: print_budget + +!========================================================================================= +contains +!========================================================================================= + +subroutine print_budget(hstwr) + + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + use cam_budget, only: thermo_budget_history,thermo_budget_histfile_num + + ! arguments + logical, intent(in) :: hstwr(:) + character(len=*), parameter :: subname = 'dycore_budget: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 + +end module dycore_budget diff --git a/src/dynamics/fv/dp_coupling.F90 b/src/dynamics/fv/dp_coupling.F90 index 4f109bf2ee..0b2aa31d55 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 !------------------------------------------------------------ @@ -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 !------------------------------------------------------------------------ @@ -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/fv/dycore_budget.F90 b/src/dynamics/fv/dycore_budget.F90 new file mode 100644 index 0000000000..a672fef9cc --- /dev/null +++ b/src/dynamics/fv/dycore_budget.F90 @@ -0,0 +1,27 @@ +module dycore_budget +implicit none + +public :: print_budget + +!========================================================================================= +contains +!========================================================================================= + +subroutine print_budget(hstwr) + + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + use cam_budget, only: thermo_budget_histfile_num, thermo_budget_history + + ! arguments + logical, intent(in) :: hstwr(:) + character(len=*), parameter :: subname = 'dycore_budget: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 + +end module dycore_budget diff --git a/src/dynamics/fv/metdata.F90 b/src/dynamics/fv/metdata.F90 index 5f49143562..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 @@ -902,6 +904,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 +916,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) @@ -920,14 +927,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(i,k) = state(c)%q(i,k,1) - ! 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) @@ -940,7 +959,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/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/fv3/dycore_budget.F90 b/src/dynamics/fv3/dycore_budget.F90 new file mode 100644 index 0000000000..0645edb251 --- /dev/null +++ b/src/dynamics/fv3/dycore_budget.F90 @@ -0,0 +1,27 @@ +module dycore_budget + +implicit none + +public :: print_budget + +!========================================================================================= +contains +!========================================================================================= + +subroutine print_budget(hstwr) + + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + use cam_budget, only: thermo_budget_histfile_num, thermo_budget_history + + ! arguments + logical, intent(in) :: hstwr(:) + character(len=*), parameter :: subname = 'dycore_budget: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 +end module dycore_budget diff --git a/src/dynamics/mpas/dp_coupling.F90 b/src/dynamics/mpas/dp_coupling.F90 index 2037a820cb..792a7d54b0 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 cam_budget, only : thermo_budget_history ! arguments type(physics_state), intent(inout) :: phys_state(begchunk:endchunk) @@ -70,8 +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(:,:,:) - - integer :: lchnk, icol, icol_p, k, kk ! indices over chunks, columns, physics columns and layers integer :: i, m, ncols, blockid integer :: block_index @@ -90,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 @@ -110,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 @@ -127,7 +123,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, size(tracers, 1), index_qv, zz, zint, rho_zz, theta_m, exner, tracers,& pmiddry, pintdry, pmid) call t_startf('dpcopy') @@ -324,7 +320,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. @@ -332,11 +327,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, 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) @@ -344,7 +340,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) @@ -391,7 +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. - factor(:ncol,k) = 1._r8 + phys_state(lchnk)%q(:ncol,k,1) + 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 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 @@ -418,18 +419,10 @@ 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 ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then + + if (dry_air_species_num>0) then !------------------------------------------------------------ ! Apply limiters to mixing ratios of major species !------------------------------------------------------------ @@ -440,11 +433,25 @@ 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 endif + ! + ! 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) + ! 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 @@ -452,7 +459,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 @@ -484,7 +491,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 @@ -525,10 +532,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 @@ -585,38 +595,76 @@ 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 + + if (compute_energy_diags) then + ! + ! 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 + 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 + idx_dycore = thermodynamic_active_species_idx_dycore(m) + do iCell = 1, nCellsSolve + do k = 1, pver + 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 + else + Rnew = 0.0_r8 + Rold = 1.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/cv)*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+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) @@ -631,7 +679,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), & @@ -645,12 +693,17 @@ 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), & 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 ! @@ -665,8 +718,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, 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 @@ -680,71 +733,89 @@ 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) :: 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 - real(r8), dimension(nVertLevels) :: dz ! Geometric layer thickness in column - real(r8), dimension(nVertLevels+1) :: pint ! hydrostatic pressure at interface - real(r8) :: pi, t - real(r8) :: pk,rhok,rhodryk,theta,thetavk,kap1,kap2 - + integer :: iCell, k, idx + real(r8), dimension(nVertLevels) :: dz ! Geometric layer thickness in column + real(r8), dimension(nVertLevels) :: dp,dpdry ! Pressure thickness + real(r8), dimension(nVertLevels+1,nCells) :: pint ! hydrostatic pressure at interface + 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 ! 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. ! - 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 + 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 + 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 - pk = (rhok*rgas*thetavk*kap1)**kap2 !mid-level top pressure + 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 + 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 - ! + ! pintdry(nVertLevels+1,iCell) = pk-0.5_r8*dz(nVertLevels)*rhok*gravity !hydrostatic - pint (nVertLevels+1) = pintdry(nVertLevels+1,iCell) + 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 ! - rhodryk = zz(k,iCell) * rho_zz(k,iCell) - rhok = (1.0_r8+q(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)) + 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!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) + 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 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 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 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 integer, intent(in) :: nCells integer, intent(in) :: nVertLevels @@ -760,83 +831,75 @@ 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 - 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 + integer :: iCell, k, idx, idx_tmp + 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 + 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 - - character(len=16) :: name_out1,name_out2,name_out3,name_out4,name_out5 - - 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) - - 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 - - kinetic_energy = 0.0_r8 - potential_energy = 0.0_r8 - internal_energy = 0.0_r8 - water_vapor = 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) - rho_dz = (1.0_r8+q(index_qv,k,iCell))*rhod(k,iCell)*dz(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(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 - 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) - call outfld(name_out3,water_vapor ,ncells,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 + real(r8) :: sum_species + + 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 + ! + ! 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 - end do - call outfld(name_out4,liq,ncells,1) - end if - ! - ! 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 + 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 + 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) end do - end do - call outfld(name_out5,ice,ncells,1) - 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_dyn end module dp_coupling diff --git a/src/dynamics/mpas/dycore_budget.F90 b/src/dynamics/mpas/dycore_budget.F90 new file mode 100644 index 0000000000..18dd0e1375 --- /dev/null +++ b/src/dynamics/mpas/dycore_budget.F90 @@ -0,0 +1,407 @@ +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 +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 +!========================================================================================= + +subroutine print_budget(hstwr) + + 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 + 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 + logical, intent(in) :: hstwr(:) + + ! Local variables + character(len=*), parameter :: subname = 'dycore_budget: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) + + 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 + ! + ! 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 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_and_pdc_estimated_from_efix ! dEdt dycore and PDC errors (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 + 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 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 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 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 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,*)"======================================================================" + 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 : norm. diff = absolute normalized difference" + write(iulog,*)"FYI2: diff = difference (not normalized)" + 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,*) " " + if (diff>eps) then + write(iulog,*)"FAIL" + call endrun(subname//"dE/dt's in physics inconsistent") + end if + end do + 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,*)"Compare to dry mass adjustment in dynamics (xx=d,dy):" + 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),& + " ",dEdt_dme_adjust_dynE(i)," ",diff,pf + 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,*)" " + 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) = 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) = 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,*) " " + 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,*) "-------------------------------------------------------------------" + 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 estimated" + 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_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,*)" - 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 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 + ! + 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) /= 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 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,*)" " + 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 if + end do + ! + ! save dry-mass adjustment to avoid sampling error + ! + previous_dEdt_dry_mass_adjust = dEdt_dme_adjust_dynE(1) + 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/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index d4ff112434..7b27c4521e 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 @@ -39,8 +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 +use cam_budget, only: cam_budget_em_snapshot, cam_budget_em_register + implicit none private @@ -196,8 +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 - ! layer interface [dimensionless] (nver) - ! ! State that may be directly derived from dycore prognostic state ! @@ -316,6 +315,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 phys_control, only: phys_getopts + use cam_budget, only: thermo_budget_history + ! arguments: type(dyn_import_t), intent(inout) :: dyn_in type(dyn_export_t), intent(inout) :: dyn_out @@ -347,29 +349,21 @@ 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 + 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 ",& - " 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 ",& - "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 + !------------------------------------------------------- vc_dycore = vc_height if (masterproc) then @@ -536,40 +530,54 @@ 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) - 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)), gridname='mpas_cell') - end do - end do + ! + ! initialize history for MPAS energy budgets + + if (thermo_budget_history) then + ! Define energy/mass snapshots using stage structure + do istage = 1, num_stages + 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 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_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_register('dEdt_phys_total_in_dyn','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_in % mpas_from_cam_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) - 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_in % mpas_from_cam_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) - 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_in % mpas_from_cam_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) - 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 - -end subroutine dyn_init - + + end subroutine dyn_init + !========================================================================================= subroutine dyn_run(dyn_in, dyn_out) @@ -588,6 +596,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 !---------------------------------------------------------------------------- @@ -609,11 +618,10 @@ subroutine dyn_run(dyn_in, dyn_out) end subroutine dyn_run -!========================================================================================= 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. @@ -775,7 +783,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/mpas/dyn_grid.F90 b/src/dynamics/mpas/dyn_grid.F90 index c8efc66123..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 @@ -545,6 +546,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 +557,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 +587,11 @@ 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__)) + 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 +600,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/(4.0_r8*PI) 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 +625,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/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/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index 03132e8ccf..7dae784315 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: tot_energy_dyn ! 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 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) if (ierr /= 0) call endrun("dp_coupling: Allocate of frontgf failed.") @@ -377,9 +379,7 @@ 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 + 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) @@ -539,8 +539,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 - use air_composition, only: cpairv, rairv, cappav + 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 + 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 @@ -548,7 +550,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 @@ -560,7 +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 + integer :: m, i, k, ncol, m_cnst type(physics_buffer_desc), pointer :: pbuf_chnk(:) !---------------------------------------------------------------------------- @@ -602,13 +604,15 @@ subroutine derived_phys_dry(phys_state, phys_tend, pbuf2d) end do ! wet pressure variables (should be removed from physics!) - - 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 + 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 do k=1,nlev @@ -640,49 +644,51 @@ 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 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) 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._r8/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 , & 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 @@ -705,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) - 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/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..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): @@ -31,20 +30,14 @@ 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 - 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 de295da01a..843fd88bc7 100644 --- a/src/dynamics/se/dycore/global_norms_mod.F90 +++ b/src/dynamics/se/dycore/global_norms_mod.F90 @@ -24,26 +24,27 @@ 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 - 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, nelemd + use dimensions_mod, only: np use physconst, only: pi use parallel_mod, only: global_shared_buf, global_shared_sum 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) - - real (kind=r8) :: I_priv - real (kind=r8) :: I_shared - common /gblintcom/I_shared ! ! Local variables ! @@ -57,13 +58,12 @@ 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 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 @@ -71,28 +71,21 @@ 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 - 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 dimensions_mod, only: nc, nelemd 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) real (kind=r8) :: I_sphere(num_flds) - - real (kind=r8) :: I_priv - real (kind=r8) :: I_shared - common /gblintcom/I_shared ! ! Local variables ! @@ -105,12 +98,11 @@ 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 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 @@ -118,9 +110,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 @@ -133,24 +123,20 @@ end subroutine global_integrals_general ! ! ================================ ! -------------------------- - function global_integral(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, nelemd + use dimensions_mod, only: np use physconst, only: pi use parallel_mod, only: global_shared_buf, global_shared_sum 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 - real (kind=r8) :: I_priv - real (kind=r8) :: I_shared - common /gblintcom/I_shared - ! Local variables integer :: ie,j,i @@ -159,31 +145,69 @@ function global_integral(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 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 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 + end function global_integral_elem + + 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 + 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) :: fld(npts,npts,nets:nete) + type (hybrid_t) , intent(in) :: hybrid + + real (kind=r8) :: I_sphere + + ! Local variables + + integer :: ie,j,i + real(kind=r8) :: I_tmp(1) + + real (kind=r8) :: da + real (kind=r8) :: J_tmp(nets:nete) +! +! This algorithm is independent of thread count and task count. +! This is a requirement of consistancy checking in cam. +! + J_tmp = 0.0_r8 + 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*fld(i,j,ie) + end do + end do + end do + do ie=nets,nete + global_shared_buf(ie,1) = J_tmp(ie) + enddo + call wrap_repro_sum(nvars=1, comm=hybrid%par%comm) + I_tmp = global_shared_sum(1) + I_sphere = I_tmp(1)/(4.0_r8*PI) + + end function global_integral_fvm !------------------------------------------------------------------------------------ @@ -205,23 +229,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,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 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 @@ -241,14 +264,14 @@ 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,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 @@ -257,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 @@ -312,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 @@ -341,6 +364,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) @@ -351,16 +375,19 @@ 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 + ! 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..." 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))) @@ -716,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 @@ -753,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' @@ -792,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 @@ -807,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) @@ -822,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 @@ -930,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 @@ -1036,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 7f3ee98d68..c9f1ac194b 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(:) @@ -54,16 +54,15 @@ 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, 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(:) - 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 @@ -74,7 +73,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) @@ -123,22 +121,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) - 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 @@ -270,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 @@ -290,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 ! @@ -322,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 @@ -371,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 ! @@ -395,18 +387,16 @@ 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 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) ! @@ -426,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 calc_tot_energy_dynamics(elem,fvm,nets,nete,np1,np1_qdp,'p2d') - if (ntrac>0) deallocate(ftmp_fvm) + if (ftype==1.and.nsubstep==1) call tot_energy_dyn(elem,fvm,nets,nete,np1,np1_qdp,'p2d') + if (use_cslam) deallocate(ftmp_fvm) end subroutine applyCAMforcing @@ -446,11 +436,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: 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: 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 @@ -468,7 +458,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 @@ -489,16 +479,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 +503,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) @@ -554,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 @@ -606,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 @@ -616,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 @@ -676,10 +663,13 @@ 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=kbeg,kend + do k=ksponge_end,nlev + ! + ! only do "frictional heating" away from sponge + ! !OMP_COLLAPSE_SIMD !DIR_VECTOR_ALIGNED do j=1,np @@ -696,7 +686,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 ! @@ -771,7 +761,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) @@ -828,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 ! @@ -876,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 @@ -886,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 @@ -926,38 +916,40 @@ 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 - !$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) - ! - ! 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) + 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 + 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 - enddo + end if 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 @@ -983,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, ksponge_end + 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 @@ -992,12 +984,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 physconst, only: tref,cpair,gravit,lapse_rate - use time_mod, only : tevolve + use air_composition, only: get_cp_dry, get_R_dry + use physconst, only: tref,cpair,rga,lapse_rate implicit none integer, intent(in) :: np1,nm1,n0,nets,nete @@ -1028,9 +1018,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 +1041,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) @@ -1217,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 @@ -1274,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 @@ -1317,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 @@ -1328,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) @@ -1447,35 +1435,50 @@ 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) - use dimensions_mod, only: npsq,nlev,np,lcp_moist,nc,ntrac,qsize - use physconst, only: gravit, cpair, rearth, omega + 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: rga, 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 + use cam_thermo, only: get_dp, MASS_MIXING_RATIO,wvidx,wlidx,wiidx,seidx,keidx,moidx,mridx,ttidx,teidx, & + 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 + 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 dyn_tests_utils, only: vcoord=>vc_dry_pressure + use cam_budget, only: thermo_budget_history !------------------------------Arguments-------------------------------- - type (element_t) , intent(in) :: elem(:) - type(fvm_struct) , intent(in) :: fvm(:) + 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 !---------------------------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) + integer :: qidx(thermodynamic_active_species_num) real(kind=r8) :: cdp_fvm(nc,nc,nlev) - real(kind=r8) :: se_tmp - real(kind=r8) :: ke_tmp - real(kind=r8) :: ps(np,np) + real(kind=r8) :: cdp(np,np,nlev) + 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) @@ -1485,25 +1488,19 @@ 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) - integer :: ie,i,j,k + integer :: ie,i,j,k,m_cnst,nq,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 + 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 + 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 - 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.) @@ -1519,79 +1516,104 @@ 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 - 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),& + .false., cp, factor=1.0_r8/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 - + 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 + !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., & + se=se(:,j), po=po(:,j), ke=ke(:,j), wv=wv(:,j), liq=liq(:,j), ice=ice(:,j)) 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_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) ! ! 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,:) - call util_function(cdp_fvm,nc,nlev,name_out4,ie) - 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) - 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) - end if + 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) + end if + ! + ! sum over liquid water + ! + if (thermodynamic_active_species_liq_num>0) then + cdp_fvm = 0.0_r8 + 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_out(wlidx),ie) + end if + ! + ! sum over ice water + ! + if (thermodynamic_active_species_ice_num>0) then + cdp_fvm = 0.0_r8 + 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_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_out(ttidx),ie) + 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) + 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_out(ttidx),ie) + 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 + end do + ! + ! 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 @@ -1599,19 +1621,16 @@ 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 - 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 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 @@ -1624,17 +1643,17 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf end do end do end do - call outfld(name_out1 ,mr ,npsq,ie) - call outfld(name_out2 ,mo ,npsq,ie) + call outfld(name_out(mridx) ,mr ,npsq,ie) + call outfld(name_out(moidx) ,mo ,npsq,ie) end do - end if + endif ! if thermo budget history + end subroutine tot_energy_dyn - 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-------------------------------- @@ -1674,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 @@ -1692,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 @@ -1708,7 +1725,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 @@ -1723,7 +1739,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_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/dycore/prim_driver_mod.F90 b/src/dynamics/se/dycore/prim_driver_mod.F90 index 5ea869b53c..af22869f24 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 @@ -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 @@ -221,13 +221,13 @@ 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 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(:) @@ -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) @@ -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 new file mode 100644 index 0000000000..d2bfe0fceb --- /dev/null +++ b/src/dynamics/se/dycore_budget.F90 @@ -0,0 +1,528 @@ +module dycore_budget +use shr_kind_mod, only: r8=>shr_kind_r8 +implicit none + +public :: print_budget +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 +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 spmd_utils, only: masterproc + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + 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 + use control_mod, only: ftype + + ! arguments + logical, intent(in) :: hstwr(:) + + ! Local variables + character(len=*), parameter :: subname = 'dycore_budget: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) + + 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_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,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 + 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 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 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 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 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 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 + + 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 (specific to the SE dycore)" + write(iulog,*)"-----------------------------------------------------" + write(iulog,*)" " + 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) |" + 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(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,*) " " + if (diff>eps) then + write(iulog,*)"FAIL" + call endrun(subname//"dE/dt's in physics inconsistent") + end if + end do + 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) + if (.not.use_cslam) 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) = ",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 + end if + else + 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 + 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,*) "" + 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" + write(iulog,*) " " + 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 (using dynamics in physics energy; dyBF) the same?" + write(iulog,*) "" + if (.not.use_cslam) 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 (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 + + 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 (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 +! 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" + 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" + 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 + write(iulog,*)" " + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" SE dycore energy tendencies" + write(iulog,*)"------------------------------------------------------------" + write(iulog,*)" " + 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) ",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) ",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,...) ",dEdt_residual, " 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,*)thermo_budget_vars_descriptor(m_cnst) + write(iulog,*)"------------------------------" + 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 + ! + 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,*)" " + ! + ! detailed mass budget in dynamical core + ! + 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 + 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) ",dMdt_floating_dyn," Pa/m^2/s" + write(iulog,*)"dE/dt vertical remapping (dAR-dAD) ",dMdt_vert_remap + write(iulog,*)" " + write(iulog,*)"Breakdown of 2D dynamics:" + write(iulog,*)" " + 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 + write(iulog,*)"dMASS/dt residual (time truncation errors)",dMdt_residual," Pa/m^2/s" + end if + end if + if (is_cam_budget('dBD').and.is_cam_budget('dAF')) then + ! + ! check if mass change in physics is the same as dynamical core + ! + 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,*)" " + 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 + end do + ! + ! save adiabatic dycore dE/dt and dry-mass adjustment to avoid samping error + ! + previous_dEdt_adiabatic_dycore = dEdt_dycore_dyn + previous_dEdt_dry_mass_adjust = dEdt_dme_adjust_dynE(1) + 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/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index f0d42d6ed2..6504eb75cd 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 @@ -38,8 +38,8 @@ module dyn_comp use parallel_mod, only: par use hybrid_mod, only: hybrid_t -use dimensions_mod, only: nelemd, nlev, np, npsq, ntrac, nc, fv_nphys, & - qsize +use dimensions_mod, only: nelemd, nlev, np, npsq, ntrac, nc, fv_nphys +use dimensions_mod, only: qsize, use_cslam use element_mod, only: element_t, elem_state_t use fvm_control_volume_mod, only: fvm_struct use time_mod, only: nsplit @@ -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 @@ -106,13 +107,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 @@ -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 @@ -162,14 +160,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/ & @@ -209,14 +205,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 !-------------------------------------------------------------------------- @@ -284,14 +278,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 @@ -353,26 +345,26 @@ 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 ! Use finite volume physics grid and CSLAM for tracer advection nphys_pts = fv_nphys*fv_nphys qsize = thermodynamic_active_species_num ! number tracers advected by GLL - ntrac = pcnst ! number tracers advected by CSLAM + ntrac = pcnst ! number tracers advected by CSLAM + use_cslam = .true. else ! Use GLL grid for physics and tracer advection nphys_pts = npsq qsize = pcnst ntrac = 0 + use_cslam = .false. end if if (rsplit < 1) then @@ -431,7 +423,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 ! @@ -451,7 +442,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 @@ -584,7 +574,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,36 +585,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 cam_budget, only: cam_budget_em_snapshot, cam_budget_em_register, 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, num_vars = 8 - character (len = 3), dimension(num_stages) :: stage = (/"dED","dAF","dBD","dAD","dAR","dBF","dBH","dCH","dAH",'dBS','dAS','p2d'/) + integer, parameter :: num_stages = 12 + 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 @@ -639,28 +630,11 @@ 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 + + integer :: istage character (len=vc_str_lgth) :: vc_str - logical :: history_budget ! output tendencies and state variables for budgets + logical :: history_budget ! output tendencies and state variables for budgets integer :: budget_hfile_num character(len=*), parameter :: sub = 'dyn_init' @@ -678,7 +652,7 @@ subroutine dyn_init(dyn_in, dyn_out) allocate(kord_tr(qsize)) kord_tr(:) = vert_remap_tracer_alg - if (ntrac>0) then + if (use_cslam) then allocate(kord_tr_cslam(ntrac)) kord_tr_cslam(:) = vert_remap_tracer_alg end if @@ -696,7 +670,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 ! @@ -720,7 +694,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 @@ -734,7 +708,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 @@ -880,7 +854,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') @@ -902,7 +876,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 @@ -917,23 +891,43 @@ 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, 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') - else - call addfld (TRIM(ADJUSTL(str1)), horiz_only, 'A', TRIM(ADJUSTL(str3)),TRIM(ADJUSTL(str2)),gridname='GLL') - end if + if (thermo_budget_history) then + ! 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)))) end do - 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)" ) + call cam_budget_em_register('dEdt_vert_remap' ,'dAR','dAD','dyn','dif', & + 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)" ) + call cam_budget_em_register('dEdt_del4' ,'dCH','dBH','dyn','dif', & + 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)" ) + call cam_budget_em_register('dEdt_del4_tot' ,'dAH','dBH','dyn','dif', & + 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)" ) + ! + ! Register derived budgets + ! + call cam_budget_em_register('dEdt_dycore' ,'dEdt_floating_dyn','dEdt_vert_remap' ,'dyn','sum', & + 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" ) + 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)" ) + 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') @@ -961,7 +955,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 @@ -975,7 +968,7 @@ subroutine dyn_run(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 @@ -1078,7 +1071,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 @@ -1126,8 +1119,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 @@ -1157,7 +1148,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 @@ -1180,8 +1171,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(:) @@ -1193,9 +1184,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) @@ -1206,10 +1194,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 @@ -1701,7 +1685,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) @@ -1732,7 +1716,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 @@ -1754,7 +1738,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) @@ -2021,7 +2005,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 @@ -2300,7 +2283,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 77f3a27f2f..766fb893d7 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. @@ -733,6 +732,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 @@ -744,22 +744,40 @@ 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(:) ! 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 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(:) + + 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 !----------------------- @@ -777,16 +795,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)*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 @@ -832,6 +851,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 +869,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 +888,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. @@ -874,13 +898,14 @@ 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 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 +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)*rarea_unit_sphere k = k + 1 end do end do @@ -930,12 +956,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 +980,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 +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)*rarea_unit_sphere k = k + 1 end do end do @@ -1000,12 +1031,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/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/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/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)) diff --git a/src/infrastructure/phys_grid.F90 b/src/infrastructure/phys_grid.F90 index 505fdb0c26..3426c86f27 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 @@ -214,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) @@ -221,6 +224,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 +420,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*rarea_sphere + 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 f0131dab0e..580ffdf67f 100644 --- a/src/physics/cam/cam_diagnostics.F90 +++ b/src/physics/cam/cam_diagnostics.F90 @@ -13,8 +13,9 @@ 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, 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 @@ -46,6 +47,18 @@ module cam_diagnostics diag_physvar_ic, & nsurf +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 + " 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 @@ -176,46 +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 cam_budget, only: cam_budget_em_snapshot, cam_budget_em_register, thermo_budget_history type(physics_buffer_desc), pointer, intent(in) :: 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 "/) - + 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') @@ -242,7 +221,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 +365,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 @@ -412,22 +391,30 @@ 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' ) + if (thermo_budget_history) then + ! + ! energy diagnostics addflds for vars_stage combinations plus e_m_snapshots + ! + do istage = 1, num_stages + 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 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 subroutine diag_init_moist(pbuf2d) @@ -440,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 @@ -547,18 +534,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 +624,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 @@ -753,7 +719,6 @@ 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. @@ -934,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 @@ -954,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 @@ -1276,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 @@ -1294,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 @@ -1611,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: @@ -1973,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 @@ -2104,7 +2055,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 ) @@ -2144,7 +2095,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 +2110,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 +2142,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 +2166,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 +2181,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 +2190,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 4e55c3de58..7615f0e432 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -25,8 +25,8 @@ module check_energy use spmd_utils, only: masterproc use gmean_mod, only: gmean - use physconst, only: gravit, latvap, latice, cpair, rair - use air_composition, only: cpairv, rairv + 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 use time_manager, only: is_first_step @@ -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 @@ -221,7 +221,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, @@ -237,7 +237,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 - integer i,k ! column, level indices !----------------------------------------------------------------------- lchnk = state%lchnk @@ -250,17 +249,17 @@ 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 ! ! 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), & + vc_physics, ptop=state%pintdry(1:ncol,1), phis = state%phis(1:ncol),& te = state%te_ini(1:ncol,phys_te_idx), H2O = state%tw_ini(1:ncol,phys_te_idx)) ! ! Dynamical core total energy @@ -269,25 +268,41 @@ subroutine check_energy_timestep_init(state, tend, pbuf, col_type) state%z_ini(:ncol,:) = state%zm(:ncol,:) if (vc_dycore == vc_height) then ! - ! compute cv if vertical coordinate is height: cv = cp - R + ! MPAS specific hydrostatic energy computation (internal energy) ! if (state%psetcols == pcols) then - cp_or_cv(:,:) = cpairv(:,:,lchnk)-rairv(:,:,lchnk) + cp_or_cv(:ncol,:) = cp_or_cv_dycore(: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),& + 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, 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,:) = cp_or_cv_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_dycore, ps = state%ps(1:ncol), phis = state%phis(1:ncol), & - z_mid = state%z_ini(1:ncol,:), & + 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,:) @@ -309,7 +324,7 @@ end subroutine check_energy_timestep_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 !----------------------------------------------------------------------- @@ -351,12 +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(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,k ! column, level indices - integer :: ixcldice, ixcldliq ! CLDICE and CLDLIQ indices - integer :: ixrain, ixsnow ! RAINQM and SNOWQM indices - integer :: ixgrau ! GRAUQM index + integer i ! column index !----------------------------------------------------------------------- lchnk = state%lchnk @@ -373,12 +392,12 @@ 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), & - te = te, H2O = tw) - + vc_physics, ptop=state%pintdry(1:ncol,1), phis = state%phis(1:ncol), & + 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 @@ -447,20 +466,37 @@ 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,:) = cp_or_cv_dycore(: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),& + 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, 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,:) = cp_or_cv_dycore(:ncol,:,lchnk) + else + cp_or_cv(:ncol,:) = cpair + endif + ! + ! enthalpy scaling for energy consistency + ! + scaling(:ncol,:) = cpairv(:ncol,:,lchnk)/cp_or_cv_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_dycore, ps = state%ps(1:ncol), phis = state%phis(1:ncol), & - z_mid = state%z_ini(1:ncol,:), & + 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) @@ -472,7 +508,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 - 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 @@ -563,13 +598,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 + eshflx(i) = heat_glob * (state%pint(i,pver+1) - state%pint(i,1)) * rga end do -!!! if (nstep > 0) write(iulog,*) "heat", heat_glob, eshflx(1) return end subroutine check_energy_fix @@ -624,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 @@ -687,7 +720,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 @@ -713,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 @@ -785,12 +817,16 @@ 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_history, only: hist_fld_active, outfld - use dyn_tests_utils, only: vc_physics, vc_height + subroutine tot_energy_phys(state, outfld_name_suffix,vc) + 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 + use dyn_tests_utils, only: vc_physics, vc_height, vc_dry_pressure + use cam_abortutils, only: endrun + use cam_history_support, only: max_fieldname_len + use cam_budget, only: thermo_budget_history !------------------------------Arguments-------------------------------- type(physics_state), intent(inout) :: state @@ -799,6 +835,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) ! 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) @@ -817,88 +854,81 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix,vc) integer :: i,k ! column, level indices integer :: vc_loc ! local vertical coordinate variable integer :: ixtt ! test tracer index - 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 + if (.not.thermo_budget_history) return - lchnk = state%lchnk - ncol = state%ncol + do i=1,thermo_budget_num_vars + name_out(i)=trim(thermo_budget_vars(i))//'_'//trim(outfld_name_suffix) + end do - if (present(vc)) then - vc_loc = vc - else - vc_loc = vc_physics - end if + lchnk = state%lchnk + ncol = state%ncol - 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 (vc_loc == vc_height) then - scaling(:,:) = cpairv(:,:,lchnk)/cp_or_cv(:,:) !cp/cv scaling for temperature increment under constant volume + if (state%psetcols == pcols) then + if (vc_loc == vc_height .or. vc_loc == vc_dry_pressure) then + cp_or_cv(:ncol,:) = cp_or_cv_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('tot_energy_phys: energy diagnostics not implemented/tested for subcolumns') + end if - call get_hydrostatic_energy(state%q(1:ncol,1:pver,1:pcnst),& - 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) - - 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 .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 + ! 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_out(ttidx) == 'TT_pAM'.or.name_out(ttidx) == '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)*rga + 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)*rga + tt (i) = tt(i) + tt_tmp end do - end if + end do end if - - ! 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 ) end if + + 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 ) ! ! Axial angular momentum diagnostics ! @@ -912,32 +942,27 @@ 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) - - if ( hist_fld_active(name_out1).or.hist_fld_active(name_out2)) then - lchnk = state%lchnk - ncol = state%ncol - - mr_cnst = rearth**3/gravit - mo_cnst = omega*rearth**4/gravit - - mr = 0.0_r8 - mo = 0.0_r8 - do k = 1, pver - do i = 1, ncol + + mr_cnst = rga*rearth**3 + mo_cnst = rga*omega*rearth**4 + + mr = 0.0_r8 + mo = 0.0_r8 + do k = 1, pver + do i = 1, ncol cos_lat = cos(state%lat(i)) mr_tmp = mr_cnst*state%u(i,k)*state%pdel(i,k)*cos_lat mo_tmp = mo_cnst*state%pdel(i,k)*cos_lat**2 - + mr(i) = mr(i) + mr_tmp mo(i) = mo(i) + mo_tmp - end do - end do - call outfld(name_out1 ,mr, pcols,lchnk ) - call outfld(name_out2 ,mo, pcols,lchnk ) - end if - end subroutine calc_te_and_aam_budgets + end do + end do + + call outfld(name_out(mridx) ,mr, pcols,lchnk ) + call outfld(name_out(moidx) ,mo, pcols,lchnk ) + + end subroutine tot_energy_phys end module check_energy 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/geopotential.F90 b/src/physics/cam/geopotential.F90 index b06b145e51..93e99644ac 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( & @@ -132,7 +39,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 +53,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 +65,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 + ! !----------------------------------------------------------------------- ! @@ -175,40 +85,105 @@ subroutine geopotential_t( & zi(i,pverp) = 0.0_r8 end do -! 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 + ! Compute zi, zm from bottom up. + ! Note, zi(i,k) is the interface above zm(i,k) + + ! + ! 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 + 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) = piln(i,k+1) - piln(i,k) - hkk(i) = 1._r8 - pint(i,k) * hkl(i) * rpdel(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 (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) + end do end do - else!MPAS, SE or EUL + 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 + ! - ! For EUL and SE: pmid = 0.5*(pint(k+1)+pint(k)) - ! For MPAS : pmid is computed from theta_m, rhodry, etc. + ! 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 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) + 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 - + end do + end do + end if return end subroutine geopotential_t end module geopotential diff --git a/src/physics/cam/phys_control.F90 b/src/physics/cam/phys_control.F90 index 08962c816a..8d0cad7ee3 100644 --- a/src/physics/cam/phys_control.F90 +++ b/src/physics/cam/phys_control.F90 @@ -56,9 +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 - ! temperature, water vapor, cloud ice and cloud - ! liquid budgets. +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/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/physics_types.F90 b/src/physics/cam/physics_types.F90 index dcda2e8906..9b0c23d2ff 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 @@ -18,8 +18,6 @@ module physics_types implicit none private ! Make default type private to the module - logical, parameter :: adjust_te = .FALSE. - ! Public types: public physics_state @@ -210,10 +208,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 @@ -377,9 +376,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 !----------------------------------------------------------------------- @@ -426,7 +424,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 @@ -1192,7 +1190,10 @@ 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 + use dycore, only: dycore_is !----------------------------------------------------------------------- ! ! Purpose: Adjust the dry mass in each layer back to the value of physics input state @@ -1224,6 +1225,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----------------------------- @@ -1238,16 +1241,18 @@ 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 ! !----------------------------------------------------------------------- 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 @@ -1255,76 +1260,57 @@ subroutine physics_dme_adjust(state, tend, qini, 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 - ! 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 + ! + ! 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 - - 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) - 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 - + 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 + 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 + endif if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then zvirv(:,:) = shr_const_rwv / rairv(:,:,state%lchnk) - 1._r8 else 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 + !----------------------------------------------------------------------- !=============================================================================== @@ -1537,7 +1523,7 @@ end subroutine set_dry_to_wet subroutine physics_state_alloc(state,lchnk,psetcols) - use infnan, only : inf, assignment(=) + use infnan, only: inf, assignment(=) ! allocate the individual state components diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 244ac339f6..371cab1c13 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 @@ -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 @@ -109,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 @@ -122,7 +123,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 @@ -137,7 +138,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 @@ -208,6 +208,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 @@ -363,7 +365,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 +381,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 +711,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 @@ -753,14 +752,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 @@ -778,6 +776,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 cam_budget, only: cam_budget_init ! Input/output arguments type(physics_state), pointer :: phys_state(:) @@ -795,7 +794,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 - !----------------------------------------------------------------------- call physics_type_alloc(phys_state, phys_tend, begchunk, endchunk, pcols) @@ -981,6 +979,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 cam_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') @@ -1096,7 +1097,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(:) @@ -1121,10 +1121,6 @@ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out) call check_energy_gmean(phys_state, pbuf2d, ztodt, nstep) call t_stopf ('chk_en_gmean') - call t_stopf ('physpkg_st1') - - call t_startf ('physpkg_st1') - call pbuf_allocate(pbuf2d, 'physpkg') call diag_allocate() @@ -1208,7 +1204,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 @@ -1383,7 +1378,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 @@ -1397,14 +1392,17 @@ 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 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 + 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 ! @@ -1424,30 +1422,24 @@ 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 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) :: scaling(pcols,pver) logical :: moist_mixing_ratio_dycore ! physics buffer fields for total energy and mass adjustment @@ -1457,6 +1449,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 @@ -1491,6 +1485,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/)) @@ -1832,8 +1828,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 @@ -1864,7 +1860,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 @@ -1883,62 +1881,73 @@ subroutine tphysac (ztodt, cam_in, & call unicon_cam_org_diags(state, pbuf) 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 - - ! 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) + 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.& - (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 - tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) - tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver) - tmp_ps(:ncol) = state%ps(:ncol) - + 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, ztodt) - - 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) - state%ps(:ncol) = tmp_ps(:ncol) - end if - - if (moist_mixing_ratio_dycore) then - 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, 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,& - 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 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 -!!! 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 @@ -1963,8 +1972,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 ) @@ -2013,18 +2021,20 @@ 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 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 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 @@ -2093,6 +2103,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 @@ -2106,6 +2117,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 @@ -2154,8 +2167,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') @@ -2181,6 +2192,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/) ) @@ -2226,16 +2239,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) @@ -2246,6 +2259,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 ) @@ -2868,7 +2893,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 7ca40f8cf3..7452f9e115 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 @@ -195,6 +197,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 @@ -754,6 +758,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 cam_budget, only: cam_budget_init use phys_grid_ctem, only: phys_grid_ctem_init ! Input/output arguments @@ -943,6 +948,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 cam_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') @@ -1325,7 +1333,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 @@ -1368,6 +1376,10 @@ 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 + 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 ! @@ -1453,12 +1465,10 @@ 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) :: scaling(pcols,pver) logical :: moist_mixing_ratio_dycore ! physics buffer fields for total energy and mass adjustment @@ -1468,6 +1478,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 @@ -1503,6 +1515,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/)) @@ -2280,8 +2294,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 @@ -2311,61 +2325,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') - 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) + ! + ! 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.& - (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 - tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) - tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver) - tmp_ps(:ncol) = state%ps(:ncol) - + 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, ztodt) - - 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) - state%ps(:ncol) = tmp_ps(:ncol) - end if - - if (moist_mixing_ratio_dycore) then - 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, 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,& - 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 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 -!!! 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 @@ -2390,8 +2420,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 ) @@ -2435,12 +2464,14 @@ 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 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 @@ -2490,6 +2521,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 @@ -2500,6 +2532,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 @@ -2564,6 +2598,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/) ) @@ -2610,8 +2646,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) @@ -2620,8 +2656,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) @@ -2632,6 +2668,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/simple/physpkg.F90 b/src/physics/simple/physpkg.F90 index 353c245318..9c1e4c61bf 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. @@ -117,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 @@ -198,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 cam_budget, only: cam_budget_init ! Input/output arguments type(physics_state), pointer :: phys_state(:) @@ -267,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 cam_budget_init() + end subroutine phys_init !====================================================================================== @@ -469,9 +477,12 @@ 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 + 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 ! real(r8), intent(in) :: ztodt ! Two times model timestep (2 delta-t) @@ -492,20 +503,24 @@ 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 - integer :: ncol + integer :: ncol, lchnk integer :: itim_old logical :: moist_mixing_ratio_dycore 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 ncol = state%ncol + lchnk = state%lchnk ! Associate pointers with physics buffer fields itim_old = pbuf_old_tim_idx() @@ -518,11 +533,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 !========================= @@ -534,17 +555,19 @@ 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 ! 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) @@ -561,44 +584,59 @@ 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.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 - tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst) - tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver) - tmp_ps(:ncol) = state%ps(:ncol) + 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 ! - ! 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 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, ztodt) - - 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) - state%ps(:ncol) = tmp_ps(:ncol) - end if - - if (moist_mixing_ratio_dycore) then - 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 physics_dme_adjust(state, tend, qini, totliqini, toticeini, ztodt) + call tot_energy_phys(state, 'phAM') + 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 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 @@ -609,13 +647,15 @@ 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) if (.not. moist_physics) then deallocate(cldliqini) deallocate(cldiceini) + deallocate(totliqini) + deallocate(toticeini) end if end subroutine tphysac @@ -647,7 +687,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 @@ -656,6 +696,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 @@ -676,12 +718,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 @@ -709,6 +754,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 @@ -733,8 +780,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') @@ -747,8 +794,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) @@ -764,8 +811,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 367f52811a..6046ffebf1 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 @@ -10,7 +11,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 @@ -102,7 +105,9 @@ 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: enthalpy or internal energy scaling factor for + ! energy consistency + real(r8), public, protected, allocatable :: cp_or_cv_dycore(:,:,:) ! ! Interfaces for public routines interface get_cp_dry @@ -230,7 +235,6 @@ subroutine air_composition_init() use physconst, only: r_universal, cpair, rair, cpwv, rh2o, cpliq, cpice, mwdry use constituents, only: cnst_get_ind, cnst_mw use ppgrid, only: pcols, pver, begchunk, endchunk - integer :: icnst, ix, isize, ierr, idx integer :: liq_num, ice_num integer :: liq_idx(water_species_in_air_num) @@ -330,6 +334,10 @@ subroutine air_composition_init() if (ierr /= 0) then call endrun(errstr//"mbarv") end if + allocate(cp_or_cv_dycore(pcols,pver,begchunk:endchunk), stat=ierr) + if (ierr /= 0) then + call endrun(errstr//"cp_or_cv_dycore") + end if thermodynamic_active_species_idx = -HUGE(1) thermodynamic_active_species_idx_dycore = -HUGE(1) @@ -620,27 +628,63 @@ 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 + !=========================================================================== + !--------------------------------------------------------------------------- + ! water_composition_update: Update generalized cp or cv depending on dycore + !--------------------------------------------------------------------------- + !=========================================================================== + + 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 + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: vcoord + real(r8), optional, intent(in) :: 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, & + active_species_idx_dycore=thermodynamic_active_species_idx,cpdry=cpairv(:ncol,:,lchnk)) + else if (vcoord==vc_height) then + 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) + 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 + end subroutine water_composition_update !=========================================================================== !*************************************************************************** @@ -750,29 +794,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 +836,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 +898,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 @@ -955,9 +1017,10 @@ 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) use cam_abortutils, only: endrun use string_utils, only: int2str + use physconst, only: rair ! Dummy arguments ! tracer: !tracer array @@ -968,6 +1031,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 @@ -986,12 +1050,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 @@ -1046,7 +1117,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 diff --git a/src/utils/cam_grid_support.F90 b/src/utils/cam_grid_support.F90 index 30ffe78576..d86c829e77 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_areawt interface cam_grid_attribute_register module procedure add_cam_grid_attribute_0d_int @@ -1616,6 +1618,59 @@ function cam_grid_get_lonvals(id) result(lonvals) end if end function cam_grid_get_lonvals + function cam_grid_get_areawt(id) result(wtvals) + + ! Dummy argument + integer, intent(in) :: id + real(r8), pointer :: wtvals(:) + + ! Local variables + character(len=max_chars) :: wtname + integer :: gridind + class(cam_grid_attribute_t), pointer :: attrptr + character(len=120) :: errormsg + + nullify(attrptr) + gridind = get_cam_grid_index(id) + if (gridind > 0) then + 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') + wtname='areawt' + case('FVM') + wtname='area_weight_fvm' + case('mpas_cell') + wtname='area_weight_mpas' + case default + call endrun('cam_grid_get_areawt: Invalid gridname:'//trim(cam_grids(gridind)%name)) + end select + + call find_cam_grid_attr(gridind, trim(wtname), attrptr) + if (.not.associated(attrptr)) then + write(errormsg, '(4a)') & + '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) + wtvals => attrptr%values + class default + call endrun('cam_grid_get_areawt: wt attribute is not a real datatype') + end select + end if + end if + + 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 subroutine cam_grid_get_coords(id, beg, end, blk, lon, lat) @@ -2125,7 +2180,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 @@ -2172,7 +2226,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 @@ -2335,7 +2388,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 @@ -2414,14 +2466,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 @@ -2448,7 +2499,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 @@ -2456,7 +2507,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 @@ -2486,7 +2536,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 @@ -2494,7 +2544,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 @@ -2999,7 +3048,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 @@ -3880,8 +3929,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 eaea52f328..f65649c4ef 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 @@ -18,6 +17,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 +33,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_dry_air_update: Update dry air composition dependent properties + public :: cam_thermo_dry_air_update + ! cam_thermo_water_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 @@ -170,6 +172,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 (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 + 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 !=========================================================================== @@ -177,7 +211,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" @@ -202,48 +235,65 @@ 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_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_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_moist_factor(:,:) + real(r8), optional, intent(in) :: to_dry_factor(:,:)!if mmr moist convert ! !---------------------------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 + ! + !*************************************************************************** + ! + ! 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 + !------------------------------------------------------------------------- + + !------------------------------Arguments---------------------------------- + + 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(:,:) + ! + logical :: lcp - end subroutine cam_thermo_update + call water_composition_update(mmr, lchnk, ncol, vcoord, to_dry_factor=to_dry_factor) + end subroutine cam_thermo_water_update !=========================================================================== @@ -687,7 +737,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) @@ -1258,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 @@ -1334,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) * & @@ -1396,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 @@ -1523,20 +1575,23 @@ 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, & - wv, H2O, liq, ice) + subroutine get_hydrostatic_energy_1hd(tracer, moist_mixing_ratio, pdel_in, & + cp_or_cv, U, V, T, vcoord, ptop, 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 use air_composition, only: wv_idx - use physconst, only: gravit, latvap, latice + use physconst, only: rga, latvap, latice ! 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(:,:) @@ -1544,7 +1599,7 @@ subroutine get_hydrostatic_energy_1hd(tracer, pdel, cp_or_cv, U, V, T, & real(r8), intent(in) :: V(:,:) real(r8), intent(in) :: T(:,:) integer, intent(in) :: vcoord ! vertical coordinate - real(r8), intent(in), optional :: ps(:) + real(r8), intent(in), optional :: ptop(:) real(r8), intent(in), optional :: phis(:) real(r8), intent(in), optional :: z_mid(:,:) ! dycore_idx: use dycore index for thermodynamic active species @@ -1557,8 +1612,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 energy (z coordinate) + real(r8), intent(out), optional :: po (:) ! WV: vertically integrated water vapor real(r8), intent(out), optional :: wv (:) ! liq: vertically integrated liquid @@ -1568,10 +1627,12 @@ 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 + real(r8) :: pdel(SIZE(tracer, 1),SIZE(tracer, 2)) !moist pressure level thickness real(r8) :: latsub ! latent heat of sublimation integer :: ierr @@ -1618,51 +1679,56 @@ 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 = dry_air_species_num+1, thermodynamic_active_species_num + pdel(:,:) = pdel(:,:) + pdel_in(:, :)*tracer(:,:,species_idx(qdx)) + end do + end if + + ke_vint = 0._r8 + se_vint = 0._r8 select case (vcoord) case(vc_moist_pressure, vc_dry_pressure) - if ((.not. present(ps)) .or. (.not. present(phis))) then - write(iulog, *) subname, ' ps and phis must be present for ', & + if (.not. present(ptop).or. (.not. present(phis))) then + write(iulog, *) subname, ' ptop and phis must be present for ', & 'moist/dry pressure vertical coordinate' - call endrun(subname//': ps and phis must be present for '// & + call endrun(subname//': ptop and phis must be present for '// & 'moist/dry pressure vertical coordinate') end if - ke_vint = 0._r8 - se_vint = 0._r8 - wv_vint = 0._r8 + po_vint = ptop 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) - wv_vint(idx) = wv_vint(idx) + (tracer(idx, kdx, wvidx) * & - 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) - se_vint(idx) = se_vint(idx) + (phis(idx) * ps(idx) / gravit) + po_vint(idx) = (phis(idx) * po_vint(idx) * rga) 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)) then + write(iulog, *) subname, ' phis must be present for ', & + 'heigt-based vertical coordinate' + call endrun(subname//': phis must be present for '// & + 'height-based vertical coordinate') end if - ke_vint = 0._r8 - se_vint = 0._r8 - wv_vint = 0._r8 + po_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) + 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 - se_vint(idx) = se_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) + po_vint(idx) = po_vint(idx) + (z_mid(idx, kdx) + & + phis(idx) * rga) * pdel(idx, kdx) end do end do case default @@ -1670,26 +1736,39 @@ 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 - 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) * rga) + 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) * & - tracer(idx, kdx, species_liq_idx(qdx)) / gravit) + liq_vint(idx) = liq_vint(idx) + (pdel(idx, kdx) * & + tracer(idx, kdx, species_liq_idx(qdx)) * rga) end do end do end do @@ -1703,7 +1782,7 @@ subroutine get_hydrostatic_energy_1hd(tracer, pdel, cp_or_cv, U, V, T, & 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 @@ -1731,9 +1810,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 subroutine get_hydrostatic_energy_1hd end module cam_thermo