From 7fac3a9edffee7b18f885b49aee86fb244a3d369 Mon Sep 17 00:00:00 2001 From: Kuan-Chih Wang Date: Wed, 11 Sep 2024 11:17:25 -0600 Subject: [PATCH 01/27] Sort `use` statements and adjust indentation --- src/dynamics/mpas/stepon.F90 | 97 ++++++++++++++++++------------------ 1 file changed, 49 insertions(+), 48 deletions(-) diff --git a/src/dynamics/mpas/stepon.F90 b/src/dynamics/mpas/stepon.F90 index 9d53ca43..7dfdbc23 100644 --- a/src/dynamics/mpas/stepon.F90 +++ b/src/dynamics/mpas/stepon.F90 @@ -1,9 +1,12 @@ module stepon - use camsrfexch, only: cam_out_t - use dyn_comp, only: dyn_import_t, dyn_export_t + ! Modules from CAM-SIMA. + use camsrfexch, only: cam_out_t + use dyn_comp, only: dyn_import_t, dyn_export_t use physics_types, only: physics_state, physics_tend - use runtime_obj, only: runtime_options - use shr_kind_mod, only: r8 => shr_kind_r8 + use runtime_obj, only: runtime_options + + ! Modules from CESM Share. + use shr_kind_mod, only: kind_r8 => shr_kind_r8 implicit none @@ -15,48 +18,46 @@ module stepon public :: stepon_run3 public :: stepon_final contains - -! Called by `cam_init` in `src/control/cam_comp.F90`. -subroutine stepon_init(cam_runtime_opts, dyn_in, dyn_out) - type(runtime_options), intent(in) :: cam_runtime_opts - type(dyn_import_t), intent(in) :: dyn_in - type(dyn_export_t), intent(in) :: dyn_out -end subroutine stepon_init - -! Called by `cam_timestep_init` in `src/control/cam_comp.F90`. -subroutine stepon_timestep_init(dtime_phys, cam_runtime_opts, phys_state, phys_tend, dyn_in, dyn_out) - real(r8), intent(out) :: dtime_phys - type(runtime_options), intent(in) :: cam_runtime_opts - type(physics_state), intent(inout) :: phys_state - type(physics_tend), intent(inout) :: phys_tend - type(dyn_import_t), intent(inout) :: dyn_in - type(dyn_export_t), intent(inout) :: dyn_out -end subroutine stepon_timestep_init - -! Called by `cam_run2` in `src/control/cam_comp.F90`. -subroutine stepon_run2(cam_runtime_opts, phys_state, phys_tend, dyn_in, dyn_out) - type(runtime_options), intent(in) :: cam_runtime_opts - type(physics_state), intent(inout) :: phys_state - type(physics_tend), intent(inout) :: phys_tend - type(dyn_import_t), intent(inout) :: dyn_in - type(dyn_export_t), intent(inout) :: dyn_out -end subroutine stepon_run2 - -! Called by `cam_run3` in `src/control/cam_comp.F90`. -subroutine stepon_run3(dtime_phys, cam_runtime_opts, cam_out, phys_state, dyn_in, dyn_out) - real(r8), intent(in) :: dtime_phys - type(runtime_options), intent(in) :: cam_runtime_opts - type(cam_out_t), intent(inout) :: cam_out - type(physics_state), intent(inout) :: phys_state - type(dyn_import_t), intent(inout) :: dyn_in - type(dyn_export_t), intent(inout) :: dyn_out -end subroutine stepon_run3 - -! Called by `cam_final` in `src/control/cam_comp.F90`. -subroutine stepon_final(cam_runtime_opts, dyn_in, dyn_out) - type(runtime_options), intent(in) :: cam_runtime_opts - type(dyn_import_t), intent(inout) :: dyn_in - type(dyn_export_t), intent(inout) :: dyn_out -end subroutine stepon_final - + ! Called by `cam_init` in `src/control/cam_comp.F90`. + subroutine stepon_init(cam_runtime_opts, dyn_in, dyn_out) + type(runtime_options), intent(in) :: cam_runtime_opts + type(dyn_import_t), intent(in) :: dyn_in + type(dyn_export_t), intent(in) :: dyn_out + end subroutine stepon_init + + ! Called by `cam_timestep_init` in `src/control/cam_comp.F90`. + subroutine stepon_timestep_init(dtime_phys, cam_runtime_opts, phys_state, phys_tend, dyn_in, dyn_out) + real(kind_r8), intent(out) :: dtime_phys + type(runtime_options), intent(in) :: cam_runtime_opts + type(physics_state), intent(inout) :: phys_state + type(physics_tend), intent(inout) :: phys_tend + type(dyn_import_t), intent(inout) :: dyn_in + type(dyn_export_t), intent(inout) :: dyn_out + end subroutine stepon_timestep_init + + ! Called by `cam_run2` in `src/control/cam_comp.F90`. + subroutine stepon_run2(cam_runtime_opts, phys_state, phys_tend, dyn_in, dyn_out) + type(runtime_options), intent(in) :: cam_runtime_opts + type(physics_state), intent(inout) :: phys_state + type(physics_tend), intent(inout) :: phys_tend + type(dyn_import_t), intent(inout) :: dyn_in + type(dyn_export_t), intent(inout) :: dyn_out + end subroutine stepon_run2 + + ! Called by `cam_run3` in `src/control/cam_comp.F90`. + subroutine stepon_run3(dtime_phys, cam_runtime_opts, cam_out, phys_state, dyn_in, dyn_out) + real(kind_r8), intent(in) :: dtime_phys + type(runtime_options), intent(in) :: cam_runtime_opts + type(cam_out_t), intent(inout) :: cam_out + type(physics_state), intent(inout) :: phys_state + type(dyn_import_t), intent(inout) :: dyn_in + type(dyn_export_t), intent(inout) :: dyn_out + end subroutine stepon_run3 + + ! Called by `cam_final` in `src/control/cam_comp.F90`. + subroutine stepon_final(cam_runtime_opts, dyn_in, dyn_out) + type(runtime_options), intent(in) :: cam_runtime_opts + type(dyn_import_t), intent(inout) :: dyn_in + type(dyn_export_t), intent(inout) :: dyn_out + end subroutine stepon_final end module stepon From be3cef986250802e2bc433b5d495e51d8a4499ea Mon Sep 17 00:00:00 2001 From: Kuan-Chih Wang Date: Mon, 24 Jun 2024 11:55:48 -0600 Subject: [PATCH 02/27] Implement MPAS subdriver MPAS dynamical core can now integrate the dynamical states with time. --- .../mpas/driver/dyn_mpas_subdriver.F90 | 121 +++++++++++++++++- 1 file changed, 116 insertions(+), 5 deletions(-) diff --git a/src/dynamics/mpas/driver/dyn_mpas_subdriver.F90 b/src/dynamics/mpas/driver/dyn_mpas_subdriver.F90 index f6bb502e..72643196 100644 --- a/src/dynamics/mpas/driver/dyn_mpas_subdriver.F90 +++ b/src/dynamics/mpas/driver/dyn_mpas_subdriver.F90 @@ -21,7 +21,7 @@ module dyn_mpas_subdriver pio_inq_varid, pio_inq_varndims, pio_inq_vartype, pio_noerr ! Modules from MPAS. - use atm_core, only: atm_mpas_init_block + use atm_core, only: atm_compute_output_diagnostics, atm_do_timestep, atm_mpas_init_block use atm_core_interface, only: atm_setup_core, atm_setup_domain use atm_time_integration, only: mpas_atm_dynamics_init use mpas_atm_dimensions, only: mpas_atm_set_dims @@ -34,7 +34,7 @@ module dyn_mpas_subdriver mpas_pool_type, mpas_pool_field_info_type, & mpas_pool_character, mpas_pool_real, mpas_pool_integer, & mpas_stream_type, mpas_stream_noerr, & - mpas_time_type, mpas_start_time, & + mpas_time_type, mpas_timeinterval_type, mpas_now, mpas_start_time, & mpas_io_native_precision, mpas_io_pnetcdf, mpas_io_read, mpas_io_write, & field0dchar, field1dchar, & field0dinteger, field1dinteger, field2dinteger, field3dinteger, & @@ -51,11 +51,13 @@ module dyn_mpas_subdriver mpas_pool_get_array, & mpas_pool_add_dimension, mpas_pool_get_dimension, & mpas_pool_get_field, mpas_pool_get_field_info, & - mpas_pool_initialize_time_levels + mpas_pool_initialize_time_levels, mpas_pool_shift_time_levels use mpas_stream_inquiry, only: mpas_stream_inquiry_new_streaminfo use mpas_stream_manager, only: postread_reindex, prewrite_reindex, postwrite_reindex use mpas_string_utils, only: mpas_string_replace - use mpas_timekeeping, only: mpas_get_clock_time, mpas_get_time + use mpas_timekeeping, only: mpas_advance_clock, mpas_get_clock_time, mpas_get_time, & + mpas_set_timeinterval, & + operator(+), operator(<) use mpas_vector_operations, only: mpas_initialize_vectors implicit none @@ -106,7 +108,8 @@ end subroutine model_error_if logical, allocatable :: is_water_species(:) ! Initialized by `dyn_mpas_init_phase4`. - integer :: coupling_time_interval + integer :: coupling_time_interval = 0 + integer :: number_of_time_steps = 0 contains private @@ -123,6 +126,7 @@ end subroutine model_error_if procedure, pass, public :: compute_unit_vector => dyn_mpas_compute_unit_vector procedure, pass, public :: compute_edge_wind => dyn_mpas_compute_edge_wind procedure, pass, public :: init_phase4 => dyn_mpas_init_phase4 + procedure, pass, public :: run => dyn_mpas_run ! Accessor subroutines for users to access internal states of MPAS dynamical core. @@ -2673,6 +2677,7 @@ subroutine dyn_mpas_init_phase4(self, coupling_time_interval) end if self % coupling_time_interval = coupling_time_interval + self % number_of_time_steps = 0 call self % debug_print('Coupling time interval is ' // stringify([real(self % coupling_time_interval, rkind)]) // & ' seconds') @@ -2867,6 +2872,112 @@ pure function almost_equal(a, b, absolute_tolerance, relative_tolerance) end function almost_equal end subroutine dyn_mpas_init_phase4 + !------------------------------------------------------------------------------- + ! subroutine dyn_mpas_run + ! + !> \brief Integrates the dynamical states with time + !> \author Michael Duda + !> \date 29 February 2020 + !> \details + !> This subroutine calls MPAS dynamical solver in a loop, with each iteration + !> of the loop advancing the dynamical states forward by one time step, until + !> the coupling time interval is reached. + !> Essentially, it closely follows what is done in `atm_core_run`, but without + !> any calls to MPAS diagnostics manager or MPAS stream manager. + !> \addenda + !> Ported and refactored for CAM-SIMA. (KCW, 2024-06-21) + ! + !------------------------------------------------------------------------------- + subroutine dyn_mpas_run(self) + class(mpas_dynamical_core_type), intent(inout) :: self + + character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_run' + character(strkind) :: date_time + integer :: ierr + real(rkind), pointer :: config_dt + type(mpas_pool_type), pointer :: mpas_pool_diag, mpas_pool_mesh, mpas_pool_state + type(mpas_time_type) :: mpas_time_end, mpas_time_now ! This derived type is analogous to `ESMF_Time`. + type(mpas_timeinterval_type) :: mpas_time_interval ! This derived type is analogous to `ESMF_TimeInterval`. + + call self % debug_print(subname // ' entered') + + nullify(config_dt) + nullify(mpas_pool_diag, mpas_pool_mesh, mpas_pool_state) + + call self % get_variable_pointer(config_dt, 'cfg', 'config_dt') + call self % get_pool_pointer(mpas_pool_diag, 'diag') + call self % get_pool_pointer(mpas_pool_mesh, 'mesh') + call self % get_pool_pointer(mpas_pool_state, 'state') + + mpas_time_now = mpas_get_clock_time(self % domain_ptr % clock, mpas_now, ierr=ierr) + + if (ierr /= 0) then + call self % model_error('Failed to get time for "mpas_now"', subname, __LINE__) + end if + + call mpas_get_time(mpas_time_now, datetimestring=date_time, ierr=ierr) + + if (ierr /= 0) then + call self % model_error('Failed to get time for "mpas_now"', subname, __LINE__) + end if + + call self % debug_print('Time integration of MPAS dynamical core begins at ' // trim(adjustl(date_time))) + + call mpas_set_timeinterval(mpas_time_interval, s=self % coupling_time_interval, ierr=ierr) + + if (ierr /= 0) then + call self % model_error('Failed to set coupling time interval', subname, __LINE__) + end if + + ! The `+` operator is overloaded here. + mpas_time_end = mpas_time_now + mpas_time_interval + + ! Integrate until the coupling time interval is reached. + ! The `<` operator is overloaded here. + do while (mpas_time_now < mpas_time_end) + ! Number of time steps that has been completed in this MPAS dynamical core instance. + self % number_of_time_steps = self % number_of_time_steps + 1 + + ! Advance the dynamical states forward in time by `config_dt` seconds. + ! Current states are in time level 1. Upon exit, time level 2 will contain updated states. + call atm_do_timestep(self % domain_ptr, config_dt, self % number_of_time_steps) + + ! MPAS `state` pool has two time levels. + ! Swap them after advancing a time step. + call mpas_pool_shift_time_levels(mpas_pool_state) + + call mpas_advance_clock(self % domain_ptr % clock, ierr=ierr) + + if (ierr /= 0) then + call self % model_error('Failed to advance clock', subname, __LINE__) + end if + + mpas_time_now = mpas_get_clock_time(self % domain_ptr % clock, mpas_now, ierr=ierr) + + if (ierr /= 0) then + call self % model_error('Failed to get time for "mpas_now"', subname, __LINE__) + end if + + call self % debug_print('Time step ' // stringify([self % number_of_time_steps]) // ' completed') + end do + + call mpas_get_time(mpas_time_now, datetimestring=date_time, ierr=ierr) + + if (ierr /= 0) then + call self % model_error('Failed to get time for "mpas_now"', subname, __LINE__) + end if + + call self % debug_print('Time integration of MPAS dynamical core ends at ' // trim(adjustl(date_time))) + + ! Compute diagnostic variables like `pressure`, `rho` and `theta` by calling upstream MPAS functionality. + call atm_compute_output_diagnostics(mpas_pool_state, 1, mpas_pool_diag, mpas_pool_mesh) + + nullify(config_dt) + nullify(mpas_pool_diag, mpas_pool_mesh, mpas_pool_state) + + call self % debug_print(subname // ' completed') + end subroutine dyn_mpas_run + !------------------------------------------------------------------------------- ! function dyn_mpas_get_constituent_name ! From 6cfeab03aa8764031a02849c34776cfc450dffff Mon Sep 17 00:00:00 2001 From: Kuan-Chih Wang Date: Tue, 10 Sep 2024 14:17:25 -0600 Subject: [PATCH 03/27] Support for computing edge wind tendency in MPAS subdriver This functionality is intended for use by dynamics-physics coupling. --- .../mpas/driver/dyn_mpas_subdriver.F90 | 53 +++++++++++++++---- src/dynamics/mpas/dyn_comp.F90 | 2 +- 2 files changed, 44 insertions(+), 11 deletions(-) diff --git a/src/dynamics/mpas/driver/dyn_mpas_subdriver.F90 b/src/dynamics/mpas/driver/dyn_mpas_subdriver.F90 index 72643196..eb1ad3c4 100644 --- a/src/dynamics/mpas/driver/dyn_mpas_subdriver.F90 +++ b/src/dynamics/mpas/driver/dyn_mpas_subdriver.F90 @@ -42,6 +42,7 @@ module dyn_mpas_subdriver use mpas_dmpar, only: mpas_dmpar_exch_halo_field, & mpas_dmpar_max_int, mpas_dmpar_sum_int use mpas_domain_routines, only: mpas_allocate_domain + use mpas_field_routines, only: mpas_allocate_scratch_field use mpas_framework, only: mpas_framework_init_phase1, mpas_framework_init_phase2 use mpas_io_streams, only: mpas_createstream, mpas_closestream, mpas_streamaddfield, & mpas_readstream, mpas_writestream, mpas_writestreamatt @@ -2529,19 +2530,21 @@ end subroutine dyn_mpas_compute_unit_vector !> \date 16 January 2020 !> \details !> This subroutine computes the edge-normal wind vectors at edge points - !> (i.e., `u` in MPAS `state` pool) from wind components at cell points + !> (i.e., `u` in MPAS `state` pool) from the wind components at cell points !> (i.e., `uReconstruct{Zonal,Meridional}` in MPAS `diag` pool). In MPAS, the !> former are PROGNOSTIC variables, while the latter are DIAGNOSTIC variables !> that are "reconstructed" from the former. This subroutine is essentially the !> inverse function of that reconstruction. The purpose is to provide an !> alternative way for MPAS to initialize from zonal and meridional wind - !> components at cell points. + !> components at cell points. If `wind_tendency` is `.true.`, this subroutine + !> operates on the wind tendency due to physics instead. !> \addenda !> Ported and refactored for CAM-SIMA. (KCW, 2024-05-08) ! !------------------------------------------------------------------------------- - subroutine dyn_mpas_compute_edge_wind(self) + subroutine dyn_mpas_compute_edge_wind(self, wind_tendency) class(mpas_dynamical_core_type), intent(in) :: self + logical, intent(in) :: wind_tendency character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_compute_edge_wind' integer :: cell1, cell2, i @@ -2565,14 +2568,24 @@ subroutine dyn_mpas_compute_edge_wind(self) nullify(uedge) ! Make sure halo layers are up-to-date before computation. - call self % exchange_halo('uReconstructZonal') - call self % exchange_halo('uReconstructMeridional') + if (wind_tendency) then + call self % exchange_halo('tend_uzonal') + call self % exchange_halo('tend_umerid') + else + call self % exchange_halo('uReconstructZonal') + call self % exchange_halo('uReconstructMeridional') + end if ! Input. call self % get_variable_pointer(nedges, 'dim', 'nEdges') - call self % get_variable_pointer(ucellzonal, 'diag', 'uReconstructZonal') - call self % get_variable_pointer(ucellmeridional, 'diag', 'uReconstructMeridional') + if (wind_tendency) then + call self % get_variable_pointer(ucellzonal, 'tend_physics', 'tend_uzonal') + call self % get_variable_pointer(ucellmeridional, 'tend_physics', 'tend_umerid') + else + call self % get_variable_pointer(ucellzonal, 'diag', 'uReconstructZonal') + call self % get_variable_pointer(ucellmeridional, 'diag', 'uReconstructMeridional') + end if call self % get_variable_pointer(cellsonedge, 'mesh', 'cellsOnEdge') call self % get_variable_pointer(east, 'mesh', 'east') @@ -2580,7 +2593,11 @@ subroutine dyn_mpas_compute_edge_wind(self) call self % get_variable_pointer(edgenormalvectors, 'mesh', 'edgeNormalVectors') ! Output. - call self % get_variable_pointer(uedge, 'state', 'u', time_level=1) + if (wind_tendency) then + call self % get_variable_pointer(uedge, 'tend_physics', 'tend_ru_physics') + else + call self % get_variable_pointer(uedge, 'state', 'u', time_level=1) + end if do i = 1, nedges cell1 = cellsonedge(1, i) @@ -2611,7 +2628,11 @@ subroutine dyn_mpas_compute_edge_wind(self) nullify(uedge) ! Make sure halo layers are up-to-date after computation. - call self % exchange_halo('u') + if (wind_tendency) then + call self % exchange_halo('tend_ru_physics') + else + call self % exchange_halo('u') + end if call self % debug_print(subname // ' completed') end subroutine dyn_mpas_compute_edge_wind @@ -2644,6 +2665,7 @@ subroutine dyn_mpas_init_phase4(self, coupling_time_interval) logical, pointer :: config_do_restart real(rkind), pointer :: config_dt type(field0dreal), pointer :: field_0d_real + type(field2dreal), pointer :: field_2d_real type(mpas_pool_type), pointer :: mpas_pool type(mpas_time_type) :: mpas_time @@ -2655,6 +2677,7 @@ subroutine dyn_mpas_init_phase4(self, coupling_time_interval) nullify(config_do_restart) nullify(config_dt) nullify(field_0d_real) + nullify(field_2d_real) nullify(mpas_pool) if (coupling_time_interval <= 0) then @@ -2819,6 +2842,16 @@ subroutine dyn_mpas_init_phase4(self, coupling_time_interval) ! Prepare dynamics for time integration. call mpas_atm_dynamics_init(self % domain_ptr) + ! Some additional "scratch" fields are needed for interoperability with CAM-SIMA, but they are not initialized by + ! `mpas_atm_dynamics_init`. Initialize them below. + call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, 'tend_uzonal', field_2d_real, timelevel=1) + call mpas_allocate_scratch_field(field_2d_real) + nullify(field_2d_real) + + call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, 'tend_umerid', field_2d_real, timelevel=1) + call mpas_allocate_scratch_field(field_2d_real) + nullify(field_2d_real) + call self % debug_print(subname // ' completed') call self % debug_print('Successful initialization of MPAS dynamical core') @@ -3259,7 +3292,7 @@ subroutine dyn_mpas_get_pool_pointer(self, pool_pointer, pool_name) pool_pointer => self % domain_ptr % configs case ('dim') pool_pointer => self % domain_ptr % blocklist % dimensions - case ('diag', 'mesh', 'state', 'tend') + case ('diag', 'mesh', 'state', 'tend', 'tend_physics') call mpas_pool_get_subpool(self % domain_ptr % blocklist % allstructs, trim(adjustl(pool_name)), pool_pointer) case default call self % model_error('Unsupported pool name "' // trim(adjustl(pool_name)) // '"', subname, __LINE__) diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index 5c2d8f0b..dcf954a4 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -474,7 +474,7 @@ subroutine set_mpas_state_u() nullify(ucellzonal, ucellmeridional) - call mpas_dynamical_core % compute_edge_wind() + call mpas_dynamical_core % compute_edge_wind(.false.) end subroutine set_mpas_state_u !> Set MPAS state `w` (i.e., vertical velocity at cell interfaces). From c3d7968d5d1e67476909d293e7d68704da0ef350 Mon Sep 17 00:00:00 2001 From: Kuan-Chih Wang Date: Tue, 30 Jul 2024 15:40:24 -0600 Subject: [PATCH 04/27] Implement `dyn_run` --- src/dynamics/mpas/dyn_comp.F90 | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index dcf954a4..6f9fefc9 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -49,7 +49,7 @@ module dyn_comp public :: dyn_export_t public :: dyn_readnl public :: dyn_init - ! public :: dyn_run + public :: dyn_run ! public :: dyn_final public :: dyn_debug_print @@ -834,9 +834,14 @@ subroutine mark_variable_as_initialized() end do end subroutine mark_variable_as_initialized - ! Not used for now. Intended to be called by `stepon_run*` in `src/dynamics/mpas/stepon.F90`. - ! subroutine dyn_run() - ! end subroutine dyn_run + !> Run MPAS dynamical core to integrate the dynamical states with time. + !> (KCW, 2024-07-11) + subroutine dyn_run() + character(*), parameter :: subname = 'dyn_comp::dyn_run' + + ! MPAS dynamical core will run until the coupling time interval is reached. + call mpas_dynamical_core % run() + end subroutine dyn_run ! Not used for now. Intended to be called by `stepon_final` in `src/dynamics/mpas/stepon.F90`. ! subroutine dyn_final() From 6d805f65947c052c7245e2eedf3dfe843588d5f4 Mon Sep 17 00:00:00 2001 From: Kuan-Chih Wang Date: Tue, 30 Jul 2024 15:41:56 -0600 Subject: [PATCH 05/27] Wire up `dyn_run` --- src/dynamics/mpas/stepon.F90 | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/src/dynamics/mpas/stepon.F90 b/src/dynamics/mpas/stepon.F90 index 7dfdbc23..ab517b47 100644 --- a/src/dynamics/mpas/stepon.F90 +++ b/src/dynamics/mpas/stepon.F90 @@ -1,7 +1,7 @@ module stepon ! Modules from CAM-SIMA. use camsrfexch, only: cam_out_t - use dyn_comp, only: dyn_import_t, dyn_export_t + use dyn_comp, only: dyn_import_t, dyn_export_t, dyn_run use physics_types, only: physics_state, physics_tend use runtime_obj, only: runtime_options @@ -31,8 +31,8 @@ subroutine stepon_timestep_init(dtime_phys, cam_runtime_opts, phys_state, phys_t type(runtime_options), intent(in) :: cam_runtime_opts type(physics_state), intent(inout) :: phys_state type(physics_tend), intent(inout) :: phys_tend - type(dyn_import_t), intent(inout) :: dyn_in - type(dyn_export_t), intent(inout) :: dyn_out + type(dyn_import_t), intent(in) :: dyn_in + type(dyn_export_t), intent(in) :: dyn_out end subroutine stepon_timestep_init ! Called by `cam_run2` in `src/control/cam_comp.F90`. @@ -40,8 +40,8 @@ subroutine stepon_run2(cam_runtime_opts, phys_state, phys_tend, dyn_in, dyn_out) type(runtime_options), intent(in) :: cam_runtime_opts type(physics_state), intent(inout) :: phys_state type(physics_tend), intent(inout) :: phys_tend - type(dyn_import_t), intent(inout) :: dyn_in - type(dyn_export_t), intent(inout) :: dyn_out + type(dyn_import_t), intent(in) :: dyn_in + type(dyn_export_t), intent(in) :: dyn_out end subroutine stepon_run2 ! Called by `cam_run3` in `src/control/cam_comp.F90`. @@ -50,14 +50,16 @@ subroutine stepon_run3(dtime_phys, cam_runtime_opts, cam_out, phys_state, dyn_in type(runtime_options), intent(in) :: cam_runtime_opts type(cam_out_t), intent(inout) :: cam_out type(physics_state), intent(inout) :: phys_state - type(dyn_import_t), intent(inout) :: dyn_in - type(dyn_export_t), intent(inout) :: dyn_out + type(dyn_import_t), intent(in) :: dyn_in + type(dyn_export_t), intent(in) :: dyn_out + + call dyn_run() end subroutine stepon_run3 ! Called by `cam_final` in `src/control/cam_comp.F90`. subroutine stepon_final(cam_runtime_opts, dyn_in, dyn_out) type(runtime_options), intent(in) :: cam_runtime_opts - type(dyn_import_t), intent(inout) :: dyn_in - type(dyn_export_t), intent(inout) :: dyn_out + type(dyn_import_t), intent(in) :: dyn_in + type(dyn_export_t), intent(in) :: dyn_out end subroutine stepon_final end module stepon From dc786e4fbe6d311414b7bbb39dedffefac3ad56b Mon Sep 17 00:00:00 2001 From: Kuan-Chih Wang Date: Fri, 27 Sep 2024 12:45:51 -0600 Subject: [PATCH 06/27] Sort `use` statements and add comments --- src/dynamics/mpas/dyn_comp.F90 | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index 6f9fefc9..09a74cbe 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -28,16 +28,16 @@ module dyn_comp use time_manager, only: get_start_date, get_stop_date, get_step_size, get_run_duration, timemgr_get_calendar_cf use vert_coord, only: pver, pverp - ! Modules from CESM Share. - use shr_file_mod, only: shr_file_getunit - use shr_kind_mod, only: kind_cs => shr_kind_cs, kind_r8 => shr_kind_r8 - use shr_pio_mod, only: shr_pio_getiosys - ! Modules from CCPP. use cam_ccpp_cap, only: cam_constituents_array use ccpp_kinds, only: kind_phys use phys_vars_init_check, only: mark_as_initialized, std_name_len + ! Modules from CESM Share. + use shr_file_mod, only: shr_file_getunit + use shr_kind_mod, only: kind_cs => shr_kind_cs, kind_r8 => shr_kind_r8 + use shr_pio_mod, only: shr_pio_getiosys + ! Modules from external libraries. use pio, only: file_desc_t, iosystem_desc_t, pio_file_is_open @@ -357,10 +357,10 @@ subroutine set_analytic_initial_condition() integer, allocatable :: global_grid_index(:) real(kind_r8), allocatable :: buffer_2d_real(:, :), buffer_3d_real(:, :, :) real(kind_r8), allocatable :: lat_rad(:), lon_rad(:) - real(kind_r8), allocatable :: z_int(:, :) ! Geometric height (meters) at layer interfaces. - ! Dimension and vertical index orders follow CAM-SIMA convention. - real(kind_r8), pointer :: zgrid(:, :) ! Geometric height (meters) at layer interfaces. - ! Dimension and vertical index orders follow MPAS convention. + real(kind_r8), allocatable :: z_int(:, :) ! Geometric height (meters) at layer interfaces. + ! Dimension and vertical index orders follow CAM-SIMA convention. + real(kind_r8), pointer :: zgrid(:, :) ! Geometric height (meters) at layer interfaces. + ! Dimension and vertical index orders follow MPAS convention. call init_shared_variable() @@ -577,6 +577,8 @@ subroutine set_mpas_state_rho_theta() real(kind_r8), allocatable :: qv_mid_col(:) ! Water vapor mixing ratio (kg/kg) at layer midpoints of each column. real(kind_r8), allocatable :: t_mid(:, :) ! Temperature (K) at layer midpoints. real(kind_r8), allocatable :: tm_mid_col(:) ! Modified "moist" temperature (K) at layer midpoints of each column. + ! Be advised that it is not virtual temperature. + ! See doi:10.5065/1DFH-6P97 and doi:10.1175/MWR-D-11-00215.1 for details. real(kind_r8), pointer :: rho(:, :) real(kind_r8), pointer :: theta(:, :) real(kind_r8), pointer :: scalars(:, :, :) From bb8750894be9926efbebe039ac29c7fab3195672 Mon Sep 17 00:00:00 2001 From: Kuan-Chih Wang Date: Fri, 9 Aug 2024 13:37:38 -0600 Subject: [PATCH 07/27] Factor out variable finalization --- src/dynamics/mpas/dyn_comp.F90 | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index 09a74cbe..6582c8ed 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -370,11 +370,7 @@ subroutine set_analytic_initial_condition() call set_mpas_state_rho_theta() call set_mpas_state_rho_base_theta_base() - deallocate(global_grid_index) - deallocate(lat_rad, lon_rad) - deallocate(z_int) - - nullify(zgrid) + call final_shared_variable() contains !> Initialize variables that are shared and repeatedly used by the `set_mpas_state_*` internal subroutines. !> (KCW, 2024-05-13) @@ -434,6 +430,18 @@ subroutine init_shared_variable() end do end subroutine init_shared_variable + !> Finalize variables that are shared and repeatedly used by the `set_mpas_state_*` internal subroutines. + !> (KCW, 2024-05-13) + subroutine final_shared_variable() + character(*), parameter :: subname = 'dyn_comp::set_analytic_initial_condition::final_shared_variable' + + deallocate(global_grid_index) + deallocate(lat_rad, lon_rad) + deallocate(z_int) + + nullify(zgrid) + end subroutine final_shared_variable + !> Set MPAS state `u` (i.e., horizontal velocity at edge interfaces). !> (KCW, 2024-05-13) subroutine set_mpas_state_u() From 10613a1189b6ba58b2b12876cf0b97854c928aab Mon Sep 17 00:00:00 2001 From: Kuan-Chih Wang Date: Mon, 5 Aug 2024 15:41:47 -0600 Subject: [PATCH 08/27] Implement `reverse` This helper function reverses the order of elements in a 1-d array. --- src/dynamics/mpas/dyn_comp.F90 | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index 6582c8ed..d26fe34d 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -53,6 +53,7 @@ module dyn_comp ! public :: dyn_final public :: dyn_debug_print + public :: reverse public :: mpas_dynamical_core public :: ncells, ncells_solve, nedges, nedges_solve, nvertices, nvertices_solve, nvertlevels public :: ncells_global, nedges_global, nvertices_global, ncells_max, nedges_max @@ -856,4 +857,22 @@ end subroutine dyn_run ! Not used for now. Intended to be called by `stepon_final` in `src/dynamics/mpas/stepon.F90`. ! subroutine dyn_final() ! end subroutine dyn_final + + !> Helper function for reversing the order of elements in `array`. + !> (KCW, 2024-07-17) + pure function reverse(array) + real(kind_r8), intent(in) :: array(:) + real(kind_r8) :: reverse(size(array)) + + integer :: n + + n = size(array) + + ! There is nothing to reverse. + if (n == 0) then + return + end if + + reverse(:) = array(n:1:-1) + end function reverse end module dyn_comp From e30582c1a813f5371ac8a7833802e75eb9714cdb Mon Sep 17 00:00:00 2001 From: Kuan-Chih Wang Date: Mon, 5 Aug 2024 15:46:26 -0600 Subject: [PATCH 09/27] Refactor assignments between CAM-SIMA and MPAS in terms of `reverse` This makes the assignments less error-prone and much more intuitive. --- src/dynamics/mpas/dyn_comp.F90 | 48 +++++++++++++++++----------------- 1 file changed, 24 insertions(+), 24 deletions(-) diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index d26fe34d..5d594c8d 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -378,7 +378,7 @@ subroutine set_analytic_initial_condition() subroutine init_shared_variable() character(*), parameter :: subname = 'dyn_comp::set_analytic_initial_condition::init_shared_variable' integer :: ierr - integer :: k + integer :: i integer, pointer :: indextocellid(:) real(kind_r8), pointer :: lat_deg(:), lon_deg(:) @@ -426,8 +426,8 @@ subroutine init_shared_variable() call mpas_dynamical_core % get_variable_pointer(zgrid, 'mesh', 'zgrid') ! Vertical index order is reversed between CAM-SIMA and MPAS. - do k = 1, pverp - z_int(:, k) = zgrid(pverp - k + 1, 1:ncells_solve) + do i = 1, ncells_solve + z_int(i, :) = reverse(zgrid(:, i)) end do end subroutine init_shared_variable @@ -448,7 +448,7 @@ end subroutine final_shared_variable subroutine set_mpas_state_u() character(*), parameter :: subname = 'dyn_comp::set_analytic_initial_condition::set_mpas_state_u' integer :: ierr - integer :: k + integer :: i real(kind_r8), pointer :: ucellzonal(:, :), ucellmeridional(:, :) call dyn_debug_print('Setting MPAS state "u"') @@ -466,8 +466,8 @@ subroutine set_mpas_state_u() call dyn_set_inic_col(vc_height, lat_rad, lon_rad, global_grid_index, zint=z_int, u=buffer_2d_real) ! Vertical index order is reversed between CAM-SIMA and MPAS. - do k = 1, pver - ucellzonal(k, 1:ncells_solve) = buffer_2d_real(:, pver - k + 1) + do i = 1, ncells_solve + ucellzonal(:, i) = reverse(buffer_2d_real(i, :)) end do buffer_2d_real(:, :) = 0.0_kind_r8 @@ -475,8 +475,8 @@ subroutine set_mpas_state_u() call dyn_set_inic_col(vc_height, lat_rad, lon_rad, global_grid_index, zint=z_int, v=buffer_2d_real) ! Vertical index order is reversed between CAM-SIMA and MPAS. - do k = 1, pver - ucellmeridional(k, 1:ncells_solve) = buffer_2d_real(:, pver - k + 1) + do i = 1, ncells_solve + ucellmeridional(:, i) = reverse(buffer_2d_real(i, :)) end do deallocate(buffer_2d_real) @@ -514,7 +514,7 @@ subroutine set_mpas_state_scalars() 'water_vapor_mixing_ratio_wrt_dry_air' character(*), parameter :: subname = 'dyn_comp::set_analytic_initial_condition::set_mpas_state_scalars' - integer :: i, k + integer :: i, j integer :: ierr integer, allocatable :: constituent_index(:) integer, pointer :: index_qv @@ -540,12 +540,12 @@ subroutine set_mpas_state_scalars() call dyn_set_inic_col(vc_height, lat_rad, lon_rad, global_grid_index, zint=z_int, q=buffer_3d_real, & m_cnst=constituent_index) - ! `i` is indexing into `scalars`, so it is regarded as MPAS scalar index. - do i = 1, num_advected - ! Vertical index order is reversed between CAM-SIMA and MPAS. - do k = 1, pver - scalars(i, k, 1:ncells_solve) = & - buffer_3d_real(:, pver - k + 1, mpas_dynamical_core % map_constituent_index(i)) + do i = 1, ncells_solve + ! `j` is indexing into `scalars`, so it is regarded as MPAS scalar index. + do j = 1, num_advected + ! Vertical index order is reversed between CAM-SIMA and MPAS. + scalars(j, :, i) = & + reverse(buffer_3d_real(i, :, mpas_dynamical_core % map_constituent_index(j))) end do end do @@ -617,8 +617,8 @@ subroutine set_mpas_state_rho_theta() call dyn_set_inic_col(vc_height, lat_rad, lon_rad, global_grid_index, zint=z_int, t=buffer_2d_real) ! Vertical index order is reversed between CAM-SIMA and MPAS. - do k = 1, pver - t_mid(k, :) = buffer_2d_real(:, pver - k + 1) + do i = 1, ncells_solve + t_mid(:, i) = reverse(buffer_2d_real(i, :)) end do deallocate(buffer_2d_real) @@ -770,7 +770,7 @@ end subroutine set_analytic_initial_condition !> (KCW, 2024-07-09) subroutine set_default_constituent() character(*), parameter :: subname = 'dyn_comp::set_default_constituent' - integer :: i, k + integer :: i, j real(kind_phys), pointer :: constituents(:, :, :) ! This points to CCPP memory. real(kind_r8), pointer :: scalars(:, :, :) ! This points to MPAS memory. @@ -787,12 +787,12 @@ subroutine set_default_constituent() call mpas_dynamical_core % get_variable_pointer(scalars, 'state', 'scalars', time_level=1) - ! `i` is indexing into `scalars`, so it is regarded as MPAS scalar index. - do i = 1, num_advected - ! Vertical index order is reversed between CAM-SIMA and MPAS. - do k = 1, pver - scalars(i, k, 1:ncells_solve) = & - constituents(:, pver - k + 1, mpas_dynamical_core % map_constituent_index(i)) + do i = 1, ncells_solve + ! `j` is indexing into `scalars`, so it is regarded as MPAS scalar index. + do j = 1, num_advected + ! Vertical index order is reversed between CAM-SIMA and MPAS. + scalars(j, :, i) = & + reverse(constituents(i, :, mpas_dynamical_core % map_constituent_index(j))) end do end do From 759768fa4767d35a06e0970479aa15c3b7ef9365 Mon Sep 17 00:00:00 2001 From: Kuan-Chih Wang Date: Fri, 9 Aug 2024 14:01:07 -0600 Subject: [PATCH 10/27] Implement `dyn_exchange_constituent_state` This subroutine provides a streamlined mechanism for exchanging constituent states between CAM-SIMA and MPAS. --- src/dynamics/mpas/dyn_comp.F90 | 154 ++++++++++++++++++++++++++++++++- 1 file changed, 153 insertions(+), 1 deletion(-) diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index 5d594c8d..4c5006a6 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -9,7 +9,7 @@ module dyn_comp thermodynamic_active_species_liq_idx, thermodynamic_active_species_liq_idx_dycore, & thermodynamic_active_species_ice_idx, thermodynamic_active_species_ice_idx_dycore use cam_abortutils, only: check_allocate, endrun - use cam_constituents, only: const_name, const_is_water_species, num_advected, readtrace + use cam_constituents, only: const_name, const_is_dry, const_is_water_species, num_advected, readtrace use cam_control_mod, only: initial_run use cam_field_read, only: cam_read_field use cam_grid_support, only: cam_grid_get_latvals, cam_grid_get_lonvals, cam_grid_id @@ -32,6 +32,7 @@ module dyn_comp use cam_ccpp_cap, only: cam_constituents_array use ccpp_kinds, only: kind_phys use phys_vars_init_check, only: mark_as_initialized, std_name_len + use physics_types, only: phys_state ! Modules from CESM Share. use shr_file_mod, only: shr_file_getunit @@ -53,6 +54,7 @@ module dyn_comp ! public :: dyn_final public :: dyn_debug_print + public :: dyn_exchange_constituent_state public :: reverse public :: mpas_dynamical_core public :: ncells, ncells_solve, nedges, nedges_solve, nvertices, nvertices_solve, nvertlevels @@ -766,6 +768,156 @@ pure elemental function theta_by_poisson_equation(p_1, t_1, p_0) result(t_0) end function theta_by_poisson_equation end subroutine set_analytic_initial_condition + !> Exchange and/or convert constituent states between CAM-SIMA and MPAS. + !> If `exchange` is `.true.` and `direction` is "e" or "export", set MPAS state `scalars` from physics state `constituents`. + !> If `exchange` is `.true.` and `direction` is "i" or "import", set physics state `constituents` from MPAS state `scalars`. + !> Think of it as "exporting/importing constituent states in CAM-SIMA to/from MPAS". + !> Otherwise, if `exchange` is `.false.`, no exchange is performed at all. + !> If `conversion` is `.true.`, appropriate conversion is performed for constituent mixing ratio that has different + !> definitions between CAM-SIMA and MPAS (i.e., dry/moist). + !> Otherwise, if `conversion` is `.false.`, no conversion is performed at all. + !> This subroutine is intentionally designed to have these elaborate controls due to complications in CAM-SIMA. + !> Some procedures in CAM-SIMA expect constituent states to be dry, while the others expect them to be moist. + !> (KCW, 2024-09-26) + subroutine dyn_exchange_constituent_state(direction, exchange, conversion) + character(*), intent(in) :: direction + logical, intent(in) :: exchange + logical, intent(in) :: conversion + + character(*), parameter :: subname = 'dyn_comp::dyn_exchange_constituent_state' + integer :: i, j + integer :: ierr + integer, allocatable :: is_water_species_index(:) + logical, allocatable :: is_conversion_needed(:) + logical, allocatable :: is_water_species(:) + real(kind_phys), pointer :: constituents(:, :, :) ! This points to CCPP memory. + real(kind_r8), allocatable :: sigma_all_q(:) ! Summation of all water mixing ratio. + real(kind_r8), pointer :: scalars(:, :, :) ! This points to MPAS memory. + + select case (trim(adjustl(direction))) + case ('e', 'export') + if (exchange) then + call dyn_debug_print('Setting MPAS state "scalars" from physics state "constituents"') + end if + + if (conversion) then + call dyn_debug_print('Converting MPAS state "scalars"') + end if + case ('i', 'import') + if (exchange) then + call dyn_debug_print('Setting physics state "constituents" from MPAS state "scalars"') + end if + + if (conversion) then + call dyn_debug_print('Converting physics state "constituents"') + end if + case default + call endrun('Unsupported exchange direction "' // trim(adjustl(direction)) // '"', subname, __LINE__) + end select + + nullify(constituents) + nullify(scalars) + + allocate(is_conversion_needed(num_advected), stat=ierr) + call check_allocate(ierr, subname, & + 'is_conversion_needed(num_advected)', & + 'dyn_comp', __LINE__) + + allocate(is_water_species(num_advected), stat=ierr) + call check_allocate(ierr, subname, & + 'is_water_species(num_advected)', & + 'dyn_comp', __LINE__) + + do j = 1, num_advected + ! All constituent mixing ratio in MPAS is dry. + ! Therefore, conversion in between is needed for any constituent mixing ratio that is not dry in CAM-SIMA. + is_conversion_needed(j) = .not. const_is_dry(j) + is_water_species(j) = const_is_water_species(j) + end do + + allocate(is_water_species_index(count(is_water_species)), stat=ierr) + call check_allocate(ierr, subname, & + 'is_water_species_index(count(is_water_species))', & + 'dyn_comp', __LINE__) + + allocate(sigma_all_q(pver), stat=ierr) + call check_allocate(ierr, subname, & + 'sigma_all_q(pver)', & + 'dyn_comp', __LINE__) + + constituents => cam_constituents_array() + + if (.not. associated(constituents)) then + call endrun('Failed to find variable "constituents"', subname, __LINE__) + end if + + call mpas_dynamical_core % get_variable_pointer(scalars, 'state', 'scalars', time_level=1) + + if (trim(adjustl(direction)) == 'e' .or. trim(adjustl(direction)) == 'export') then + do i = 1, ncells_solve + if (conversion .and. any(is_conversion_needed)) then + ! The summation term of equation 8 in doi:10.1029/2017MS001257. + ! Using equation 7 here is not possible because it requires all constituent mixing ratio to be moist + ! on the RHS of it. There is no such guarantee in CAM-SIMA. + sigma_all_q(:) = phys_state % pdel(i, :) / phys_state % pdeldry(i, :) + end if + + ! `j` is indexing into `scalars`, so it is regarded as MPAS scalar index. + do j = 1, num_advected + if (exchange) then + ! Vertical index order is reversed between CAM-SIMA and MPAS. + scalars(j, :, i) = & + reverse(constituents(i, :, mpas_dynamical_core % map_constituent_index(j))) + end if + + if (conversion .and. is_conversion_needed(mpas_dynamical_core % map_constituent_index(j))) then + ! Equation 8 in doi:10.1029/2017MS001257. + scalars(j, :, i) = & + scalars(j, :, i) * reverse(sigma_all_q) + end if + end do + end do + else + is_water_species_index(:) = & + pack([(mpas_dynamical_core % map_mpas_scalar_index(i), i = 1, num_advected)], is_water_species) + + do i = 1, ncells_solve + if (conversion .and. any(is_conversion_needed)) then + ! The summation term of equation 8 in doi:10.1029/2017MS001257. + sigma_all_q(:) = 1.0_kind_r8 + sum(scalars(is_water_species_index, :, i), 1) + end if + + ! `j` is indexing into `constituents`, so it is regarded as constituent index. + do j = 1, num_advected + if (exchange) then + ! Vertical index order is reversed between CAM-SIMA and MPAS. + constituents(i, :, j) = & + reverse(scalars(mpas_dynamical_core % map_mpas_scalar_index(j), :, i)) + end if + + if (conversion .and. is_conversion_needed(j)) then + ! Equation 8 in doi:10.1029/2017MS001257. + constituents(i, :, j) = & + constituents(i, :, j) / reverse(sigma_all_q) + end if + end do + end do + end if + + deallocate(is_conversion_needed) + deallocate(is_water_species) + deallocate(is_water_species_index) + deallocate(sigma_all_q) + + nullify(constituents) + nullify(scalars) + + if (trim(adjustl(direction)) == 'e' .or. trim(adjustl(direction)) == 'export') then + ! Because we are injecting data directly into MPAS memory, halo layers need to be updated manually. + call mpas_dynamical_core % exchange_halo('scalars') + end if + end subroutine dyn_exchange_constituent_state + !> Set default MPAS state `scalars` (i.e., constituents) in accordance with CCPP, which is a component of CAM-SIMA. !> (KCW, 2024-07-09) subroutine set_default_constituent() From 201fc4c628c87d4bec0f56d2afa4b60c4a5cea4e Mon Sep 17 00:00:00 2001 From: Kuan-Chih Wang Date: Fri, 9 Aug 2024 14:06:37 -0600 Subject: [PATCH 11/27] Switch to use `dyn_exchange_constituent_state` Use the new `dyn_exchange_constituent_state` subroutine to perform default initialization for all constituents instead. --- src/dynamics/mpas/dyn_comp.F90 | 41 ++-------------------------------- 1 file changed, 2 insertions(+), 39 deletions(-) diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index 4c5006a6..eec89488 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -254,9 +254,9 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) ! Perform default initialization for all constituents. ! Subsequently, they can be overridden depending on the namelist option (below) and ! the actual availability (checked and handled by MPAS). - call dyn_debug_print('Calling set_default_constituent') + call dyn_debug_print('Calling dyn_exchange_constituent_state') - call set_default_constituent() + call dyn_exchange_constituent_state('e', .true., .false.) ! Namelist option that controls if constituents are to be read from the file. if (readtrace) then @@ -918,43 +918,6 @@ subroutine dyn_exchange_constituent_state(direction, exchange, conversion) end if end subroutine dyn_exchange_constituent_state - !> Set default MPAS state `scalars` (i.e., constituents) in accordance with CCPP, which is a component of CAM-SIMA. - !> (KCW, 2024-07-09) - subroutine set_default_constituent() - character(*), parameter :: subname = 'dyn_comp::set_default_constituent' - integer :: i, j - real(kind_phys), pointer :: constituents(:, :, :) ! This points to CCPP memory. - real(kind_r8), pointer :: scalars(:, :, :) ! This points to MPAS memory. - - call dyn_debug_print('Setting default MPAS state "scalars"') - - nullify(constituents) - nullify(scalars) - - constituents => cam_constituents_array() - - if (.not. associated(constituents)) then - call endrun('Failed to find variable "constituents"', subname, __LINE__) - end if - - call mpas_dynamical_core % get_variable_pointer(scalars, 'state', 'scalars', time_level=1) - - do i = 1, ncells_solve - ! `j` is indexing into `scalars`, so it is regarded as MPAS scalar index. - do j = 1, num_advected - ! Vertical index order is reversed between CAM-SIMA and MPAS. - scalars(j, :, i) = & - reverse(constituents(i, :, mpas_dynamical_core % map_constituent_index(j))) - end do - end do - - nullify(constituents) - nullify(scalars) - - ! Because we are injecting data directly into MPAS memory, halo layers need to be updated manually. - call mpas_dynamical_core % exchange_halo('scalars') - end subroutine set_default_constituent - !> Mark everything in the `physics_{state,tend}` derived types along with constituents as initialized !> to prevent physics from attempting to read them from a file. These variables are to be exchanged later !> during dynamics-physics coupling. From 936306e295153f0cda127284506a5fd684ead167 Mon Sep 17 00:00:00 2001 From: Kuan-Chih Wang Date: Mon, 22 Jul 2024 13:22:29 -0600 Subject: [PATCH 12/27] Implement dynamics-physics coupling and vice versa --- src/dynamics/mpas/dyn_coupling.F90 | 627 +++++++++++++++++++++++++++++ 1 file changed, 627 insertions(+) create mode 100644 src/dynamics/mpas/dyn_coupling.F90 diff --git a/src/dynamics/mpas/dyn_coupling.F90 b/src/dynamics/mpas/dyn_coupling.F90 new file mode 100644 index 00000000..2858e9ff --- /dev/null +++ b/src/dynamics/mpas/dyn_coupling.F90 @@ -0,0 +1,627 @@ +module dyn_coupling + ! Modules from CAM-SIMA. + use cam_abortutils, only: check_allocate, endrun + use cam_constituents, only: const_is_water_species, const_qmin, num_advected + use cam_thermo, only: cam_thermo_update + use dyn_comp, only: dyn_debug_print, dyn_exchange_constituent_state, reverse, mpas_dynamical_core, & + ncells_solve + use dynconst, only: constant_cpd => cpair, constant_g => gravit, constant_p0 => pref, & + constant_rd => rair, constant_rv => rh2o + use runtime_obj, only: cam_runtime_opts + use vert_coord, only: pver, pverp + + ! Modules from CCPP. + use cam_ccpp_cap, only: cam_constituents_array, cam_model_const_properties + use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t + use ccpp_kinds, only: kind_phys + use geopotential_temp, only: geopotential_temp_run + use physics_types, only: cappav, cpairv, rairv, zvirv, & + dtime_phys, lagrangian_vertical, & + phys_state, phys_tend + use qneg, only: qneg_run + use static_energy, only: update_dry_static_energy_run + + ! Modules from CESM Share. + use shr_kind_mod, only: kind_cx => shr_kind_cx, kind_r8 => shr_kind_r8 + + implicit none + + private + ! Provide APIs required by CAM-SIMA. + public :: dynamics_to_physics_coupling + public :: physics_to_dynamics_coupling +contains + !> Perform one-way coupling from the dynamics output states to the physics input states. + !> The other coupling direction is implemented by its counterpart, `physics_to_dynamics_coupling`. + !> (KCW, 2024-07-31) + subroutine dynamics_to_physics_coupling() + character(*), parameter :: subname = 'dyn_coupling::dynamics_to_physics_coupling' + integer :: column_index + integer, allocatable :: is_water_species_index(:) + integer, pointer :: index_qv + ! Variable name suffixes have the following meanings: + ! `*_col`: Variable is of each column. + ! `*_int`: Variable is at layer interfaces. + ! `*_mid`: Variable is at layer midpoints. + real(kind_r8), allocatable :: pd_int_col(:), & ! Dry hydrostatic air pressure (Pa). + pd_mid_col(:), & ! Dry hydrostatic air pressure (Pa). + p_int_col(:), & ! Full hydrostatic air pressure (Pa). + p_mid_col(:), & ! Full hydrostatic air pressure (Pa). + z_int_col(:) ! Geometric height (m). + real(kind_r8), allocatable :: dpd_col(:), & ! Dry air pressure difference (Pa) between layer interfaces. + dp_col(:), & ! Full air pressure difference (Pa) between layer interfaces. + dz_col(:) ! Geometric height difference (m) between layer interfaces. + real(kind_r8), allocatable :: qv_mid_col(:), & ! Water vapor mixing ratio (kg kg-1). + sigma_all_q_mid_col(:) ! Summation of all water mixing ratio (kg kg-1). + real(kind_r8), allocatable :: rhod_mid_col(:), & ! Dry air density (kg m-3). + rho_mid_col(:) ! Full air density (kg m-3). + real(kind_r8), allocatable :: t_mid_col(:), & ! Temperature (K). + tm_mid_col(:), & ! Modified "moist" temperature (K). + tv_mid_col(:) ! Virtual temperature (K). + real(kind_r8), allocatable :: u_mid_col(:), & ! Eastward wind velocity (m s-1). + v_mid_col(:), & ! Northward wind velocity (m s-1). + omega_mid_col(:) ! Vertical wind velocity (Pa s-1). + real(kind_r8), pointer :: exner(:, :) + real(kind_r8), pointer :: rho_zz(:, :) + real(kind_r8), pointer :: scalars(:, :, :) + real(kind_r8), pointer :: theta_m(:, :) + real(kind_r8), pointer :: ucellzonal(:, :), ucellmeridional(:, :), w(:, :) + real(kind_r8), pointer :: zgrid(:, :) + real(kind_r8), pointer :: zz(:, :) + + call init_shared_variable() + + call dyn_exchange_constituent_state('i', .true., .false.) + + call dyn_debug_print('Setting physics state variables column by column') + + ! Set variables in the `physics_state` derived type column by column. + ! This way, peak memory usage can be reduced. + do column_index = 1, ncells_solve + call update_shared_variable(column_index) + call set_physics_state_column(column_index) + end do + + call set_physics_state_external() + + call final_shared_variable() + contains + !> Initialize variables that are shared and repeatedly used by the `update_shared_variable` and + !> `set_physics_state_column` internal subroutines. + !> (KCW, 2024-07-20) + subroutine init_shared_variable() + character(*), parameter :: subname = 'dyn_coupling::dynamics_to_physics_coupling::init_shared_variable' + integer :: i + integer :: ierr + logical, allocatable :: is_water_species(:) + + call dyn_debug_print('Preparing for dynamics-physics coupling') + + nullify(index_qv) + nullify(exner) + nullify(rho_zz) + nullify(scalars) + nullify(theta_m) + nullify(ucellzonal, ucellmeridional, w) + nullify(zgrid) + nullify(zz) + + allocate(is_water_species(num_advected), stat=ierr) + call check_allocate(ierr, subname, & + 'is_water_species(num_advected)', & + 'dyn_coupling', __LINE__) + + do i = 1, num_advected + is_water_species(i) = const_is_water_species(i) + end do + + allocate(is_water_species_index(count(is_water_species)), stat=ierr) + call check_allocate(ierr, subname, & + 'is_water_species_index(count(is_water_species))', & + 'dyn_coupling', __LINE__) + + is_water_species_index(:) = & + pack([(mpas_dynamical_core % map_mpas_scalar_index(i), i = 1, num_advected)], is_water_species) + + deallocate(is_water_species) + + allocate(pd_int_col(pverp), pd_mid_col(pver), p_int_col(pverp), p_mid_col(pver), z_int_col(pverp), stat=ierr) + call check_allocate(ierr, subname, & + 'pd_int_col(pverp), pd_mid_col(pver), p_int_col(pverp), p_mid_col(pver), z_int_col(pverp)', & + 'dyn_coupling', __LINE__) + + allocate(dpd_col(pver), dp_col(pver), dz_col(pver), stat=ierr) + call check_allocate(ierr, subname, & + 'dpd_col(pver), dp_col(pver), dz_col(pver)', & + 'dyn_coupling', __LINE__) + + allocate(qv_mid_col(pver), sigma_all_q_mid_col(pver), stat=ierr) + call check_allocate(ierr, subname, & + 'qv_mid_col(pver), sigma_all_q_mid_col(pver)', & + 'dyn_coupling', __LINE__) + + allocate(rhod_mid_col(pver), rho_mid_col(pver), stat=ierr) + call check_allocate(ierr, subname, & + 'rhod_mid_col(pver), rho_mid_col(pver)', & + 'dyn_coupling', __LINE__) + + allocate(t_mid_col(pver), tm_mid_col(pver), tv_mid_col(pver), stat=ierr) + call check_allocate(ierr, subname, & + 't_mid_col(pver), tm_mid_col(pver), tv_mid_col(pver)', & + 'dyn_coupling', __LINE__) + + allocate(u_mid_col(pver), v_mid_col(pver), omega_mid_col(pver), stat=ierr) + call check_allocate(ierr, subname, & + 'u_mid_col(pver), v_mid_col(pver), omega_mid_col(pver)', & + 'dyn_coupling', __LINE__) + + call mpas_dynamical_core % get_variable_pointer(index_qv, 'dim', 'index_qv') + call mpas_dynamical_core % get_variable_pointer(exner, 'diag', 'exner') + call mpas_dynamical_core % get_variable_pointer(rho_zz, 'state', 'rho_zz', time_level=1) + call mpas_dynamical_core % get_variable_pointer(scalars, 'state', 'scalars', time_level=1) + call mpas_dynamical_core % get_variable_pointer(theta_m, 'state', 'theta_m', time_level=1) + call mpas_dynamical_core % get_variable_pointer(ucellzonal, 'diag', 'uReconstructZonal') + call mpas_dynamical_core % get_variable_pointer(ucellmeridional, 'diag', 'uReconstructMeridional') + call mpas_dynamical_core % get_variable_pointer(w, 'state', 'w', time_level=1) + call mpas_dynamical_core % get_variable_pointer(zgrid, 'mesh', 'zgrid') + call mpas_dynamical_core % get_variable_pointer(zz, 'mesh', 'zz') + end subroutine init_shared_variable + + !> Finalize variables that are shared and repeatedly used by the `update_shared_variable` and + !> `set_physics_state_column` internal subroutines. + !> (KCW, 2024-07-20) + subroutine final_shared_variable() + character(*), parameter :: subname = 'dyn_coupling::dynamics_to_physics_coupling::final_shared_variable' + + deallocate(is_water_species_index) + deallocate(pd_int_col, pd_mid_col, p_int_col, p_mid_col, z_int_col) + deallocate(dpd_col, dp_col, dz_col) + deallocate(qv_mid_col, sigma_all_q_mid_col) + deallocate(rhod_mid_col, rho_mid_col) + deallocate(t_mid_col, tm_mid_col, tv_mid_col) + deallocate(u_mid_col, v_mid_col, omega_mid_col) + + nullify(index_qv) + nullify(exner) + nullify(rho_zz) + nullify(scalars) + nullify(theta_m) + nullify(ucellzonal, ucellmeridional, w) + nullify(zgrid) + nullify(zz) + end subroutine final_shared_variable + + !> Update variables for the specific column, indicated by `i`. This subroutine and `set_physics_state_column` + !> should be called in pairs. + !> (KCW, 2024-07-30) + subroutine update_shared_variable(i) + integer, intent(in) :: i + + character(*), parameter :: subname = 'dyn_coupling::dynamics_to_physics_coupling::update_shared_variable' + integer :: k + + ! The summation term of equation 5 in doi:10.1029/2017MS001257. + sigma_all_q_mid_col(:) = 1.0_kind_r8 + sum(scalars(is_water_species_index, :, i), 1) + + ! Compute thermodynamic variables. + + ! By definition. + z_int_col(:) = zgrid(:, i) + dz_col(:) = z_int_col(2:pverp) - z_int_col(1:pver) + qv_mid_col(:) = scalars(index_qv, :, i) + rhod_mid_col(:) = rho_zz(:, i) * zz(:, i) + + ! Equation 5 in doi:10.1029/2017MS001257. + rho_mid_col(:) = rhod_mid_col(:) * sigma_all_q_mid_col(:) + + ! Hydrostatic equation. + dpd_col(:) = -rhod_mid_col(:) * constant_g * dz_col(:) + dp_col(:) = -rho_mid_col(:) * constant_g * dz_col(:) + + ! By definition of Exner function. Also see below. + tm_mid_col(:) = theta_m(:, i) * exner(:, i) + + ! The paragraph below equation 2.7 in doi:10.5065/1DFH-6P97. + ! The paragraph below equation 2 in doi:10.1175/MWR-D-11-00215.1. + t_mid_col(:) = tm_mid_col(:) / & + (1.0_kind_r8 + constant_rv / constant_rd * qv_mid_col(:)) + + ! Equation 16 in doi:10.1029/2017MS001257. + ! The numerator terms are just `tm_mid_col` here (i.e., modified "moist" temperature). + tv_mid_col(:) = tm_mid_col(:) / sigma_all_q_mid_col(:) + + ! Hydrostatic equation with equation of state plugged in and arranging for pressure. + pd_mid_col(:) = -constant_rd * t_mid_col(:) * dpd_col(:) / (constant_g * dz_col(:)) + p_mid_col(:) = -constant_rd * tv_mid_col(:) * dp_col(:) / (constant_g * dz_col(:)) + + ! By definition. + p_int_col(pverp) = p_mid_col(pver) + 0.5_kind_r8 * dp_col(pver) + + ! Assume no water at top of model. + pd_int_col(pverp) = p_int_col(pverp) + + ! Integrate downward. + do k = pver, 1, -1 + pd_int_col(k) = pd_int_col(k + 1) - dpd_col(k) + p_int_col(k) = p_int_col(k + 1) - dp_col(k) + end do + + ! Compute momentum variables. + + ! By definition. + u_mid_col(:) = ucellzonal(:, i) + v_mid_col(:) = ucellmeridional(:, i) + omega_mid_col(:) = -rhod_mid_col(:) * constant_g * 0.5_kind_r8 * (w(1:pver, i) + w(2:pverp, i)) + end subroutine update_shared_variable + + !> Set variables for the specific column, indicated by `i`, in the `physics_state` derived type. + !> This subroutine and `update_shared_variable` should be called in pairs. + !> (KCW, 2024-07-30) + subroutine set_physics_state_column(i) + integer, intent(in) :: i + + character(*), parameter :: subname = 'dyn_coupling::dynamics_to_physics_coupling::set_physics_state_column' + + ! Vertical index order is reversed between CAM-SIMA and MPAS. + ! Always call `reverse` when assigning anything to/from the `physics_state` derived type. + + phys_state % u(i, :) = reverse(u_mid_col) + phys_state % v(i, :) = reverse(v_mid_col) + phys_state % omega(i, :) = reverse(omega_mid_col) + + phys_state % psdry(i) = pd_int_col(1) + phys_state % pintdry(i, :) = reverse(pd_int_col) + phys_state % pmiddry(i, :) = reverse(pd_mid_col) + phys_state % pdeldry(i, :) = reverse(-dpd_col) + phys_state % lnpintdry(i, :) = log(phys_state % pintdry(i, :)) + phys_state % lnpmiddry(i, :) = log(phys_state % pmiddry(i, :)) + phys_state % rpdeldry(i, :) = 1.0_kind_r8 / phys_state % pdeldry(i, :) + + phys_state % ps(i) = p_int_col(1) + phys_state % pint(i, :) = reverse(p_int_col) + phys_state % pmid(i, :) = reverse(p_mid_col) + phys_state % pdel(i, :) = reverse(-dp_col) + phys_state % lnpint(i, :) = log(phys_state % pint(i, :)) + phys_state % lnpmid(i, :) = log(phys_state % pmid(i, :)) + phys_state % rpdel(i, :) = 1.0_kind_r8 / phys_state % pdel(i, :) + + phys_state % t(i, :) = reverse(t_mid_col) + + phys_state % phis(i) = constant_g * z_int_col(1) + end subroutine set_physics_state_column + + !> Set variables in the `physics_state` derived type by calling external procedures. + !> (KCW, 2024-07-30) + subroutine set_physics_state_external() + character(*), parameter :: subname = 'dyn_coupling::dynamics_to_physics_coupling::set_physics_state_external' + character(kind_cx) :: cerr + integer :: i + integer :: ierr + real(kind_phys), allocatable :: minimum_constituents(:) + real(kind_phys), pointer :: constituents(:, :, :) + type(ccpp_constituent_prop_ptr_t), pointer :: constituent_properties(:) + + call dyn_debug_print('Setting physics state variables externally') + + nullify(constituents) + nullify(constituent_properties) + + allocate(minimum_constituents(num_advected), stat=ierr) + call check_allocate(ierr, subname, & + 'minimum_constituents(num_advected)', & + 'dyn_coupling', __LINE__) + + do i = 1, num_advected + minimum_constituents(i) = const_qmin(i) + end do + + constituents => cam_constituents_array() + + if (.not. associated(constituents)) then + call endrun('Failed to find variable "constituents"', subname, __LINE__) + end if + + constituent_properties => cam_model_const_properties() + + if (.not. associated(constituent_properties)) then + call endrun('Failed to find variable "constituent_properties"', subname, __LINE__) + end if + + ! Update `cappav`, `cpairv`, `rairv`, `zvirv`, etc. as needed by calling `cam_thermo_update`. + ! Note that this subroutine expects constituents to be dry. + call cam_thermo_update( & + constituents, phys_state % t, ncells_solve, cam_runtime_opts % update_thermodynamic_variables()) + + ! This variable name is really misleading. It actually represents the reciprocal of Exner function + ! with respect to surface pressure. This definition is sometimes used for boundary layer work. See + ! the paragraph below equation 1.5.1c in doi:10.1007/978-94-009-3027-8. + ! Also note that `cappav` is updated externally by `cam_thermo_update`. + do i = 1, ncells_solve + phys_state % exner(i, :) = (phys_state % ps(i) / phys_state % pmid(i, :)) ** cappav(i, :) + end do + + ! Note that constituents become moist after this. + call dyn_exchange_constituent_state('i', .false., .true.) + + ! Impose minimum limits on constituents. + call qneg_run(subname, ncells_solve, pver, minimum_constituents, constituents, ierr, cerr) + + if (ierr /= 0) then + call endrun('Failed to impose minimum limits on constituents externally', subname, __LINE__) + end if + + ! Set `zi` (i.e., geopotential height at layer interfaces) and `zm` (i.e., geopotential height at layer midpoints). + ! Note that `rairv` and `zvirv` are updated externally by `cam_thermo_update`. + call geopotential_temp_run( & + pver, lagrangian_vertical, pver, 1, pverp, 1, num_advected, & + phys_state % lnpint, phys_state % pint, phys_state % pmid, phys_state % pdel, phys_state % rpdel, phys_state % t, & + constituents(:, :, mpas_dynamical_core % map_constituent_index(index_qv)), constituents, & + constituent_properties, rairv, constant_g, zvirv, phys_state % zi, phys_state % zm, ncells_solve, ierr, cerr) + + if (ierr /= 0) then + call endrun('Failed to set variable "zi" and "zm" externally', subname, __LINE__) + end if + + ! Set `dse` (i.e., dry static energy). + ! Note that `cpairv` is updated externally by `cam_thermo_update`. + call update_dry_static_energy_run( & + pver, constant_g, phys_state % t, phys_state % zm, phys_state % phis, phys_state % dse, cpairv, ierr, cerr) + + if (ierr /= 0) then + call endrun('Failed to set variable "dse" externally', subname, __LINE__) + end if + + deallocate(minimum_constituents) + + nullify(constituents) + nullify(constituent_properties) + end subroutine set_physics_state_external + end subroutine dynamics_to_physics_coupling + + !> Perform one-way coupling from the physics output states to the dynamics input states. + !> The other coupling direction is implemented by its counterpart, `dynamics_to_physics_coupling`. + !> (KCW, 2024-09-20) + subroutine physics_to_dynamics_coupling() + character(*), parameter :: subname = 'dyn_coupling::physics_to_dynamics_coupling' + integer, pointer :: index_qv + real(kind_r8), allocatable :: qv_prev(:, :) ! Water vapor mixing ratio (kg kg-1) + ! before being updated by physics. + real(kind_r8), pointer :: rho_zz(:, :) + real(kind_r8), pointer :: scalars(:, :, :) + real(kind_r8), pointer :: zz(:, :) + + call init_shared_variable() + + call dyn_exchange_constituent_state('e', .true., .true.) + + call set_mpas_physics_tendency_ru() + call set_mpas_physics_tendency_rho() + call set_mpas_physics_tendency_rtheta() + + call final_shared_variable() + contains + !> Initialize variables that are shared and repeatedly used by the `set_mpas_physics_tendency_*` internal subroutines. + !> (KCW, 2024-09-13) + subroutine init_shared_variable() + character(*), parameter :: subname = 'dyn_coupling::physics_to_dynamics_coupling::init_shared_variable' + integer :: ierr + + call dyn_debug_print('Preparing for physics-dynamics coupling') + + nullify(index_qv) + nullify(rho_zz) + nullify(scalars) + nullify(zz) + + call mpas_dynamical_core % get_variable_pointer(index_qv, 'dim', 'index_qv') + call mpas_dynamical_core % get_variable_pointer(rho_zz, 'state', 'rho_zz', time_level=1) + call mpas_dynamical_core % get_variable_pointer(scalars, 'state', 'scalars', time_level=1) + call mpas_dynamical_core % get_variable_pointer(zz, 'mesh', 'zz') + + allocate(qv_prev(pver, ncells_solve), stat=ierr) + call check_allocate(ierr, subname, & + 'qv_prev(pver, ncells_solve)', & + 'dyn_coupling', __LINE__) + + ! Save water vapor mixing ratio before being updated by physics because `set_mpas_physics_tendency_rtheta` + ! needs it. This must be done before calling `dyn_exchange_constituent_state`. + qv_prev(:, :) = scalars(index_qv, :, 1:ncells_solve) + end subroutine init_shared_variable + + !> Finalize variables that are shared and repeatedly used by the `set_mpas_physics_tendency_*` internal subroutines. + !> (KCW, 2024-09-13) + subroutine final_shared_variable() + character(*), parameter :: subname = 'dyn_coupling::physics_to_dynamics_coupling::final_shared_variable' + + deallocate(qv_prev) + + nullify(index_qv) + nullify(rho_zz) + nullify(scalars) + nullify(zz) + end subroutine final_shared_variable + + !> Set MPAS physics tendency `tend_ru_physics` (i.e., "coupled" tendency of horizontal velocity at edge interfaces + !> due to physics). In MPAS, a "coupled" variable means that it is multiplied by a vertical metric term, `rho_zz`. + !> (KCW, 2024-09-11) + subroutine set_mpas_physics_tendency_ru() + character(*), parameter :: subname = 'dyn_coupling::physics_to_dynamics_coupling::set_mpas_physics_tendency_ru' + integer :: i + real(kind_r8), pointer :: u_tendency(:, :), v_tendency(:, :) + + call dyn_debug_print('Setting MPAS physics tendency "tend_ru_physics"') + + nullify(u_tendency, v_tendency) + + call mpas_dynamical_core % get_variable_pointer(u_tendency, 'tend_physics', 'tend_uzonal') + call mpas_dynamical_core % get_variable_pointer(v_tendency, 'tend_physics', 'tend_umerid') + + ! Vertical index order is reversed between CAM-SIMA and MPAS. + ! Always call `reverse` when assigning anything to/from the `physics_tend` derived type. + do i = 1, ncells_solve + u_tendency(:, i) = reverse(phys_tend % dudt_total(i, :)) * rho_zz(:, i) + v_tendency(:, i) = reverse(phys_tend % dvdt_total(i, :)) * rho_zz(:, i) + end do + + nullify(u_tendency, v_tendency) + + call mpas_dynamical_core % compute_edge_wind(.true.) + end subroutine set_mpas_physics_tendency_ru + + !> Set MPAS physics tendency `tend_rho_physics` (i.e., "coupled" tendency of dry air density due to physics). + !> In MPAS, a "coupled" variable means that it is multiplied by a vertical metric term, `rho_zz`. + !> (KCW, 2024-09-11) + subroutine set_mpas_physics_tendency_rho() + character(*), parameter :: subname = 'dyn_coupling::physics_to_dynamics_coupling::set_mpas_physics_tendency_rho' + real(kind_r8), pointer :: rho_tendency(:, :) + + call dyn_debug_print('Setting MPAS physics tendency "tend_rho_physics"') + + nullify(rho_tendency) + + call mpas_dynamical_core % get_variable_pointer(rho_tendency, 'tend_physics', 'tend_rho_physics') + + ! The material derivative of `rho` (i.e., dry air density) is zero for incompressible fluid. + rho_tendency(:, 1:ncells_solve) = 0.0_kind_r8 + + nullify(rho_tendency) + + ! Because we are injecting data directly into MPAS memory, halo layers need to be updated manually. + call mpas_dynamical_core % exchange_halo('tend_rho_physics') + end subroutine set_mpas_physics_tendency_rho + + !> Set MPAS physics tendency `tend_rtheta_physics` (i.e., "coupled" tendency of modified "moist" potential temperature + !> due to physics). In MPAS, a "coupled" variable means that it is multiplied by a vertical metric term, `rho_zz`. + !> (KCW, 2024-09-19) + subroutine set_mpas_physics_tendency_rtheta() + character(*), parameter :: subname = 'dyn_coupling::physics_to_dynamics_coupling::set_mpas_physics_tendency_rtheta' + integer :: i + integer :: ierr + ! Variable name suffixes have the following meanings: + ! `*_col`: Variable is of each column. + ! `*_prev`: Variable is before being updated by physics. + ! `*_curr`: Variable is after being updated by physics. + real(kind_r8), allocatable :: qv_col_prev(:), qv_col_curr(:) ! Water vapor mixing ratio (kg kg-1). + real(kind_r8), allocatable :: rhod_col(:) ! Dry air density (kg m-3). + real(kind_r8), allocatable :: t_col_prev(:), t_col_curr(:) ! Temperature (K). + real(kind_r8), allocatable :: theta_col_prev(:), theta_col_curr(:) ! Potential temperature (K). + real(kind_r8), allocatable :: thetam_col_prev(:), thetam_col_curr(:) ! Modified "moist" potential temperature (K). + real(kind_r8), pointer :: theta_m(:, :) + real(kind_r8), pointer :: theta_m_tendency(:, :) + + call dyn_debug_print('Setting MPAS physics tendency "tend_rtheta_physics"') + + nullify(theta_m) + nullify(theta_m_tendency) + + allocate(qv_col_prev(pver), qv_col_curr(pver), stat=ierr) + call check_allocate(ierr, subname, & + 'qv_col_prev(pver), qv_col_curr(pver)', & + 'dyn_coupling', __LINE__) + + allocate(rhod_col(pver), stat=ierr) + call check_allocate(ierr, subname, & + 'rhod_col(pver)', & + 'dyn_coupling', __LINE__) + + allocate(t_col_prev(pver), t_col_curr(pver), stat=ierr) + call check_allocate(ierr, subname, & + 't_col_prev(pver), t_col_curr(pver)', & + 'dyn_coupling', __LINE__) + + allocate(theta_col_prev(pver), theta_col_curr(pver), stat=ierr) + call check_allocate(ierr, subname, & + 'theta_col_prev(pver), theta_col_curr(pver)', & + 'dyn_coupling', __LINE__) + + allocate(thetam_col_prev(pver), thetam_col_curr(pver), stat=ierr) + call check_allocate(ierr, subname, & + 'thetam_col_prev(pver), thetam_col_curr(pver)', & + 'dyn_coupling', __LINE__) + + call mpas_dynamical_core % get_variable_pointer(theta_m, 'state', 'theta_m', time_level=1) + call mpas_dynamical_core % get_variable_pointer(theta_m_tendency, 'tend_physics', 'tend_rtheta_physics') + + ! Set `theta_m_tendency` column by column. This way, peak memory usage can be reduced. + do i = 1, ncells_solve + qv_col_curr(:) = scalars(index_qv, :, i) + qv_col_prev(:) = qv_prev(:, i) + rhod_col(:) = rho_zz(:, i) * zz(:, i) + + thetam_col_prev(:) = theta_m(:, i) + theta_col_prev(:) = thetam_col_prev(:) / (1.0_kind_r8 + constant_rv / constant_rd * qv_col_prev(:)) + t_col_prev(:) = t_of_theta_rhod_qv(theta_col_prev, rhod_col, qv_col_prev) + + ! Vertical index order is reversed between CAM-SIMA and MPAS. + ! Always call `reverse` when assigning anything to/from the `physics_tend` derived type. + t_col_curr(:) = t_col_prev(:) + reverse(phys_tend % dtdt_total(i, :)) * dtime_phys + theta_col_curr(:) = theta_of_t_rhod_qv(t_col_curr, rhod_col, qv_col_curr) + thetam_col_curr(:) = theta_col_curr(:) * (1.0_kind_r8 + constant_rv / constant_rd * qv_col_curr(:)) + + theta_m_tendency(:, i) = (thetam_col_curr(:) - thetam_col_prev(:)) * rho_zz(:, i) / dtime_phys + end do + + deallocate(qv_col_prev, qv_col_curr) + deallocate(rhod_col) + deallocate(t_col_prev, t_col_curr) + deallocate(theta_col_prev, theta_col_curr) + deallocate(thetam_col_prev, thetam_col_curr) + + nullify(theta_m) + nullify(theta_m_tendency) + + ! Because we are injecting data directly into MPAS memory, halo layers need to be updated manually. + call mpas_dynamical_core % exchange_halo('tend_rtheta_physics') + end subroutine set_mpas_physics_tendency_rtheta + + !> Compute temperature `t` as a function of potential temperature `theta`, dry air density `rhod` and water vapor + !> mixing ratio `qv`. The formulation comes from Poisson equation with equation of state plugged in and arranging + !> for temperature. This function is the exact inverse of `theta_of_t_rhod_qv`, which means that: + !> `t == t_of_theta_rhod_qv(theta_of_t_rhod_qv(t, rhod, qv), rhod, qv)`. + !> (KCW, 2024-09-13) + pure elemental function t_of_theta_rhod_qv(theta, rhod, qv) result(t) + real(kind_r8), intent(in) :: theta, rhod, qv + real(kind_r8) :: t + + real(kind_r8) :: constant_cvd ! Specific heat of dry air at constant volume. + + ! Mayer's relation. + constant_cvd = constant_cpd - constant_rd + + ! Poisson equation with equation of state plugged in and arranging for temperature. For equation of state, + ! it can be shown that the effect of water vapor can be passed on to the temperature term entirely such that + ! dry air density and dry air gas constant can be used at all times. This modified "moist" temperature is + ! described herein: + ! The paragraph below equation 2.7 in doi:10.5065/1DFH-6P97. + ! The paragraph below equation 2 in doi:10.1175/MWR-D-11-00215.1. + t = (theta ** (constant_cpd / constant_cvd)) * & + (((rhod * constant_rd * (1.0_kind_r8 + constant_rv / constant_rd * qv)) / constant_p0) ** & + (constant_rd / constant_cvd)) + end function t_of_theta_rhod_qv + + !> Compute potential temperature `theta` as a function of temperature `t`, dry air density `rhod` and water vapor + !> mixing ratio `qv`. The formulation comes from Poisson equation with equation of state plugged in and arranging + !> for potential temperature. This function is the exact inverse of `t_of_theta_rhod_qv`, which means that: + !> `theta == theta_of_t_rhod_qv(t_of_theta_rhod_qv(theta, rhod, qv), rhod, qv)`. + !> (KCW, 2024-09-13) + pure elemental function theta_of_t_rhod_qv(t, rhod, qv) result(theta) + real(kind_r8), intent(in) :: t, rhod, qv + real(kind_r8) :: theta + + real(kind_r8) :: constant_cvd ! Specific heat of dry air at constant volume. + + ! Mayer's relation. + constant_cvd = constant_cpd - constant_rd + + ! Poisson equation with equation of state plugged in and arranging for potential temperature. For equation of state, + ! it can be shown that the effect of water vapor can be passed on to the temperature term entirely such that + ! dry air density and dry air gas constant can be used at all times. This modified "moist" temperature is + ! described herein: + ! The paragraph below equation 2.7 in doi:10.5065/1DFH-6P97. + ! The paragraph below equation 2 in doi:10.1175/MWR-D-11-00215.1. + theta = (t ** (constant_cvd / constant_cpd)) * & + ((constant_p0 / (rhod * constant_rd * (1.0_kind_r8 + constant_rv / constant_rd * qv))) ** & + (constant_rd / constant_cpd)) + end function theta_of_t_rhod_qv + end subroutine physics_to_dynamics_coupling +end module dyn_coupling From e048618ce099d4ba585fcb89a839e8e0b0cee11d Mon Sep 17 00:00:00 2001 From: Kuan-Chih Wang Date: Tue, 30 Jul 2024 12:55:46 -0600 Subject: [PATCH 13/27] Wire up dynamics-physics coupling --- src/dynamics/mpas/stepon.F90 | 29 +++++++++++++++++++---------- 1 file changed, 19 insertions(+), 10 deletions(-) diff --git a/src/dynamics/mpas/stepon.F90 b/src/dynamics/mpas/stepon.F90 index ab517b47..d089636e 100644 --- a/src/dynamics/mpas/stepon.F90 +++ b/src/dynamics/mpas/stepon.F90 @@ -2,11 +2,13 @@ module stepon ! Modules from CAM-SIMA. use camsrfexch, only: cam_out_t use dyn_comp, only: dyn_import_t, dyn_export_t, dyn_run + use dyn_coupling, only: dynamics_to_physics_coupling, physics_to_dynamics_coupling use physics_types, only: physics_state, physics_tend use runtime_obj, only: runtime_options + use time_manager, only: get_step_size - ! Modules from CESM Share. - use shr_kind_mod, only: kind_r8 => shr_kind_r8 + ! Modules from CCPP. + use ccpp_kinds, only: kind_phys implicit none @@ -27,29 +29,36 @@ end subroutine stepon_init ! Called by `cam_timestep_init` in `src/control/cam_comp.F90`. subroutine stepon_timestep_init(dtime_phys, cam_runtime_opts, phys_state, phys_tend, dyn_in, dyn_out) - real(kind_r8), intent(out) :: dtime_phys + real(kind_phys), intent(out) :: dtime_phys type(runtime_options), intent(in) :: cam_runtime_opts - type(physics_state), intent(inout) :: phys_state - type(physics_tend), intent(inout) :: phys_tend + type(physics_state), intent(in) :: phys_state + type(physics_tend), intent(in) :: phys_tend type(dyn_import_t), intent(in) :: dyn_in type(dyn_export_t), intent(in) :: dyn_out + + ! Set timestep for physics. + dtime_phys = real(get_step_size(), kind_phys) + + call dynamics_to_physics_coupling() end subroutine stepon_timestep_init ! Called by `cam_run2` in `src/control/cam_comp.F90`. subroutine stepon_run2(cam_runtime_opts, phys_state, phys_tend, dyn_in, dyn_out) type(runtime_options), intent(in) :: cam_runtime_opts - type(physics_state), intent(inout) :: phys_state - type(physics_tend), intent(inout) :: phys_tend + type(physics_state), intent(in) :: phys_state + type(physics_tend), intent(in) :: phys_tend type(dyn_import_t), intent(in) :: dyn_in type(dyn_export_t), intent(in) :: dyn_out + + call physics_to_dynamics_coupling() end subroutine stepon_run2 ! Called by `cam_run3` in `src/control/cam_comp.F90`. subroutine stepon_run3(dtime_phys, cam_runtime_opts, cam_out, phys_state, dyn_in, dyn_out) - real(kind_r8), intent(in) :: dtime_phys + real(kind_phys), intent(in) :: dtime_phys type(runtime_options), intent(in) :: cam_runtime_opts - type(cam_out_t), intent(inout) :: cam_out - type(physics_state), intent(inout) :: phys_state + type(cam_out_t), intent(in) :: cam_out + type(physics_state), intent(in) :: phys_state type(dyn_import_t), intent(in) :: dyn_in type(dyn_export_t), intent(in) :: dyn_out From f557372c84a190ce5e759abda13be24479ced37c Mon Sep 17 00:00:00 2001 From: Kuan-Chih Wang Date: Mon, 4 Nov 2024 14:08:46 -0700 Subject: [PATCH 14/27] Add more detailed comments about an MPAS subroutine --- src/dynamics/mpas/driver/dyn_mpas_subdriver.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/dynamics/mpas/driver/dyn_mpas_subdriver.F90 b/src/dynamics/mpas/driver/dyn_mpas_subdriver.F90 index eb1ad3c4..ca8e4159 100644 --- a/src/dynamics/mpas/driver/dyn_mpas_subdriver.F90 +++ b/src/dynamics/mpas/driver/dyn_mpas_subdriver.F90 @@ -3002,7 +3002,8 @@ subroutine dyn_mpas_run(self) call self % debug_print('Time integration of MPAS dynamical core ends at ' // trim(adjustl(date_time))) - ! Compute diagnostic variables like `pressure`, `rho` and `theta` by calling upstream MPAS functionality. + ! Compute diagnostic variables like `pressure`, `rho` and `theta` from time level 1 of MPAS `state` pool + ! by calling upstream MPAS functionality. call atm_compute_output_diagnostics(mpas_pool_state, 1, mpas_pool_diag, mpas_pool_mesh) nullify(config_dt) From b66368d5dfe003b59c0b54f28635ca1029026fdd Mon Sep 17 00:00:00 2001 From: Kuan-Chih Wang Date: Mon, 4 Nov 2024 14:16:05 -0700 Subject: [PATCH 15/27] Fix grammar in comments --- src/dynamics/mpas/dyn_comp.F90 | 6 +++--- src/dynamics/mpas/dyn_coupling.F90 | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index eec89488..3e512ad7 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -791,7 +791,7 @@ subroutine dyn_exchange_constituent_state(direction, exchange, conversion) logical, allocatable :: is_conversion_needed(:) logical, allocatable :: is_water_species(:) real(kind_phys), pointer :: constituents(:, :, :) ! This points to CCPP memory. - real(kind_r8), allocatable :: sigma_all_q(:) ! Summation of all water mixing ratio. + real(kind_r8), allocatable :: sigma_all_q(:) ! Summation of all water species mixing ratios. real(kind_r8), pointer :: scalars(:, :, :) ! This points to MPAS memory. select case (trim(adjustl(direction))) @@ -829,8 +829,8 @@ subroutine dyn_exchange_constituent_state(direction, exchange, conversion) 'dyn_comp', __LINE__) do j = 1, num_advected - ! All constituent mixing ratio in MPAS is dry. - ! Therefore, conversion in between is needed for any constituent mixing ratio that is not dry in CAM-SIMA. + ! All constituent mixing ratios in MPAS are dry. + ! Therefore, conversion in between is needed for any constituent mixing ratios that are not dry in CAM-SIMA. is_conversion_needed(j) = .not. const_is_dry(j) is_water_species(j) = const_is_water_species(j) end do diff --git a/src/dynamics/mpas/dyn_coupling.F90 b/src/dynamics/mpas/dyn_coupling.F90 index 2858e9ff..8d54e481 100644 --- a/src/dynamics/mpas/dyn_coupling.F90 +++ b/src/dynamics/mpas/dyn_coupling.F90 @@ -52,7 +52,7 @@ subroutine dynamics_to_physics_coupling() dp_col(:), & ! Full air pressure difference (Pa) between layer interfaces. dz_col(:) ! Geometric height difference (m) between layer interfaces. real(kind_r8), allocatable :: qv_mid_col(:), & ! Water vapor mixing ratio (kg kg-1). - sigma_all_q_mid_col(:) ! Summation of all water mixing ratio (kg kg-1). + sigma_all_q_mid_col(:) ! Summation of all water species mixing ratios (kg kg-1). real(kind_r8), allocatable :: rhod_mid_col(:), & ! Dry air density (kg m-3). rho_mid_col(:) ! Full air density (kg m-3). real(kind_r8), allocatable :: t_mid_col(:), & ! Temperature (K). From ee5cedb18d3f9107fb894b2976640047875b23b1 Mon Sep 17 00:00:00 2001 From: Kuan-Chih Wang Date: Mon, 4 Nov 2024 14:20:33 -0700 Subject: [PATCH 16/27] Only call `reverse` once per cell when performing conversion --- src/dynamics/mpas/dyn_comp.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index 3e512ad7..6b228ece 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -859,7 +859,7 @@ subroutine dyn_exchange_constituent_state(direction, exchange, conversion) ! The summation term of equation 8 in doi:10.1029/2017MS001257. ! Using equation 7 here is not possible because it requires all constituent mixing ratio to be moist ! on the RHS of it. There is no such guarantee in CAM-SIMA. - sigma_all_q(:) = phys_state % pdel(i, :) / phys_state % pdeldry(i, :) + sigma_all_q(:) = reverse(phys_state % pdel(i, :) / phys_state % pdeldry(i, :)) end if ! `j` is indexing into `scalars`, so it is regarded as MPAS scalar index. @@ -873,7 +873,7 @@ subroutine dyn_exchange_constituent_state(direction, exchange, conversion) if (conversion .and. is_conversion_needed(mpas_dynamical_core % map_constituent_index(j))) then ! Equation 8 in doi:10.1029/2017MS001257. scalars(j, :, i) = & - scalars(j, :, i) * reverse(sigma_all_q) + scalars(j, :, i) * sigma_all_q(:) end if end do end do @@ -884,7 +884,7 @@ subroutine dyn_exchange_constituent_state(direction, exchange, conversion) do i = 1, ncells_solve if (conversion .and. any(is_conversion_needed)) then ! The summation term of equation 8 in doi:10.1029/2017MS001257. - sigma_all_q(:) = 1.0_kind_r8 + sum(scalars(is_water_species_index, :, i), 1) + sigma_all_q(:) = reverse(1.0_kind_r8 + sum(scalars(is_water_species_index, :, i), 1)) end if ! `j` is indexing into `constituents`, so it is regarded as constituent index. @@ -898,7 +898,7 @@ subroutine dyn_exchange_constituent_state(direction, exchange, conversion) if (conversion .and. is_conversion_needed(j)) then ! Equation 8 in doi:10.1029/2017MS001257. constituents(i, :, j) = & - constituents(i, :, j) / reverse(sigma_all_q) + constituents(i, :, j) / sigma_all_q(:) end if end do end do From 122c64f642f3ddb211990a4f5fb6bc93f8617e98 Mon Sep 17 00:00:00 2001 From: Kuan-Chih Wang Date: Mon, 4 Nov 2024 14:28:33 -0700 Subject: [PATCH 17/27] Pass arguments by keywords for better clarity --- src/dynamics/mpas/dyn_comp.F90 | 2 +- src/dynamics/mpas/dyn_coupling.F90 | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index 6b228ece..c421b0e0 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -256,7 +256,7 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) ! the actual availability (checked and handled by MPAS). call dyn_debug_print('Calling dyn_exchange_constituent_state') - call dyn_exchange_constituent_state('e', .true., .false.) + call dyn_exchange_constituent_state(direction='e', exchange=.true., conversion=.false.) ! Namelist option that controls if constituents are to be read from the file. if (readtrace) then diff --git a/src/dynamics/mpas/dyn_coupling.F90 b/src/dynamics/mpas/dyn_coupling.F90 index 8d54e481..afa24f27 100644 --- a/src/dynamics/mpas/dyn_coupling.F90 +++ b/src/dynamics/mpas/dyn_coupling.F90 @@ -71,7 +71,7 @@ subroutine dynamics_to_physics_coupling() call init_shared_variable() - call dyn_exchange_constituent_state('i', .true., .false.) + call dyn_exchange_constituent_state(direction='i', exchange=.true., conversion=.false.) call dyn_debug_print('Setting physics state variables column by column') @@ -341,7 +341,7 @@ subroutine set_physics_state_external() end do ! Note that constituents become moist after this. - call dyn_exchange_constituent_state('i', .false., .true.) + call dyn_exchange_constituent_state(direction='i', exchange=.false., conversion=.true.) ! Impose minimum limits on constituents. call qneg_run(subname, ncells_solve, pver, minimum_constituents, constituents, ierr, cerr) @@ -392,7 +392,7 @@ subroutine physics_to_dynamics_coupling() call init_shared_variable() - call dyn_exchange_constituent_state('e', .true., .true.) + call dyn_exchange_constituent_state(direction='e', exchange=.true., conversion=.true.) call set_mpas_physics_tendency_ru() call set_mpas_physics_tendency_rho() From 679e9147e9c8f5472f6a4d8635ecc265c90292a8 Mon Sep 17 00:00:00 2001 From: Kuan-Chih Wang Date: Mon, 4 Nov 2024 14:34:09 -0700 Subject: [PATCH 18/27] Rename internal subroutines --- src/dynamics/mpas/dyn_comp.F90 | 16 +++++------ src/dynamics/mpas/dyn_coupling.F90 | 46 +++++++++++++++--------------- 2 files changed, 31 insertions(+), 31 deletions(-) diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index c421b0e0..2800c74b 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -365,7 +365,7 @@ subroutine set_analytic_initial_condition() real(kind_r8), pointer :: zgrid(:, :) ! Geometric height (meters) at layer interfaces. ! Dimension and vertical index orders follow MPAS convention. - call init_shared_variable() + call init_shared_variables() call set_mpas_state_u() call set_mpas_state_w() @@ -373,12 +373,12 @@ subroutine set_analytic_initial_condition() call set_mpas_state_rho_theta() call set_mpas_state_rho_base_theta_base() - call final_shared_variable() + call final_shared_variables() contains !> Initialize variables that are shared and repeatedly used by the `set_mpas_state_*` internal subroutines. !> (KCW, 2024-05-13) - subroutine init_shared_variable() - character(*), parameter :: subname = 'dyn_comp::set_analytic_initial_condition::init_shared_variable' + subroutine init_shared_variables() + character(*), parameter :: subname = 'dyn_comp::set_analytic_initial_condition::init_shared_variables' integer :: ierr integer :: i integer, pointer :: indextocellid(:) @@ -431,19 +431,19 @@ subroutine init_shared_variable() do i = 1, ncells_solve z_int(i, :) = reverse(zgrid(:, i)) end do - end subroutine init_shared_variable + end subroutine init_shared_variables !> Finalize variables that are shared and repeatedly used by the `set_mpas_state_*` internal subroutines. !> (KCW, 2024-05-13) - subroutine final_shared_variable() - character(*), parameter :: subname = 'dyn_comp::set_analytic_initial_condition::final_shared_variable' + subroutine final_shared_variables() + character(*), parameter :: subname = 'dyn_comp::set_analytic_initial_condition::final_shared_variables' deallocate(global_grid_index) deallocate(lat_rad, lon_rad) deallocate(z_int) nullify(zgrid) - end subroutine final_shared_variable + end subroutine final_shared_variables !> Set MPAS state `u` (i.e., horizontal velocity at edge interfaces). !> (KCW, 2024-05-13) diff --git a/src/dynamics/mpas/dyn_coupling.F90 b/src/dynamics/mpas/dyn_coupling.F90 index afa24f27..3ebc0818 100644 --- a/src/dynamics/mpas/dyn_coupling.F90 +++ b/src/dynamics/mpas/dyn_coupling.F90 @@ -69,7 +69,7 @@ subroutine dynamics_to_physics_coupling() real(kind_r8), pointer :: zgrid(:, :) real(kind_r8), pointer :: zz(:, :) - call init_shared_variable() + call init_shared_variables() call dyn_exchange_constituent_state(direction='i', exchange=.true., conversion=.false.) @@ -78,19 +78,19 @@ subroutine dynamics_to_physics_coupling() ! Set variables in the `physics_state` derived type column by column. ! This way, peak memory usage can be reduced. do column_index = 1, ncells_solve - call update_shared_variable(column_index) + call update_shared_variables(column_index) call set_physics_state_column(column_index) end do call set_physics_state_external() - call final_shared_variable() + call final_shared_variables() contains - !> Initialize variables that are shared and repeatedly used by the `update_shared_variable` and + !> Initialize variables that are shared and repeatedly used by the `update_shared_variables` and !> `set_physics_state_column` internal subroutines. !> (KCW, 2024-07-20) - subroutine init_shared_variable() - character(*), parameter :: subname = 'dyn_coupling::dynamics_to_physics_coupling::init_shared_variable' + subroutine init_shared_variables() + character(*), parameter :: subname = 'dyn_coupling::dynamics_to_physics_coupling::init_shared_variables' integer :: i integer :: ierr logical, allocatable :: is_water_species(:) @@ -165,13 +165,13 @@ subroutine init_shared_variable() call mpas_dynamical_core % get_variable_pointer(w, 'state', 'w', time_level=1) call mpas_dynamical_core % get_variable_pointer(zgrid, 'mesh', 'zgrid') call mpas_dynamical_core % get_variable_pointer(zz, 'mesh', 'zz') - end subroutine init_shared_variable + end subroutine init_shared_variables - !> Finalize variables that are shared and repeatedly used by the `update_shared_variable` and + !> Finalize variables that are shared and repeatedly used by the `update_shared_variables` and !> `set_physics_state_column` internal subroutines. !> (KCW, 2024-07-20) - subroutine final_shared_variable() - character(*), parameter :: subname = 'dyn_coupling::dynamics_to_physics_coupling::final_shared_variable' + subroutine final_shared_variables() + character(*), parameter :: subname = 'dyn_coupling::dynamics_to_physics_coupling::final_shared_variables' deallocate(is_water_species_index) deallocate(pd_int_col, pd_mid_col, p_int_col, p_mid_col, z_int_col) @@ -189,15 +189,15 @@ subroutine final_shared_variable() nullify(ucellzonal, ucellmeridional, w) nullify(zgrid) nullify(zz) - end subroutine final_shared_variable + end subroutine final_shared_variables !> Update variables for the specific column, indicated by `i`. This subroutine and `set_physics_state_column` !> should be called in pairs. !> (KCW, 2024-07-30) - subroutine update_shared_variable(i) + subroutine update_shared_variables(i) integer, intent(in) :: i - character(*), parameter :: subname = 'dyn_coupling::dynamics_to_physics_coupling::update_shared_variable' + character(*), parameter :: subname = 'dyn_coupling::dynamics_to_physics_coupling::update_shared_variables' integer :: k ! The summation term of equation 5 in doi:10.1029/2017MS001257. @@ -252,10 +252,10 @@ subroutine update_shared_variable(i) u_mid_col(:) = ucellzonal(:, i) v_mid_col(:) = ucellmeridional(:, i) omega_mid_col(:) = -rhod_mid_col(:) * constant_g * 0.5_kind_r8 * (w(1:pver, i) + w(2:pverp, i)) - end subroutine update_shared_variable + end subroutine update_shared_variables !> Set variables for the specific column, indicated by `i`, in the `physics_state` derived type. - !> This subroutine and `update_shared_variable` should be called in pairs. + !> This subroutine and `update_shared_variables` should be called in pairs. !> (KCW, 2024-07-30) subroutine set_physics_state_column(i) integer, intent(in) :: i @@ -390,7 +390,7 @@ subroutine physics_to_dynamics_coupling() real(kind_r8), pointer :: scalars(:, :, :) real(kind_r8), pointer :: zz(:, :) - call init_shared_variable() + call init_shared_variables() call dyn_exchange_constituent_state(direction='e', exchange=.true., conversion=.true.) @@ -398,12 +398,12 @@ subroutine physics_to_dynamics_coupling() call set_mpas_physics_tendency_rho() call set_mpas_physics_tendency_rtheta() - call final_shared_variable() + call final_shared_variables() contains !> Initialize variables that are shared and repeatedly used by the `set_mpas_physics_tendency_*` internal subroutines. !> (KCW, 2024-09-13) - subroutine init_shared_variable() - character(*), parameter :: subname = 'dyn_coupling::physics_to_dynamics_coupling::init_shared_variable' + subroutine init_shared_variables() + character(*), parameter :: subname = 'dyn_coupling::physics_to_dynamics_coupling::init_shared_variables' integer :: ierr call dyn_debug_print('Preparing for physics-dynamics coupling') @@ -426,12 +426,12 @@ subroutine init_shared_variable() ! Save water vapor mixing ratio before being updated by physics because `set_mpas_physics_tendency_rtheta` ! needs it. This must be done before calling `dyn_exchange_constituent_state`. qv_prev(:, :) = scalars(index_qv, :, 1:ncells_solve) - end subroutine init_shared_variable + end subroutine init_shared_variables !> Finalize variables that are shared and repeatedly used by the `set_mpas_physics_tendency_*` internal subroutines. !> (KCW, 2024-09-13) - subroutine final_shared_variable() - character(*), parameter :: subname = 'dyn_coupling::physics_to_dynamics_coupling::final_shared_variable' + subroutine final_shared_variables() + character(*), parameter :: subname = 'dyn_coupling::physics_to_dynamics_coupling::final_shared_variables' deallocate(qv_prev) @@ -439,7 +439,7 @@ subroutine final_shared_variable() nullify(rho_zz) nullify(scalars) nullify(zz) - end subroutine final_shared_variable + end subroutine final_shared_variables !> Set MPAS physics tendency `tend_ru_physics` (i.e., "coupled" tendency of horizontal velocity at edge interfaces !> due to physics). In MPAS, a "coupled" variable means that it is multiplied by a vertical metric term, `rho_zz`. From 8c3725cb062cdba0b0160cdf9d539c8e6c85d47a Mon Sep 17 00:00:00 2001 From: Kuan-Chih Wang Date: Mon, 4 Nov 2024 14:41:22 -0700 Subject: [PATCH 19/27] Include error codes and messages returned by external procedures --- src/dynamics/mpas/dyn_coupling.F90 | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/dynamics/mpas/dyn_coupling.F90 b/src/dynamics/mpas/dyn_coupling.F90 index 3ebc0818..d777789c 100644 --- a/src/dynamics/mpas/dyn_coupling.F90 +++ b/src/dynamics/mpas/dyn_coupling.F90 @@ -20,6 +20,7 @@ module dyn_coupling phys_state, phys_tend use qneg, only: qneg_run use static_energy, only: update_dry_static_energy_run + use string_utils, only: stringify ! Modules from CESM Share. use shr_kind_mod, only: kind_cx => shr_kind_cx, kind_r8 => shr_kind_r8 @@ -347,7 +348,9 @@ subroutine set_physics_state_external() call qneg_run(subname, ncells_solve, pver, minimum_constituents, constituents, ierr, cerr) if (ierr /= 0) then - call endrun('Failed to impose minimum limits on constituents externally', subname, __LINE__) + call endrun('Failed to impose minimum limits on constituents externally' // new_line('') // & + 'External procedure returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if ! Set `zi` (i.e., geopotential height at layer interfaces) and `zm` (i.e., geopotential height at layer midpoints). @@ -359,7 +362,9 @@ subroutine set_physics_state_external() constituent_properties, rairv, constant_g, zvirv, phys_state % zi, phys_state % zm, ncells_solve, ierr, cerr) if (ierr /= 0) then - call endrun('Failed to set variable "zi" and "zm" externally', subname, __LINE__) + call endrun('Failed to set variable "zi" and "zm" externally' // new_line('') // & + 'External procedure returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if ! Set `dse` (i.e., dry static energy). @@ -368,7 +373,9 @@ subroutine set_physics_state_external() pver, constant_g, phys_state % t, phys_state % zm, phys_state % phis, phys_state % dse, cpairv, ierr, cerr) if (ierr /= 0) then - call endrun('Failed to set variable "dse" externally', subname, __LINE__) + call endrun('Failed to set variable "dse" externally' // new_line('') // & + 'External procedure returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if deallocate(minimum_constituents) From 54378f0a29d7a3833661fdb229a064a3a19f340e Mon Sep 17 00:00:00 2001 From: Kuan-Chih Wang Date: Mon, 4 Nov 2024 14:43:22 -0700 Subject: [PATCH 20/27] Just use equation of state --- src/dynamics/mpas/dyn_coupling.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/dynamics/mpas/dyn_coupling.F90 b/src/dynamics/mpas/dyn_coupling.F90 index d777789c..158e0913 100644 --- a/src/dynamics/mpas/dyn_coupling.F90 +++ b/src/dynamics/mpas/dyn_coupling.F90 @@ -231,9 +231,9 @@ subroutine update_shared_variables(i) ! The numerator terms are just `tm_mid_col` here (i.e., modified "moist" temperature). tv_mid_col(:) = tm_mid_col(:) / sigma_all_q_mid_col(:) - ! Hydrostatic equation with equation of state plugged in and arranging for pressure. - pd_mid_col(:) = -constant_rd * t_mid_col(:) * dpd_col(:) / (constant_g * dz_col(:)) - p_mid_col(:) = -constant_rd * tv_mid_col(:) * dp_col(:) / (constant_g * dz_col(:)) + ! Equation of state. + pd_mid_col(:) = rhod_mid_col(:) * constant_rd * t_mid_col(:) + p_mid_col(:) = rho_mid_col(:) * constant_rd * tv_mid_col(:) ! By definition. p_int_col(pverp) = p_mid_col(pver) + 0.5_kind_r8 * dp_col(pver) From cf5ce82133fe883f17655415c0b6daaa1d01fe11 Mon Sep 17 00:00:00 2001 From: Kuan-Chih Wang Date: Mon, 4 Nov 2024 14:47:09 -0700 Subject: [PATCH 21/27] Do not assume no water at top of model This assumption does not always hold. --- src/dynamics/mpas/dyn_coupling.F90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/dynamics/mpas/dyn_coupling.F90 b/src/dynamics/mpas/dyn_coupling.F90 index 158e0913..f469dd63 100644 --- a/src/dynamics/mpas/dyn_coupling.F90 +++ b/src/dynamics/mpas/dyn_coupling.F90 @@ -236,11 +236,9 @@ subroutine update_shared_variables(i) p_mid_col(:) = rho_mid_col(:) * constant_rd * tv_mid_col(:) ! By definition. + pd_int_col(pverp) = pd_mid_col(pver) + 0.5_kind_r8 * dpd_col(pver) p_int_col(pverp) = p_mid_col(pver) + 0.5_kind_r8 * dp_col(pver) - ! Assume no water at top of model. - pd_int_col(pverp) = p_int_col(pverp) - ! Integrate downward. do k = pver, 1, -1 pd_int_col(k) = pd_int_col(k + 1) - dpd_col(k) From 81331442873166f48a2d569934440afdac43d6fd Mon Sep 17 00:00:00 2001 From: Kuan-Chih Wang Date: Mon, 4 Nov 2024 14:49:56 -0700 Subject: [PATCH 22/27] Add more detailed comments about equation derivation --- src/dynamics/mpas/dyn_coupling.F90 | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/src/dynamics/mpas/dyn_coupling.F90 b/src/dynamics/mpas/dyn_coupling.F90 index f469dd63..6757158f 100644 --- a/src/dynamics/mpas/dyn_coupling.F90 +++ b/src/dynamics/mpas/dyn_coupling.F90 @@ -599,6 +599,15 @@ pure elemental function t_of_theta_rhod_qv(theta, rhod, qv) result(t) ! described herein: ! The paragraph below equation 2.7 in doi:10.5065/1DFH-6P97. ! The paragraph below equation 2 in doi:10.1175/MWR-D-11-00215.1. + ! + ! In short, solve the below equation set for $T$ in terms of $\theta$, $\rho_d$ and $q_v$: + ! \begin{equation*} + ! \begin{cases} + ! \theta &= T (\frac{P_0}{P})^{\frac{R_d}{C_p}} \\ + ! P &= \rho_d R_d T_m \\ + ! T_m &= T (1 + \frac{R_v}{R_d} q_v) + ! \end{cases} + ! \end{equation*} t = (theta ** (constant_cpd / constant_cvd)) * & (((rhod * constant_rd * (1.0_kind_r8 + constant_rv / constant_rd * qv)) / constant_p0) ** & (constant_rd / constant_cvd)) @@ -624,6 +633,15 @@ pure elemental function theta_of_t_rhod_qv(t, rhod, qv) result(theta) ! described herein: ! The paragraph below equation 2.7 in doi:10.5065/1DFH-6P97. ! The paragraph below equation 2 in doi:10.1175/MWR-D-11-00215.1. + ! + ! In short, solve the below equation set for $\theta$ in terms of $T$, $\rho_d$ and $q_v$: + ! \begin{equation*} + ! \begin{cases} + ! \theta &= T (\frac{P_0}{P})^{\frac{R_d}{C_p}} \\ + ! P &= \rho_d R_d T_m \\ + ! T_m &= T (1 + \frac{R_v}{R_d} q_v) + ! \end{cases} + ! \end{equation*} theta = (t ** (constant_cvd / constant_cpd)) * & ((constant_p0 / (rhod * constant_rd * (1.0_kind_r8 + constant_rv / constant_rd * qv))) ** & (constant_rd / constant_cpd)) From 253fdce6ca3131f389c1c58abba7008dd090ae60 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Mon, 9 Dec 2024 09:37:44 -0700 Subject: [PATCH 23/27] Update regression tests to run! (#323) Tag name (required for release branches): sima0_00_001 Originator(s): peverwhee Description (include the issue title, and the keyword ['closes', 'fixes', 'resolves'] followed by the issue number): closes #229 (Need ability for ncdata_check routines to end model run) addresses #230 (Need CIME smoke tests for FPHYStest compset and various physics suites) **Updates the regression tests to actually run and compare against previous baselines.** Describe any changes made to build system: - added new compset FCAM7 that exercises the cam7 physics suites - updated config_pes.xml for ne3 grid Describe any changes made to the namelist: - updated namelist defaults for ne3 grid (though these are currently unused; using analytic_ic until the SE dycore is updated) List any changes to the defaults for the input datasets (e.g. boundary datasets): none List all files MOVED and why: cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_mpas_derecho_nooutput/user_nl_cam cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_mpas_derecho_nooutput/shell_commands cime_config/testdefs/testmods_dirs/cam/outfrq_held_suarez_derecho_nooutput/shell_commands cime_config/testdefs/testmods_dirs/cam/outfrq_held_suarez_derecho_nooutput/user_nl_cam cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_derecho_nooutput/shell_commands cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_derecho_nooutput/user_nl_cam cime_config/testdefs/testmods_dirs/cam/outfrq_tj2016_derecho_nooutput/user_nl_cam cime_config/testdefs/testmods_dirs/cam/outfrq_tj2016_derecho_nooutput/shell_commands - removed "nooutput" from directory name cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_se_cslam_derecho_nooutput/user_nl_cam cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_se_cslam_derecho_nooutput/shell_commands - moved to outfrq_se_sclam/* List all files added and what they do: A cime_config/config_archive.xml - brought over from CAM so tests will run List all existing files that have been modified, and describe the changes: (Helpful git command: `git diff --name-status development...`) M cime_config/config_component.xml - added FCAM7 configuration M cime_config/config_compset.xml - added FCAM7 compset M cime_config/config_pes.xml - modified for ne3 grid M cime_config/namelist_definition_cam.xml - added ne3 grid defaults M cime_config/testdefs/testlist_cam.xml - added FHS94 and FTJ16 SE CSLAM tests - modified existing FKESSLER SE CSLAM test to use ne5 M src/dynamics/tests/namelist_definition_analy_ic.xml - use held-suarez initial conditions by default (not "none") M src/physics/utils/phys_comp.F90 M src/physics/utils/physics_data.F90 - add namelist variable to endrun on diff found during ncdata_check M test/system/archive_baseline.sh - update to add a symlink to the ${baseline_dir}/latest_${CAM_FC} directory for easier test_driver usage - add flag to turn off symlink addition M test/system/test_driver.sh - use ${baseline_dir}/latest_${CAM_FC} by default - add flag to turn off default usage (no baseline comparison) If there are new failures (compared to the `test/existing-test-failures.txt` file), have them OK'd by the gatekeeper, note them here, and add them to the file. If there are baseline differences, include the test and the reason for the diff. What is the nature of the change? Roundoff? derecho/intel/aux_sima: SMS_Ln2.mpasa480_mpasa480.FKESSLER.derecho_intel.cam-outfrq_kessler_mpas_derecho - will fail until MPAS is fully integrated derecho/gnu/aux_sima: SMS_Ln2.mpasa480_mpasa480.FKESSLER.derecho_gnu.cam-outfrq_kessler_mpas_derecho - will fail until MPAS is fully integrated If this changes climate describe any run(s) done to evaluate the new climate in enough detail that it(they) could be reproduced: n/a CAM-SIMA date used for the baseline comparison tests if different than latest: first baselines! --- .gitmodules | 2 +- cime_config/config_archive.xml | 27 ++++++ cime_config/config_component.xml | 2 + cime_config/config_compsets.xml | 5 ++ cime_config/config_pes.xml | 37 ++++++++ cime_config/namelist_definition_cam.xml | 23 +++++ cime_config/testdefs/testlist_cam.xml | 62 ++++++++++--- .../shell_commands | 0 .../user_nl_cam | 7 +- .../shell_commands | 0 .../user_nl_cam | 9 +- .../shell_commands | 0 .../outfrq_kessler_mpas_derecho/user_nl_cam | 4 + .../user_nl_cam | 1 - .../shell_commands | 1 - .../user_nl_cam | 1 - .../cam/outfrq_se_cslam/shell_commands | 1 + .../cam/outfrq_se_cslam/user_nl_cam | 3 + .../outfrq_se_cslam_analy_ic/shell_commands | 2 + .../cam/outfrq_se_cslam_analy_ic/user_nl_cam | 4 + .../shell_commands | 1 + .../user_nl_cam | 7 ++ .../shell_commands | 2 +- .../user_nl_cam | 4 + src/data/write_init_files.py | 27 +++++- src/physics/ncar_ccpp | 2 +- src/physics/utils/phys_comp.F90 | 16 +++- src/physics/utils/physics_data.F90 | 11 ++- test/existing-test-failures.txt | 14 ++- test/system/archive_baseline.sh | 86 +++++++++++-------- test/system/test_driver.sh | 61 ++++++++----- .../write_init_files/physics_inputs_4D.F90 | 25 +++++- .../write_init_files/physics_inputs_bvd.F90 | 25 +++++- .../write_init_files/physics_inputs_cnst.F90 | 27 ++++-- .../write_init_files/physics_inputs_ddt.F90 | 27 ++++-- .../write_init_files/physics_inputs_ddt2.F90 | 27 ++++-- .../physics_inputs_ddt_array.F90 | 27 ++++-- .../physics_inputs_host_var.F90 | 25 +++++- .../write_init_files/physics_inputs_mf.F90 | 27 ++++-- .../physics_inputs_no_horiz.F90 | 25 +++++- .../write_init_files/physics_inputs_noreq.F90 | 23 ++++- .../write_init_files/physics_inputs_param.F90 | 27 ++++-- .../physics_inputs_protect.F90 | 27 ++++-- .../physics_inputs_scalar.F90 | 25 +++++- .../physics_inputs_simple.F90 | 27 ++++-- 45 files changed, 637 insertions(+), 149 deletions(-) create mode 100644 cime_config/config_archive.xml rename cime_config/testdefs/testmods_dirs/cam/{outfrq_held_suarez_derecho_nooutput => outfrq_held_suarez_derecho}/shell_commands (100%) rename cime_config/testdefs/testmods_dirs/cam/{outfrq_held_suarez_derecho_nooutput => outfrq_held_suarez_derecho}/user_nl_cam (50%) rename cime_config/testdefs/testmods_dirs/cam/{outfrq_kessler_derecho_nooutput => outfrq_kessler_derecho}/shell_commands (100%) rename cime_config/testdefs/testmods_dirs/cam/{outfrq_kessler_derecho_nooutput => outfrq_kessler_derecho}/user_nl_cam (61%) rename cime_config/testdefs/testmods_dirs/cam/{outfrq_kessler_mpas_derecho_nooutput => outfrq_kessler_mpas_derecho}/shell_commands (100%) create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_mpas_derecho/user_nl_cam delete mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_mpas_derecho_nooutput/user_nl_cam delete mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_se_cslam_derecho_nooutput/shell_commands delete mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_se_cslam_derecho_nooutput/user_nl_cam create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq_se_cslam/shell_commands create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq_se_cslam/user_nl_cam create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq_se_cslam_analy_ic/shell_commands create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq_se_cslam_analy_ic/user_nl_cam create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq_tj2016_after_coupler_derecho/shell_commands create mode 100644 cime_config/testdefs/testmods_dirs/cam/outfrq_tj2016_after_coupler_derecho/user_nl_cam rename cime_config/testdefs/testmods_dirs/cam/{outfrq_tj2016_derecho_nooutput => outfrq_tj2016_before_coupler_derecho}/shell_commands (87%) rename cime_config/testdefs/testmods_dirs/cam/{outfrq_tj2016_derecho_nooutput => outfrq_tj2016_before_coupler_derecho}/user_nl_cam (72%) diff --git a/.gitmodules b/.gitmodules index b6984f0f..fe5de260 100644 --- a/.gitmodules +++ b/.gitmodules @@ -20,7 +20,7 @@ [submodule "ncar-physics"] path = src/physics/ncar_ccpp url = https://github.com/ESCOMP/atmospheric_physics - fxtag = d46bb55e233e8f16b4e7a7b5a90352e99c7a5d72 + fxtag = 0ecfcc155ac0387ef9db3304611c6f3ef055ac1d fxrequired = AlwaysRequired fxDONOTUSEurl = https://github.com/ESCOMP/atmospheric_physics [submodule "ccs_config"] diff --git a/cime_config/config_archive.xml b/cime_config/config_archive.xml new file mode 100644 index 00000000..0a6a139e --- /dev/null +++ b/cime_config/config_archive.xml @@ -0,0 +1,27 @@ + + + + r + rh\d* + rs + h\d*.*\.nc$ + i\..*\.nc$ + e + nhfil + + rpointer.atm$NINST_STRING + $CASE.cam$NINST_STRING.r.$DATENAME.nc + + + rpointer.atm + rpointer.atm_9999 + casename.cam.r.1976-01-01-00000.nc + casename.cam.rh4.1976-01-01-00000.nc + casename.cam.h0.1976-01-01-00000.nc + casename.cam.h0.1976-01-01-00000.nc.base + casename.cam_0002.e.postassim.1976-01-01-00000.nc + casename.cam_0002.e.preassim.1976-01-01-00000.nc + casename.cam.i.1976-01-01-00000.nc + + + diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index c93a9de8..5805131c 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -8,6 +8,7 @@ CAM =============== --> + CAM cam7 physics: CAM cam6 physics: CAM cam5 physics: CAM cam4 physics: @@ -120,6 +121,7 @@ + --physics-suites cam7 diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index 972c0cd4..6a3df181 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -104,6 +104,11 @@ + + FCAM7 + 2000_CAM70_SLND_SICE_SOCN_SROF_SGLC_SWAV + + F2010climo 2010_CAM60_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV diff --git a/cime_config/config_pes.xml b/cime_config/config_pes.xml index bde96b4e..6d7bafe5 100644 --- a/cime_config/config_pes.xml +++ b/cime_config/config_pes.xml @@ -72,6 +72,43 @@ + + + + none + + 24 + 24 + 24 + 24 + 24 + 24 + 24 + 24 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + diff --git a/cime_config/namelist_definition_cam.xml b/cime_config/namelist_definition_cam.xml index ba8fbe40..fce70728 100644 --- a/cime_config/namelist_definition_cam.xml +++ b/cime_config/namelist_definition_cam.xml @@ -104,6 +104,15 @@ ${DIN_LOC_ROOT}/atm/cam/inic/gaus/cami_0000-01-01_8x16_L26_c030228.nc ${DIN_LOC_ROOT}/atm/cam/inic/gaus/cami_0000-09-01_8x16_L26_c030918.nc ${DIN_LOC_ROOT}/atm/cam/inic/gaus/cami_0000-01-01_8x16_L30_c090102.nc + ${DIN_LOC_ROOT}/atm/cam/inic/se/FCts4MTHIST_ne3pg3_spinup02.cam.i.1980-01-01_c240702.nc + ${DIN_LOC_ROOT}/atm/cam/inic/se/cam6_QPC6_topo_ne3pg3_mg37_L32_01-01-31_c221214.nc + ${DIN_LOC_ROOT}/atm/cam/inic/se/CESM2.F2000climo.ne3np4.cam.i.0003-09-01-00000.nc + ${DIN_LOC_ROOT}/atm/cam/inic/se/cami_0000-01-01_ne3np4_L30_c120315.nc + ${DIN_LOC_ROOT}/atm/cam/inic/se/cami_0000-01-01_ne3np4_L30_c120315.nc + ${DIN_LOC_ROOT}/atm/cam/inic/se/cami_0000-01-01_ne3np4_L26_c120525.nc + ${DIN_LOC_ROOT}/atm/cam/inic/se/cami_0000-01-01_ne3np4_L26_c120525.nc + ${DIN_LOC_ROOT}/atm/cam/inic/se/cam6_QPC6_topo_ne3pg3_mg37_L58_01-01-31_c221214.nc + ${DIN_LOC_ROOT}/atm/cam/inic/se/cam6_FMTHIST_ne3pg3_mg37_L93_79-02-01_c240517.nc ${DIN_LOC_ROOT}/atm/cam/inic/homme/cami-mam3_0000-01_ne5np4_L30.140707.nc ${DIN_LOC_ROOT}/atm/cam/inic/se/ape_topo_cam4_ne16np4_L26_c171020.nc ${DIN_LOC_ROOT}/atm/cam/inic/se/ape_topo_cam4_ne16np4_L30_c171020.nc @@ -208,6 +217,7 @@ ${DIN_LOC_ROOT}/atm/cam/topo/USGS-gtopo30_2.5x3.33_remap_c100204.nc ${DIN_LOC_ROOT}/atm/cam/topo/USGS-gtopo30_4x5_remap_c050520.nc ${DIN_LOC_ROOT}/atm/cam/topo/fv_10x15_nc0540_Nsw042_Nrs008_Co060_Fi001_20171220.nc + ${DIN_LOC_ROOT}/atm/cam/topo/se/ne3np4_gmted2010_modis_bedmachine_nc0540_Laplace1000_noleak_20230717.nc ${DIN_LOC_ROOT}/atm/cam/topo/se/ne5np4_nc3000_Co360_Fi001_MulG_PF_nullRR_Nsw064_20170515.nc ${DIN_LOC_ROOT}/atm/cam/topo/se/ne16np4_nc3000_Co120_Fi001_PF_nullRR_Nsw084_20171012.nc ${DIN_LOC_ROOT}/atm/cam/topo/se/ne30np4_nc3000_Co060_Fi001_PF_nullRR_Nsw042_20171020.nc @@ -219,6 +229,7 @@ ${DIN_LOC_ROOT}/atm/cam/topo/se/ne60pg2_nc3000_Co030_Fi001_PF_nullRR_Nsw021_20171014.nc ${DIN_LOC_ROOT}/atm/cam/topo/se/ne120pg2_nc3000_Co015_Fi001_PF_nullRR_Nsw010_20171012.nc ${DIN_LOC_ROOT}/atm/cam/topo/se/ne240pg2_nc3000_Co008_Fi001_PF_nullRR_Nsw005_20171014.nc + ${DIN_LOC_ROOT}/atm/cam/topo/se/ne3pg3_gmted2010_modis_bedmachine_nc0540_Laplace1000_noleak_20230209.nc ${DIN_LOC_ROOT}/atm/cam/topo/se/ne5pg3_nc3000_Co360_Fi001_MulG_PF_nullRR_Nsw064_20170516.nc ${DIN_LOC_ROOT}/atm/cam/topo/se/ne16pg3_nc3000_Co120_Fi001_PF_nullRR_Nsw084_20171012.nc ${DIN_LOC_ROOT}/atm/cam/topo/se/ne30pg3_nc3000_Co060_Fi001_PF_nullRR_Nsw042_20171014.nc @@ -252,6 +263,18 @@ UNSET_PATH + + logical + initial_conditions + physics_nl + + Flag to determine whether to endrun if the ncdata check fails. + Default: FALSE + + + .false. + + real diagnostics diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 3da26bdd..ef75f335 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -7,56 +7,98 @@ - + - + - + - + - + - + + + + + + + + + + + - + - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq_held_suarez_derecho_nooutput/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq_held_suarez_derecho/shell_commands similarity index 100% rename from cime_config/testdefs/testmods_dirs/cam/outfrq_held_suarez_derecho_nooutput/shell_commands rename to cime_config/testdefs/testmods_dirs/cam/outfrq_held_suarez_derecho/shell_commands diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq_held_suarez_derecho_nooutput/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq_held_suarez_derecho/user_nl_cam similarity index 50% rename from cime_config/testdefs/testmods_dirs/cam/outfrq_held_suarez_derecho_nooutput/user_nl_cam rename to cime_config/testdefs/testmods_dirs/cam/outfrq_held_suarez_derecho/user_nl_cam index f24f3126..17605757 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq_held_suarez_derecho_nooutput/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq_held_suarez_derecho/user_nl_cam @@ -1,4 +1,7 @@ -ncdata=/glade/campaign/cesm/community/amwg/sima_baselines/cam_sima_test_snapshots/cam_ne3pg3_held_suarez_snapshot_derecho_gnu_before.nc -ncdata_check=/glade/campaign/cesm/community/amwg/sima_baselines/cam_sima_test_snapshots/cam_ne3pg3_held_suarez_snapshot_derecho_gnu_after.nc +ncdata=/glade/campaign/cesm/community/amwg/sima_baselines/cam_sima_test_snapshots/cam_ne3pg3_held_suarez_snapshot_derecho_gnu_cam_before_c20240412.nc +ncdata_check=/glade/campaign/cesm/community/amwg/sima_baselines/cam_sima_test_snapshots/cam_ne3pg3_held_suarez_snapshot_derecho_gnu_cam_after_c20240412.nc debug_output=0 pver=30 +hist_add_inst_fields;h2: ZM, T +hist_output_frequency;h2: 2*nsteps +hist_write_nstep0;h2: .true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_derecho_nooutput/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_derecho/shell_commands similarity index 100% rename from cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_derecho_nooutput/shell_commands rename to cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_derecho/shell_commands diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_derecho_nooutput/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_derecho/user_nl_cam similarity index 61% rename from cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_derecho_nooutput/user_nl_cam rename to cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_derecho/user_nl_cam index 4d8d7750..e6881e64 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_derecho_nooutput/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_derecho/user_nl_cam @@ -1,4 +1,9 @@ -ncdata=/glade/campaign/cesm/community/amwg/sima_baselines/cam_sima_test_snapshots/cam_ne3pg3_kessler_snapshot_derecho_gnu_before.nc -ncdata_check=/glade/campaign/cesm/community/amwg/sima_baselines/cam_sima_test_snapshots/cam_ne3pg3_kessler_snapshot_derecho_gnu_after.nc +ncdata=/glade/campaign/cesm/community/amwg/sima_baselines/cam_sima_test_snapshots/cam_ne3pg3_kessler_snapshot_derecho_gnu_before_c20240412.nc +ncdata_check=/glade/campaign/cesm/community/amwg/sima_baselines/cam_sima_test_snapshots/cam_ne3pg3_kessler_snapshot_derecho_gnu_after_c20240412.nc +ncdata_check_err=.true. +min_difference=1.0e-15 debug_output=0 pver=30 +hist_add_inst_fields;h2: Q, T +hist_output_frequency;h2: 2*nsteps +hist_write_nstep0;h2: .true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_mpas_derecho_nooutput/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_mpas_derecho/shell_commands similarity index 100% rename from cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_mpas_derecho_nooutput/shell_commands rename to cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_mpas_derecho/shell_commands diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_mpas_derecho/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_mpas_derecho/user_nl_cam new file mode 100644 index 00000000..d4f431df --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_mpas_derecho/user_nl_cam @@ -0,0 +1,4 @@ +debug_output=0 +hist_add_inst_fields;h2: Q,T,U,V,PS +hist_output_frequency;h2: nsteps +hist_write_nstep0;h2: .true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_mpas_derecho_nooutput/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_mpas_derecho_nooutput/user_nl_cam deleted file mode 100644 index b9bb156a..00000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_mpas_derecho_nooutput/user_nl_cam +++ /dev/null @@ -1 +0,0 @@ -debug_output=0 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_se_cslam_derecho_nooutput/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_se_cslam_derecho_nooutput/shell_commands deleted file mode 100644 index e63aeb0a..00000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_se_cslam_derecho_nooutput/shell_commands +++ /dev/null @@ -1 +0,0 @@ - ./xmlchange CAM_LINKED_LIBS=" " diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_se_cslam_derecho_nooutput/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_se_cslam_derecho_nooutput/user_nl_cam deleted file mode 100644 index b9bb156a..00000000 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq_kessler_se_cslam_derecho_nooutput/user_nl_cam +++ /dev/null @@ -1 +0,0 @@ -debug_output=0 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq_se_cslam/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq_se_cslam/shell_commands new file mode 100644 index 00000000..bff4ca28 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq_se_cslam/shell_commands @@ -0,0 +1 @@ +./xmlchange CAM_LINKED_LIBS=" " diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq_se_cslam/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq_se_cslam/user_nl_cam new file mode 100644 index 00000000..30b04da7 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq_se_cslam/user_nl_cam @@ -0,0 +1,3 @@ +hist_add_inst_fields;h1: T, Q, U, V, PS +hist_output_frequency;h1: 1*nsteps +hist_write_nstep0;h1: .true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq_se_cslam_analy_ic/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq_se_cslam_analy_ic/shell_commands new file mode 100644 index 00000000..97df00e3 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq_se_cslam_analy_ic/shell_commands @@ -0,0 +1,2 @@ +./xmlchange CAM_LINKED_LIBS=" " +./xmlchange --append CAM_CONFIG_OPTS="--analytic_ic" diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq_se_cslam_analy_ic/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq_se_cslam_analy_ic/user_nl_cam new file mode 100644 index 00000000..ddd9f580 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq_se_cslam_analy_ic/user_nl_cam @@ -0,0 +1,4 @@ +hist_add_inst_fields;h1: T, Q, U, V, PS +hist_output_frequency;h1: 1*nsteps +hist_write_nstep0;h1: .true. +analytic_ic_type=held_suarez_1994 diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq_tj2016_after_coupler_derecho/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq_tj2016_after_coupler_derecho/shell_commands new file mode 100644 index 00000000..2e06620f --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq_tj2016_after_coupler_derecho/shell_commands @@ -0,0 +1 @@ + ./xmlchange CAM_CONFIG_OPTS="--dyn none --physics-suites tj2016_sfc_pbl_hs" diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq_tj2016_after_coupler_derecho/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq_tj2016_after_coupler_derecho/user_nl_cam new file mode 100644 index 00000000..c46f586a --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq_tj2016_after_coupler_derecho/user_nl_cam @@ -0,0 +1,7 @@ +ncdata=/glade/campaign/cesm/community/amwg/sima_baselines/cam_sima_test_snapshots/cam_tj2016_sfc_pbl_hs_ne3pg3mg37_derecho_gnu_before.nc +ncdata_check=/glade/campaign/cesm/community/amwg/sima_baselines/cam_sima_test_snapshots/cam_tj2016_sfc_pbl_hs_ne3pg3mg37_derecho_gnu_after.nc +debug_output=0 +pver=30 +hist_add_inst_fields;h2: Q, T +hist_output_frequency;h2: 2*nsteps +hist_write_nstep0;h2: .true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq_tj2016_derecho_nooutput/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq_tj2016_before_coupler_derecho/shell_commands similarity index 87% rename from cime_config/testdefs/testmods_dirs/cam/outfrq_tj2016_derecho_nooutput/shell_commands rename to cime_config/testdefs/testmods_dirs/cam/outfrq_tj2016_before_coupler_derecho/shell_commands index 1ff03d8f..a5284d83 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq_tj2016_derecho_nooutput/shell_commands +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq_tj2016_before_coupler_derecho/shell_commands @@ -1 +1 @@ - ./xmlchange CAM_CONFIG_OPTS="--dyn none --physics-suites tj2016" + ./xmlchange CAM_CONFIG_OPTS="--dyn none --physics-suites tj2016_precip" diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq_tj2016_derecho_nooutput/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq_tj2016_before_coupler_derecho/user_nl_cam similarity index 72% rename from cime_config/testdefs/testmods_dirs/cam/outfrq_tj2016_derecho_nooutput/user_nl_cam rename to cime_config/testdefs/testmods_dirs/cam/outfrq_tj2016_before_coupler_derecho/user_nl_cam index 28c39fd6..b2672dbf 100644 --- a/cime_config/testdefs/testmods_dirs/cam/outfrq_tj2016_derecho_nooutput/user_nl_cam +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq_tj2016_before_coupler_derecho/user_nl_cam @@ -1,4 +1,8 @@ ncdata=/glade/campaign/cesm/community/amwg/sima_baselines/cam_sima_test_snapshots/cam_tj2016_precip_tend_ne3pg3mg37_derecho_gnu_before.nc ncdata_check=/glade/campaign/cesm/community/amwg/sima_baselines/cam_sima_test_snapshots/cam_tj2016_precip_tend_ne3pg3mg37_derecho_gnu_after.nc +ncdata_check_err=.true. debug_output=0 pver=30 +hist_add_inst_fields;h2: Q, T +hist_output_frequency;h2: 2*nsteps +hist_write_nstep0;h2: .true. diff --git a/src/data/write_init_files.py b/src/data/write_init_files.py index b0f92d1c..f96cccde 100644 --- a/src/data/write_init_files.py +++ b/src/data/write_init_files.py @@ -1192,7 +1192,7 @@ def write_phys_check_subroutine(outfile, host_dict, host_vars, host_imports, call_str += f"'{levnm}', " # end if call_str += f"timestep, {var_locname}, '{var_stdname}', " - call_str += "min_difference, min_relative_value, is_first)" + call_str += "min_difference, min_relative_value, is_first, diff_found)" else: call_str = f"call endrun('Cannot check status of {var_locname}'" + \ f"//', {reason}')" @@ -1207,7 +1207,7 @@ def write_phys_check_subroutine(outfile, host_dict, host_vars, host_imports, # Add subroutine header: outfile.write("subroutine physics_check_data(file_name, suite_names, " + \ - "timestep, min_difference, min_relative_value)", 1) + "timestep, min_difference, min_relative_value, err_on_fail)", 1) use_stmts = [["pio", ["file_desc_t", "pio_nowrite"]], ["cam_abortutils", ["endrun"]], @@ -1245,6 +1245,7 @@ def write_phys_check_subroutine(outfile, host_dict, host_vars, host_imports, outfile.write("integer, intent(in) :: timestep", 2) outfile.write("real(kind_phys), intent(in) :: min_difference", 2) outfile.write("real(kind_phys), intent(in) :: min_relative_value", 2) + outfile.write("logical, intent(in) :: err_on_fail", 2) outfile.blank_line() # Write local variable declarations: @@ -1273,6 +1274,8 @@ def write_phys_check_subroutine(outfile, host_dict, host_vars, host_imports, outfile.write("logical :: file_found", 2) outfile.write("logical :: is_first", 2) outfile.write("logical :: is_read", 2) + outfile.write("logical :: diff_found", 2) + outfile.write("logical :: overall_diff_found", 2) outfile.write("character(len=std_name_len) :: std_name !Variable to hold constiutent standard name", 2) outfile.write("real(kind=kind_phys), pointer :: field_data_ptr(:,:,:)", 2) outfile.write("type(ccpp_constituent_prop_ptr_t), pointer :: const_props(:)", 2) @@ -1286,6 +1289,7 @@ def write_phys_check_subroutine(outfile, host_dict, host_vars, host_imports, outfile.write("missing_input_names = ' '", 2) outfile.write("nullify(file)", 2) outfile.write("is_first = .true.", 2) + outfile.write("overall_diff_found = .false.", 2) outfile.blank_line() # Begin check data log: @@ -1360,6 +1364,9 @@ def write_phys_check_subroutine(outfile, host_dict, host_vars, host_imports, outfile.write(read_call, 6) outfile.blank_line() outfile.write("end select !check variables", 5) + outfile.write("if (diff_found) then", 5) + outfile.write("overall_diff_found = .true.", 6) + outfile.write("end if", 5) outfile.write("end if !check if constituent", 4) # End select case and required variables loop: @@ -1390,10 +1397,16 @@ def write_phys_check_subroutine(outfile, host_dict, host_vars, host_imports, outfile.write("exit", 6) outfile.write("end if", 5) outfile.write("end do", 4) - outfile.write("call check_field(file, input_var_names(:,const_input_idx), 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, min_difference, min_relative_value, is_first)", 4) + outfile.write("call check_field(file, input_var_names(:,const_input_idx), 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, min_difference, min_relative_value, is_first, diff_found)", 4) + outfile.write("if (diff_found) then", 4) + outfile.write("overall_diff_found = .true.", 5) + outfile.write("end if", 4) outfile.write("else", 3) outfile.comment("If not in standard names list, then just use constituent name as input file name:",4) - outfile.write("call check_field(file, [std_name], 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, min_difference, min_relative_value, is_first)", 4) + outfile.write("call check_field(file, [std_name], 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, min_difference, min_relative_value, is_first, diff_found)", 4) + outfile.write("if (diff_found) then", 4) + outfile.write("overall_diff_found = .true.", 5) + outfile.write("end if", 4) outfile.write("end if", 3) outfile.write("end do", 2) @@ -1419,6 +1432,12 @@ def write_phys_check_subroutine(outfile, host_dict, host_vars, host_imports, outfile.write("write(iulog,*) ''", 3) outfile.write("end if", 2) + # Endrun if differences were found on this timestep + outfile.comment("Endrun if differences were found on this timestep and err_on_fail=TRUE", 2) + outfile.write("if (overall_diff_found .and. err_on_fail .and. masterproc) then", 2) + outfile.write("call endrun('ERROR: Difference(s) found during ncdata check', file=__FILE__, line=__LINE__)", 3) + outfile.write("end if", 2) + # End subroutine: outfile.write("end subroutine physics_check_data", 1) diff --git a/src/physics/ncar_ccpp b/src/physics/ncar_ccpp index 29c7663a..0ecfcc15 160000 --- a/src/physics/ncar_ccpp +++ b/src/physics/ncar_ccpp @@ -1 +1 @@ -Subproject commit 29c7663a68d9b66bfe7926a56a595dbcbf2c385c +Subproject commit 0ecfcc155ac0387ef9db3304611c6f3ef055ac1d diff --git a/src/physics/utils/phys_comp.F90 b/src/physics/utils/phys_comp.F90 index e01f6a1a..5dbfc20a 100644 --- a/src/physics/utils/phys_comp.F90 +++ b/src/physics/utils/phys_comp.F90 @@ -27,6 +27,7 @@ module phys_comp character(len=SHR_KIND_CS) :: suite_parts_expect(2) = (/"physics_before_coupler", "physics_after_coupler "/) character(len=SHR_KIND_CS), allocatable :: suite_parts(:) character(len=SHR_KIND_CL) :: ncdata_check = unset_str + logical :: ncdata_check_err = .false. character(len=SHR_KIND_CL) :: cam_physics_mesh = unset_str character(len=SHR_KIND_CS) :: cam_take_snapshot_before = unset_str character(len=SHR_KIND_CS) :: cam_take_snapshot_after = unset_str @@ -40,7 +41,7 @@ module phys_comp subroutine phys_readnl(nlfilename) ! Read physics options, such as suite to run use shr_nl_mod, only: find_group_name => shr_nl_find_group_name - use mpi, only: mpi_character, mpi_real8 + use mpi, only: mpi_character, mpi_real8, mpi_logical use spmd_utils, only: masterproc, masterprocid, mpicom use cam_logfile, only: iulog use cam_abortutils, only: endrun @@ -58,7 +59,7 @@ subroutine phys_readnl(nlfilename) namelist /physics_nl/ ncdata_check, min_difference, min_relative_value,& cam_take_snapshot_before, cam_take_snapshot_after, cam_physics_mesh,& - physics_suite + physics_suite, ncdata_check_err ! Initialize namelist variables to invalid values min_difference = HUGE(1.0_kind_phys) @@ -68,6 +69,7 @@ subroutine phys_readnl(nlfilename) cam_physics_mesh = unset_path_str ncdata_check = unset_path_str physics_suite = unset_str + ncdata_check_err = .false. ! Read namelist if (masterproc) then @@ -97,6 +99,8 @@ subroutine phys_readnl(nlfilename) mpi_character, masterprocid, mpicom, ierr) call mpi_bcast(physics_suite, len(physics_suite),& mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(ncdata_check_err, 1, mpi_logical, masterprocid, & + mpicom, ierr) ! Check that the listed physics suite is actually present ! in the CCPP physics suite list: @@ -118,6 +122,11 @@ subroutine phys_readnl(nlfilename) if (trim(ncdata_check) /= trim(unset_path_str)) then write(iulog,*) ' Physics data check will be performed against: ',& trim(ncdata_check) + if (ncdata_check_err) then + write(iulog,*) ' Model will endrun if the physics data check fails' + else + write(iulog,*) ' Model will NOT endrun if the physics data check fails' + end if write(iulog,*) 'Minimum Difference considered significant: ', & min_difference write(iulog,*) 'Value Under Which Absolute Difference Calculated: ', & @@ -275,7 +284,8 @@ subroutine phys_timestep_final(do_ncdata_check) if (trim(ncdata_check) /= trim(unset_path_str)) then if (do_ncdata_check) then call physics_check_data(ncdata_check, suite_names, data_frame, & - min_difference, min_relative_value) + min_difference, min_relative_value, & + ncdata_check_err) end if end if diff --git a/src/physics/utils/physics_data.F90 b/src/physics/utils/physics_data.F90 index 62070f9f..4699fc0d 100644 --- a/src/physics/utils/physics_data.F90 +++ b/src/physics/utils/physics_data.F90 @@ -326,7 +326,7 @@ subroutine read_field_3d(file, std_name, var_names, vcoord_name, & end subroutine read_field_3d subroutine check_field_2d(file, var_names, timestep, current_value, & - stdname, min_difference, min_relative_value, is_first) + stdname, min_difference, min_relative_value, is_first, diff_found) use pio, only: file_desc_t, var_desc_t use spmd_utils, only: masterproc, masterprocid use spmd_utils, only: mpicom, iam @@ -348,6 +348,7 @@ subroutine check_field_2d(file, var_names, timestep, current_value, & real(kind_phys), intent(in) :: min_difference real(kind_phys), intent(in) :: min_relative_value logical, intent(inout) :: is_first + logical, intent(out) :: diff_found !Local variables: logical :: var_found @@ -375,6 +376,7 @@ subroutine check_field_2d(file, var_names, timestep, current_value, & diff = 0._kind_phys max_diff(1) = 0._kind_phys max_diff(2) = real(iam, kind_phys) !MPI rank for this task + diff_found = .false. call cam_pio_find_var(file, var_names, found_name, vardesc, var_found) if (.not. var_found) then @@ -437,6 +439,7 @@ subroutine check_field_2d(file, var_names, timestep, current_value, & int(max_diff_gl(2)), & max_diff_gl_col, is_first) is_first = .false. + diff_found = .true. end if end if end if @@ -445,7 +448,8 @@ subroutine check_field_2d(file, var_names, timestep, current_value, & end subroutine check_field_2d subroutine check_field_3d(file, var_names, vcoord_name, timestep, & - current_value, stdname, min_difference, min_relative_value, is_first) + current_value, stdname, min_difference, min_relative_value, is_first, & + diff_found) use shr_sys_mod, only: shr_sys_flush use pio, only: file_desc_t, var_desc_t use spmd_utils, only: masterproc, masterprocid @@ -470,6 +474,7 @@ subroutine check_field_3d(file, var_names, vcoord_name, timestep, & real(kind_phys), intent(in) :: min_difference real(kind_phys), intent(in) :: min_relative_value logical, intent(inout) :: is_first + logical, intent(out) :: diff_found !Local variables: logical :: var_found = .true. @@ -503,6 +508,7 @@ subroutine check_field_3d(file, var_names, vcoord_name, timestep, & diff = 0._kind_phys max_diff(1) = 0._kind_phys max_diff(2) = real(iam, kind_phys) !MPI rank for this task + diff_found = .false. call cam_pio_find_var(file, var_names, found_name, vardesc, var_found) if (.not. var_found) then @@ -586,6 +592,7 @@ subroutine check_field_3d(file, var_names, vcoord_name, timestep, & is_first, & max_diff_lev=max_diff_gl_lev) is_first = .false. + diff_found = .true. end if end if end if diff --git a/test/existing-test-failures.txt b/test/existing-test-failures.txt index 92c15920..253b5633 100644 --- a/test/existing-test-failures.txt +++ b/test/existing-test-failures.txt @@ -1 +1,13 @@ -No test failures +SMS_Ln2.mpasa480_mpasa480.FKESSLER.derecho_intel.cam-outfrq_kessler_mpas_derecho (Overall: FAIL) +SMS_Ln2.mpasa480_mpasa480.FKESSLER.derecho_gnu.cam-outfrq_kessler_mpas_derecho (Overall: FAIL) + - will fail until MPAS is fully integrated + +SMS_Ln9.ne5pg3_ne5pg3_mg37.FTJ16.derecho_intel.cam-outfrq_se_cslam (Overall: FAIL) +SMS_Ln9.ne5pg3_ne5pg3_mg37.FKESSLER.derecho_intel.cam-outfrq_se_cslam (Overall: FAIL) +SMS_Ln2.ne3pg3_ne3pg3_mg37.FPHYStest.derecho_intel.cam-outfrq_kessler_derecho (Overall: FAIL) +SMS_Ln9.ne5pg3_ne5pg3_mg37.FCAM7.derecho_intel.cam-outfrq_se_cslam_analy_ic (Overall: FAIL) +SMS_Ln9.ne5pg3_ne5pg3_mg37.FTJ16.derecho_gnu.cam-outfrq_se_cslam (Overall: FAIL) +SMS_Ln9.ne5pg3_ne5pg3_mg37.FKESSLER.derecho_gnu.cam-outfrq_se_cslam (Overall: FAIL) +SMS_Ln2.ne3pg3_ne3pg3_mg37.FPHYStest.derecho_gnu.cam-outfrq_kessler_derecho (Overall: FAIL) +SMS_Ln9.ne5pg3_ne5pg3_mg37.FCAM7.derecho_gnu.cam-outfrq_se_cslam_analy_ic (Overall: FAIL) + - will fail until https://github.com/ESCOMP/CAM-SIMA/pull/316 is merged diff --git a/test/system/archive_baseline.sh b/test/system/archive_baseline.sh index e72814ad..4adfa25d 100755 --- a/test/system/archive_baseline.sh +++ b/test/system/archive_baseline.sh @@ -1,13 +1,6 @@ #!/bin/sh -f -echo - -if [ $# -ne 1 ]; then - echo "Invoke archive_baseline.sh -help for usage." - exit 1 -fi - -if [ $1 == "-help" ] || [ $1 == "--help" ]; then +show_help() { cat << EOF1 NAME @@ -17,14 +10,14 @@ NAME SYNOPSIS - archive_baseline.sh TAGNAME - [-help] + archive_baseline.sh TAGNAME [--no-symlink] + [--help] ENVIROMENT VARIABLES CESM_TESTDIR - Directory that contains the CESM finished results you wish to archive. - CAM_FC - Compiler used, used on izumi and derecho (GNU,NAG), where the compiler + CAM_FC - Compiler used, used on izumi and derecho (GNU,NAG,INTEL,NVHPC), where the compiler name is appended to the archive directory. @@ -35,31 +28,23 @@ BASELINE ARCHIVED LOCATION derecho: /glade/campaign/cesm/community/amwg/sima_baselines/TAGNAME - -HOW TO USE ARCHIVE BASELINES - - Set BL_TESTDIR to the archived baseline you wish to load. +SYMLINK + By default, this script will create a symlink between the new baseline directory and + $baseline_dir/latest_${CAM_FC} so that future tests can be run against these baselines + until the next baselines are established. If you'd like to not create the symlink (e.g. + you are archiving old baselines), use the "--no-symlink" argument. WORK FLOW - This is an example for izumi. + This is an example for derecho. Modify your sandbox with the changes you want. - setenv CAM_FC GNU - setenv CAM_TESTDIR /scratch/cluster/fischer/cam5_2_06 - Run the cam test suite. + Run the sima test suite. Make your trunk tag - archive_baseline.sh cam5_2_06 - - Create a new sandbox. setenv CAM_FC GNU - setenv CAM_TESTDIR /scratch/cluster/fischer/cam5_2_07 - setenv BL_TESTDIR /fs/cgd/csm/models/atm/sima/pretag_bl/cam5_2_06_gnu - Run the cam test suite. - Make your trunk tag - archive_baseline.sh cam5_2_07 - + setenv CESM_TESTDIR /scratch/cluster/fischer/aux_sima_gnu_20241113133750 + ./archive_baseline.sh sima0_00_001 WARNING @@ -67,10 +52,40 @@ WARNING if you are getting unexpected baseline failures. EOF1 -exit -fi +} +symlink=true hostname=`hostname` + +# Parse arguments +while [[ $# -gt 0 ]]; do + case "$1" in + --no-symlink) + symlink=false + shift + ;; + -h|--help) + show_help + exit 0 + ;; + -*) + echo "Unknown option: $1" + show_help + exit 1 + ;; + *) + # Assume the first non-flag argument is the tag + if [ -z "$cam_tag" ]; then + cam_tag="$1" + else + echo "Unexpected argument: $1" + show_help + exit 1 + fi + shift + esac +done + case $hostname in iz*) @@ -78,8 +93,7 @@ case $hostname in if [ -z "$CAM_FC" ]; then CAM_FC="GNU" fi - test_file_list="tests_pretag_izumi_${CAM_FC,,}" - cam_tag=$1_${CAM_FC,,} + cam_tag=${cam_tag}_${CAM_FC,,} baselinedir="/fs/cgd/csm/models/atm/sima/pretag_bl/$cam_tag" ;; @@ -88,8 +102,7 @@ case $hostname in if [ -z "$CAM_FC" ]; then CAM_FC="INTEL" fi - test_file_list="tests_pretag_derecho" - cam_tag=$1 + cam_tag=${cam_tag}_${CAM_FC,,} baselinedir="/glade/campaign/cesm/community/amwg/sima_baselines/$cam_tag" ;; @@ -110,6 +123,11 @@ if [ -n "$CESM_TESTDIR" ]; then if [ -d $CESM_TESTDIR/baselines ]; then echo "Using cp to archive baselines." cp -r $CESM_TESTDIR/baselines/. $root_baselinedir/$cam_tag + chmod -R a+r ${baselinedir} + if [ "${symlink}" = true ]; then + echo "Establishing symlink from '$root_baselinedir/latest_${CAM_FC,,}' to '$root_baselinedir/$cam_tag'" + ln -sfn $root_baselinedir/$cam_tag $root_baselinedir/latest_${CAM_FC,,} + fi else echo "Using bless_test_results to archive baselines." ../../cime/CIME/Tools/bless_test_results -p -t '' -c '' -r $CESM_TESTDIR --baseline-root $root_baselinedir -b $cam_tag -f -s diff --git a/test/system/test_driver.sh b/test/system/test_driver.sh index c0dc78ae..f0c0b2e8 100755 --- a/test/system/test_driver.sh +++ b/test/system/test_driver.sh @@ -26,6 +26,7 @@ help () { echo "${hprefix} [ -j ] (number of jobs for gmake)" echo "${hprefix} [ --baseline-dir ] (directory for saving baselines of cime tests)" echo "${hprefix} [ --no-baseline] (baselines of cime tests are not saved)" + echo "${hprefix} [ --no-bl-compare] (turns off default baseline path)" echo "${hprefix} [ --xml-driver ] (mct or nuopc)" echo "${hprefix} [ --cesm ] (default aux_sima)" echo "${hprefix} [ --rerun-cesm ] (rerun the cesm tests with the --use-existing-flag)" @@ -36,7 +37,7 @@ help () { echo "${hprefix} 'env var1=setting var2=setting '" echo "" echo "Supported ENVIRONMENT variables" - echo "BL_TESTDIR: Default = none (used to set baseline compare dir)" + echo "BL_TESTDIR: Default = latest_[CAM_FC] (used to set baseline compare dir)" echo "CAM_ACCOUNT: Default = none" echo "CAM_BATCHQ: Default = machine dependent" echo "CAM_FC: Default = machine dependent" @@ -80,6 +81,7 @@ interactive=false use_existing='' namelists_only=false batch=false +baseline_default=true # Understand where we are and where the CAM root and CIME reside if [ -n "${CAM_ROOT}" ]; then @@ -132,6 +134,9 @@ while [ "${1:0:1}" == "-" ]; do --no-baseline ) no_baseline=false ;; + --no-bl-compare ) baseline_default=false + ;; + -b ) export CAM_BASEBACK="YES" ;; @@ -253,12 +258,17 @@ case $hostname in CAM_RESTART_THREADS=1 mach_workspace="/glade/derecho/scratch" + default_bl_dir="/glade/campaign/cesm/community/amwg/sima_baselines/latest_${CAM_FC,,}" -#### # Check for CESM baseline directory -#### if [ -n "${BL_TESTDIR}" ] && [ ! -d "${BL_TESTDIR}" ]; then -#### echo "CESM_BASELINE ${BL_TESTDIR} not found. Check BL_TESTDIR for correct tag name." -#### exit 3 -#### fi + # Check for CESM baseline directory + if [ -z "${BL_TESTDIR}" ] && [ "${baseline_default}" = true ]; then + echo "using default BL_TESTDIR of ${default_bl_dir}" + BL_TESTDIR=$default_bl_dir + fi + if [ -n "${BL_TESTDIR}" ] && [ ! -d "${BL_TESTDIR}" ]; then + echo "CESM_BASELINE ${BL_TESTDIR} not found. Check BL_TESTDIR for correct tag name." + exit 3 + fi #------------------------------------------- @@ -306,11 +316,11 @@ EOF mach_workspace="/scratch/cluster" -#### # Check for CESM baseline directory -#### if [ -n "{$BL_TESTDIR}" ] && [ ! -d "${BL_TESTDIR}" ]; then -#### echo "CESM_BASELINE ${BL_TESTDIR} not found. Check BL_TESTDIR for correct tag name." -#### exit -#### fi + # Check for CESM baseline directory + if [ -n "{$BL_TESTDIR}" ] && [ ! -d "${BL_TESTDIR}" ]; then + echo "CESM_BASELINE ${BL_TESTDIR} not found. Check BL_TESTDIR for correct tag name." + exit + fi #------------------------------------------- @@ -362,12 +372,19 @@ EOF fi mach_workspace="/scratch/cluster" + default_bl_dir="/fs/cgd/csm/models/atm/sima/pretag_bl/latest_${CAM_FC,,}" -#### # Check for CESM baseline directory -#### if [ -n "{$BL_TESTDIR}" ] && [ ! -d "${BL_TESTDIR}" ]; then -#### echo "CESM_BASELINE ${BL_TESTDIR} not found. Check BL_TESTDIR for correct tag name." -#### exit -#### fi + # Check for CESM baseline directory + if [ -z "${BL_TESTDIR}" ] && [ "${baseline_default}" = true ]; then + echo "using default BL_TESTDIR of ${default_bl_dir}" + BL_TESTDIR=$default_bl_dir + fi + + # Check for CESM baseline directory + if [ -n "{$BL_TESTDIR}" ] && [ ! -d "${BL_TESTDIR}" ]; then + echo "CESM_BASELINE ${BL_TESTDIR} not found. Check BL_TESTDIR for correct tag name." + exit + fi #------------------------------------------- @@ -421,11 +438,11 @@ EOF mach_workspace="/glade/scratch" -#### # Check for CESM baseline directory -#### if [ -n "${BL_TESTDIR}" ] && [ ! -d "${BL_TESTDIR}" ]; then -#### echo "CESM_BASELINE ${BL_TESTDIR} not found. Check BL_TESTDIR for correct tag name." -#### exit -#### fi + # Check for CESM baseline directory + if [ -n "${BL_TESTDIR}" ] && [ ! -d "${BL_TESTDIR}" ]; then + echo "CESM_BASELINE ${BL_TESTDIR} not found. Check BL_TESTDIR for correct tag name." + exit + fi #------------------------------------------- @@ -475,7 +492,7 @@ if [ "${cesm_test_suite}" != "none" -a -n "${cesm_test_mach}" ]; then for cesm_test in ${cesm_test_suite}; do - testargs="--xml-category ${cesm_test} --xml-machine ${cesm_test_mach} --retry 2 --no-run" + testargs="--xml-category ${cesm_test} --xml-machine ${cesm_test_mach} --retry 2" if [ -n "${use_existing}" ]; then test_id="${use_existing}" diff --git a/test/unit/sample_files/write_init_files/physics_inputs_4D.F90 b/test/unit/sample_files/write_init_files/physics_inputs_4D.F90 index 250179c8..f7b78f09 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_4D.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_4D.F90 @@ -226,7 +226,7 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia end subroutine physics_read_data - subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value) + subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value, err_on_fail) use pio, only: file_desc_t, pio_nowrite use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX @@ -249,6 +249,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, integer, intent(in) :: timestep real(kind_phys), intent(in) :: min_difference real(kind_phys), intent(in) :: min_relative_value + logical, intent(in) :: err_on_fail ! Local variables: @@ -273,6 +274,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, logical :: file_found logical :: is_first logical :: is_read + logical :: diff_found + logical :: overall_diff_found character(len=std_name_len) :: std_name !Variable to hold constiutent standard name real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) type(ccpp_constituent_prop_ptr_t), pointer :: const_props(:) @@ -283,6 +286,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, missing_input_names = ' ' nullify(file) is_first = .true. + overall_diff_found = .false. if (masterproc) then write(iulog,*) '' @@ -327,12 +331,15 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, select case (trim(phys_var_stdnames(name_idx))) case ('potential_temperature') call check_field(file, input_var_names(:,name_idx), 'lev', timestep, theta, 'potential_temperature', min_difference, & - min_relative_value, is_first) + min_relative_value, is_first, diff_found) case ('air_pressure_at_sea_level') call endrun('Cannot check status of slp'//', slp has unsupported dimension, timestep_for_physics.') end select !check variables + if (diff_found) then + overall_diff_found = .true. + end if end if !check if constituent end do !Suite-required variables @@ -357,11 +364,17 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, end if end do call check_field(file, input_var_names(:,const_input_idx), 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, & - min_difference, min_relative_value, is_first) + min_difference, min_relative_value, is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if else ! If not in standard names list, then just use constituent name as input file name: call check_field(file, [std_name], 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, min_difference, min_relative_value, & - is_first) + is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if end if end do ! Close check file: @@ -379,6 +392,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' end if + ! Endrun if differences were found on this timestep and err_on_fail=TRUE + if (overall_diff_found .and. err_on_fail .and. masterproc) then + call endrun('ERROR: Difference(s) found during ncdata check', file=__FILE__, line=__LINE__) + end if end subroutine physics_check_data end module physics_inputs_4D diff --git a/test/unit/sample_files/write_init_files/physics_inputs_bvd.F90 b/test/unit/sample_files/write_init_files/physics_inputs_bvd.F90 index 99fa3c3d..de773cc5 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_bvd.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_bvd.F90 @@ -226,7 +226,7 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia end subroutine physics_read_data - subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value) + subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value, err_on_fail) use pio, only: file_desc_t, pio_nowrite use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX @@ -249,6 +249,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, integer, intent(in) :: timestep real(kind_phys), intent(in) :: min_difference real(kind_phys), intent(in) :: min_relative_value + logical, intent(in) :: err_on_fail ! Local variables: @@ -273,6 +274,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, logical :: file_found logical :: is_first logical :: is_read + logical :: diff_found + logical :: overall_diff_found character(len=std_name_len) :: std_name !Variable to hold constiutent standard name real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) type(ccpp_constituent_prop_ptr_t), pointer :: const_props(:) @@ -283,6 +286,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, missing_input_names = ' ' nullify(file) is_first = .true. + overall_diff_found = .false. if (masterproc) then write(iulog,*) '' @@ -327,12 +331,15 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, select case (trim(phys_var_stdnames(name_idx))) case ('potential_temperature') call check_field(file, input_var_names(:,name_idx), 'lev', timestep, theta, 'potential_temperature', min_difference, & - min_relative_value, is_first) + min_relative_value, is_first, diff_found) case ('air_pressure_at_sea_level') call endrun('Cannot check status of slp'//', slp has unsupported dimension, band_number.') end select !check variables + if (diff_found) then + overall_diff_found = .true. + end if end if !check if constituent end do !Suite-required variables @@ -357,11 +364,17 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, end if end do call check_field(file, input_var_names(:,const_input_idx), 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, & - min_difference, min_relative_value, is_first) + min_difference, min_relative_value, is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if else ! If not in standard names list, then just use constituent name as input file name: call check_field(file, [std_name], 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, min_difference, min_relative_value, & - is_first) + is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if end if end do ! Close check file: @@ -379,6 +392,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' end if + ! Endrun if differences were found on this timestep and err_on_fail=TRUE + if (overall_diff_found .and. err_on_fail .and. masterproc) then + call endrun('ERROR: Difference(s) found during ncdata check', file=__FILE__, line=__LINE__) + end if end subroutine physics_check_data end module physics_inputs_bvd diff --git a/test/unit/sample_files/write_init_files/physics_inputs_cnst.F90 b/test/unit/sample_files/write_init_files/physics_inputs_cnst.F90 index 218d7f48..b7897809 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_cnst.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_cnst.F90 @@ -226,7 +226,7 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia end subroutine physics_read_data - subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value) + subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value, err_on_fail) use pio, only: file_desc_t, pio_nowrite use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX @@ -249,6 +249,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, integer, intent(in) :: timestep real(kind_phys), intent(in) :: min_difference real(kind_phys), intent(in) :: min_relative_value + logical, intent(in) :: err_on_fail ! Local variables: @@ -273,6 +274,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, logical :: file_found logical :: is_first logical :: is_read + logical :: diff_found + logical :: overall_diff_found character(len=std_name_len) :: std_name !Variable to hold constiutent standard name real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) type(ccpp_constituent_prop_ptr_t), pointer :: const_props(:) @@ -283,6 +286,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, missing_input_names = ' ' nullify(file) is_first = .true. + overall_diff_found = .false. if (masterproc) then write(iulog,*) '' @@ -327,13 +331,16 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, select case (trim(phys_var_stdnames(name_idx))) case ('potential_temperature') call check_field(file, input_var_names(:,name_idx), 'lev', timestep, theta, 'potential_temperature', min_difference, & - min_relative_value, is_first) + min_relative_value, is_first, diff_found) case ('air_pressure_at_sea_level') call check_field(file, input_var_names(:,name_idx), timestep, slp, 'air_pressure_at_sea_level', min_difference, min_relative_value, & - is_first) + is_first, diff_found) end select !check variables + if (diff_found) then + overall_diff_found = .true. + end if end if !check if constituent end do !Suite-required variables @@ -358,11 +365,17 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, end if end do call check_field(file, input_var_names(:,const_input_idx), 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, & - min_difference, min_relative_value, is_first) + min_difference, min_relative_value, is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if else ! If not in standard names list, then just use constituent name as input file name: call check_field(file, [std_name], 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, min_difference, min_relative_value, & - is_first) + is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if end if end do ! Close check file: @@ -380,6 +393,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' end if + ! Endrun if differences were found on this timestep and err_on_fail=TRUE + if (overall_diff_found .and. err_on_fail .and. masterproc) then + call endrun('ERROR: Difference(s) found during ncdata check', file=__FILE__, line=__LINE__) + end if end subroutine physics_check_data end module physics_inputs_cnst diff --git a/test/unit/sample_files/write_init_files/physics_inputs_ddt.F90 b/test/unit/sample_files/write_init_files/physics_inputs_ddt.F90 index d5675487..db732939 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_ddt.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_ddt.F90 @@ -226,7 +226,7 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia end subroutine physics_read_data - subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value) + subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value, err_on_fail) use pio, only: file_desc_t, pio_nowrite use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX @@ -249,6 +249,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, integer, intent(in) :: timestep real(kind_phys), intent(in) :: min_difference real(kind_phys), intent(in) :: min_relative_value + logical, intent(in) :: err_on_fail ! Local variables: @@ -273,6 +274,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, logical :: file_found logical :: is_first logical :: is_read + logical :: diff_found + logical :: overall_diff_found character(len=std_name_len) :: std_name !Variable to hold constiutent standard name real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) type(ccpp_constituent_prop_ptr_t), pointer :: const_props(:) @@ -283,6 +286,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, missing_input_names = ' ' nullify(file) is_first = .true. + overall_diff_found = .false. if (masterproc) then write(iulog,*) '' @@ -327,13 +331,16 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, select case (trim(phys_var_stdnames(name_idx))) case ('potential_temperature') call check_field(file, input_var_names(:,name_idx), 'lev', timestep, phys_state%theta, 'potential_temperature', min_difference, & - min_relative_value, is_first) + min_relative_value, is_first, diff_found) case ('air_pressure_at_sea_level') call check_field(file, input_var_names(:,name_idx), timestep, slp, 'air_pressure_at_sea_level', min_difference, min_relative_value, & - is_first) + is_first, diff_found) end select !check variables + if (diff_found) then + overall_diff_found = .true. + end if end if !check if constituent end do !Suite-required variables @@ -358,11 +365,17 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, end if end do call check_field(file, input_var_names(:,const_input_idx), 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, & - min_difference, min_relative_value, is_first) + min_difference, min_relative_value, is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if else ! If not in standard names list, then just use constituent name as input file name: call check_field(file, [std_name], 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, min_difference, min_relative_value, & - is_first) + is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if end if end do ! Close check file: @@ -380,6 +393,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' end if + ! Endrun if differences were found on this timestep and err_on_fail=TRUE + if (overall_diff_found .and. err_on_fail .and. masterproc) then + call endrun('ERROR: Difference(s) found during ncdata check', file=__FILE__, line=__LINE__) + end if end subroutine physics_check_data end module physics_inputs_ddt diff --git a/test/unit/sample_files/write_init_files/physics_inputs_ddt2.F90 b/test/unit/sample_files/write_init_files/physics_inputs_ddt2.F90 index 57ea3c19..ad60820f 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_ddt2.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_ddt2.F90 @@ -226,7 +226,7 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia end subroutine physics_read_data - subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value) + subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value, err_on_fail) use pio, only: file_desc_t, pio_nowrite use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX @@ -249,6 +249,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, integer, intent(in) :: timestep real(kind_phys), intent(in) :: min_difference real(kind_phys), intent(in) :: min_relative_value + logical, intent(in) :: err_on_fail ! Local variables: @@ -273,6 +274,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, logical :: file_found logical :: is_first logical :: is_read + logical :: diff_found + logical :: overall_diff_found character(len=std_name_len) :: std_name !Variable to hold constiutent standard name real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) type(ccpp_constituent_prop_ptr_t), pointer :: const_props(:) @@ -283,6 +286,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, missing_input_names = ' ' nullify(file) is_first = .true. + overall_diff_found = .false. if (masterproc) then write(iulog,*) '' @@ -327,13 +331,16 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, select case (trim(phys_var_stdnames(name_idx))) case ('potential_temperature') call check_field(file, input_var_names(:,name_idx), 'lev', timestep, phys_state%theta, 'potential_temperature', min_difference, & - min_relative_value, is_first) + min_relative_value, is_first, diff_found) case ('air_pressure_at_sea_level') call check_field(file, input_var_names(:,name_idx), timestep, phys_state%slp, 'air_pressure_at_sea_level', min_difference, & - min_relative_value, is_first) + min_relative_value, is_first, diff_found) end select !check variables + if (diff_found) then + overall_diff_found = .true. + end if end if !check if constituent end do !Suite-required variables @@ -358,11 +365,17 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, end if end do call check_field(file, input_var_names(:,const_input_idx), 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, & - min_difference, min_relative_value, is_first) + min_difference, min_relative_value, is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if else ! If not in standard names list, then just use constituent name as input file name: call check_field(file, [std_name], 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, min_difference, min_relative_value, & - is_first) + is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if end if end do ! Close check file: @@ -380,6 +393,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' end if + ! Endrun if differences were found on this timestep and err_on_fail=TRUE + if (overall_diff_found .and. err_on_fail .and. masterproc) then + call endrun('ERROR: Difference(s) found during ncdata check', file=__FILE__, line=__LINE__) + end if end subroutine physics_check_data end module physics_inputs_ddt2 diff --git a/test/unit/sample_files/write_init_files/physics_inputs_ddt_array.F90 b/test/unit/sample_files/write_init_files/physics_inputs_ddt_array.F90 index c9c0b278..0f6795c3 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_ddt_array.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_ddt_array.F90 @@ -226,7 +226,7 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia end subroutine physics_read_data - subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value) + subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value, err_on_fail) use pio, only: file_desc_t, pio_nowrite use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX @@ -249,6 +249,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, integer, intent(in) :: timestep real(kind_phys), intent(in) :: min_difference real(kind_phys), intent(in) :: min_relative_value + logical, intent(in) :: err_on_fail ! Local variables: @@ -273,6 +274,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, logical :: file_found logical :: is_first logical :: is_read + logical :: diff_found + logical :: overall_diff_found character(len=std_name_len) :: std_name !Variable to hold constiutent standard name real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) type(ccpp_constituent_prop_ptr_t), pointer :: const_props(:) @@ -283,6 +286,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, missing_input_names = ' ' nullify(file) is_first = .true. + overall_diff_found = .false. if (masterproc) then write(iulog,*) '' @@ -327,13 +331,16 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, select case (trim(phys_var_stdnames(name_idx))) case ('potential_temperature') call check_field(file, input_var_names(:,name_idx), 'lev', timestep, phys_state%T(:, :, ix_theta), 'potential_temperature', & - min_difference, min_relative_value, is_first) + min_difference, min_relative_value, is_first, diff_found) case ('air_pressure_at_sea_level') call check_field(file, input_var_names(:,name_idx), timestep, phys_state%slp, 'air_pressure_at_sea_level', min_difference, & - min_relative_value, is_first) + min_relative_value, is_first, diff_found) end select !check variables + if (diff_found) then + overall_diff_found = .true. + end if end if !check if constituent end do !Suite-required variables @@ -358,11 +365,17 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, end if end do call check_field(file, input_var_names(:,const_input_idx), 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, & - min_difference, min_relative_value, is_first) + min_difference, min_relative_value, is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if else ! If not in standard names list, then just use constituent name as input file name: call check_field(file, [std_name], 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, min_difference, min_relative_value, & - is_first) + is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if end if end do ! Close check file: @@ -380,6 +393,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' end if + ! Endrun if differences were found on this timestep and err_on_fail=TRUE + if (overall_diff_found .and. err_on_fail .and. masterproc) then + call endrun('ERROR: Difference(s) found during ncdata check', file=__FILE__, line=__LINE__) + end if end subroutine physics_check_data end module physics_inputs_ddt_array diff --git a/test/unit/sample_files/write_init_files/physics_inputs_host_var.F90 b/test/unit/sample_files/write_init_files/physics_inputs_host_var.F90 index 9b4dc702..e15415d8 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_host_var.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_host_var.F90 @@ -223,7 +223,7 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia end subroutine physics_read_data - subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value) + subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value, err_on_fail) use pio, only: file_desc_t, pio_nowrite use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX @@ -246,6 +246,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, integer, intent(in) :: timestep real(kind_phys), intent(in) :: min_difference real(kind_phys), intent(in) :: min_relative_value + logical, intent(in) :: err_on_fail ! Local variables: @@ -270,6 +271,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, logical :: file_found logical :: is_first logical :: is_read + logical :: diff_found + logical :: overall_diff_found character(len=std_name_len) :: std_name !Variable to hold constiutent standard name real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) type(ccpp_constituent_prop_ptr_t), pointer :: const_props(:) @@ -280,6 +283,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, missing_input_names = ' ' nullify(file) is_first = .true. + overall_diff_found = .false. if (masterproc) then write(iulog,*) '' @@ -324,9 +328,12 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, select case (trim(phys_var_stdnames(name_idx))) case ('air_pressure_at_sea_level') call check_field(file, input_var_names(:,name_idx), timestep, slp, 'air_pressure_at_sea_level', min_difference, min_relative_value, & - is_first) + is_first, diff_found) end select !check variables + if (diff_found) then + overall_diff_found = .true. + end if end if !check if constituent end do !Suite-required variables @@ -351,11 +358,17 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, end if end do call check_field(file, input_var_names(:,const_input_idx), 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, & - min_difference, min_relative_value, is_first) + min_difference, min_relative_value, is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if else ! If not in standard names list, then just use constituent name as input file name: call check_field(file, [std_name], 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, min_difference, min_relative_value, & - is_first) + is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if end if end do ! Close check file: @@ -373,6 +386,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' end if + ! Endrun if differences were found on this timestep and err_on_fail=TRUE + if (overall_diff_found .and. err_on_fail .and. masterproc) then + call endrun('ERROR: Difference(s) found during ncdata check', file=__FILE__, line=__LINE__) + end if end subroutine physics_check_data end module physics_inputs_host_var diff --git a/test/unit/sample_files/write_init_files/physics_inputs_mf.F90 b/test/unit/sample_files/write_init_files/physics_inputs_mf.F90 index 7ccaf7ee..88b30b1a 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_mf.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_mf.F90 @@ -227,7 +227,7 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia end subroutine physics_read_data - subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value) + subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value, err_on_fail) use pio, only: file_desc_t, pio_nowrite use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX @@ -251,6 +251,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, integer, intent(in) :: timestep real(kind_phys), intent(in) :: min_difference real(kind_phys), intent(in) :: min_relative_value + logical, intent(in) :: err_on_fail ! Local variables: @@ -275,6 +276,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, logical :: file_found logical :: is_first logical :: is_read + logical :: diff_found + logical :: overall_diff_found character(len=std_name_len) :: std_name !Variable to hold constiutent standard name real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) type(ccpp_constituent_prop_ptr_t), pointer :: const_props(:) @@ -285,6 +288,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, missing_input_names = ' ' nullify(file) is_first = .true. + overall_diff_found = .false. if (masterproc) then write(iulog,*) '' @@ -329,13 +333,16 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, select case (trim(phys_var_stdnames(name_idx))) case ('potential_temperature') call check_field(file, input_var_names(:,name_idx), 'lev', timestep, theta, 'potential_temperature', min_difference, & - min_relative_value, is_first) + min_relative_value, is_first, diff_found) case ('air_pressure_at_sea_level') call check_field(file, input_var_names(:,name_idx), timestep, slp, 'air_pressure_at_sea_level', min_difference, min_relative_value, & - is_first) + is_first, diff_found) end select !check variables + if (diff_found) then + overall_diff_found = .true. + end if end if !check if constituent end do !Suite-required variables @@ -360,11 +367,17 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, end if end do call check_field(file, input_var_names(:,const_input_idx), 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, & - min_difference, min_relative_value, is_first) + min_difference, min_relative_value, is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if else ! If not in standard names list, then just use constituent name as input file name: call check_field(file, [std_name], 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, min_difference, min_relative_value, & - is_first) + is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if end if end do ! Close check file: @@ -382,6 +395,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' end if + ! Endrun if differences were found on this timestep and err_on_fail=TRUE + if (overall_diff_found .and. err_on_fail .and. masterproc) then + call endrun('ERROR: Difference(s) found during ncdata check', file=__FILE__, line=__LINE__) + end if end subroutine physics_check_data end module physics_inputs_mf diff --git a/test/unit/sample_files/write_init_files/physics_inputs_no_horiz.F90 b/test/unit/sample_files/write_init_files/physics_inputs_no_horiz.F90 index d238768e..2b76aaa3 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_no_horiz.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_no_horiz.F90 @@ -226,7 +226,7 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia end subroutine physics_read_data - subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value) + subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value, err_on_fail) use pio, only: file_desc_t, pio_nowrite use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX @@ -249,6 +249,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, integer, intent(in) :: timestep real(kind_phys), intent(in) :: min_difference real(kind_phys), intent(in) :: min_relative_value + logical, intent(in) :: err_on_fail ! Local variables: @@ -273,6 +274,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, logical :: file_found logical :: is_first logical :: is_read + logical :: diff_found + logical :: overall_diff_found character(len=std_name_len) :: std_name !Variable to hold constiutent standard name real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) type(ccpp_constituent_prop_ptr_t), pointer :: const_props(:) @@ -283,6 +286,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, missing_input_names = ' ' nullify(file) is_first = .true. + overall_diff_found = .false. if (masterproc) then write(iulog,*) '' @@ -327,12 +331,15 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, select case (trim(phys_var_stdnames(name_idx))) case ('potential_temperature') call check_field(file, input_var_names(:,name_idx), 'lev', timestep, theta, 'potential_temperature', min_difference, & - min_relative_value, is_first) + min_relative_value, is_first, diff_found) case ('air_pressure_at_sea_level') call endrun('Cannot check status of slp'//', slp has no horizontal dimension') end select !check variables + if (diff_found) then + overall_diff_found = .true. + end if end if !check if constituent end do !Suite-required variables @@ -357,11 +364,17 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, end if end do call check_field(file, input_var_names(:,const_input_idx), 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, & - min_difference, min_relative_value, is_first) + min_difference, min_relative_value, is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if else ! If not in standard names list, then just use constituent name as input file name: call check_field(file, [std_name], 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, min_difference, min_relative_value, & - is_first) + is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if end if end do ! Close check file: @@ -379,6 +392,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' end if + ! Endrun if differences were found on this timestep and err_on_fail=TRUE + if (overall_diff_found .and. err_on_fail .and. masterproc) then + call endrun('ERROR: Difference(s) found during ncdata check', file=__FILE__, line=__LINE__) + end if end subroutine physics_check_data end module physics_inputs_no_horiz diff --git a/test/unit/sample_files/write_init_files/physics_inputs_noreq.F90 b/test/unit/sample_files/write_init_files/physics_inputs_noreq.F90 index 52eb8cf9..f8f1c0fd 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_noreq.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_noreq.F90 @@ -219,7 +219,7 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia end subroutine physics_read_data - subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value) + subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value, err_on_fail) use pio, only: file_desc_t, pio_nowrite use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX @@ -241,6 +241,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, integer, intent(in) :: timestep real(kind_phys), intent(in) :: min_difference real(kind_phys), intent(in) :: min_relative_value + logical, intent(in) :: err_on_fail ! Local variables: @@ -265,6 +266,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, logical :: file_found logical :: is_first logical :: is_read + logical :: diff_found + logical :: overall_diff_found character(len=std_name_len) :: std_name !Variable to hold constiutent standard name real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) type(ccpp_constituent_prop_ptr_t), pointer :: const_props(:) @@ -275,6 +278,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, missing_input_names = ' ' nullify(file) is_first = .true. + overall_diff_found = .false. if (masterproc) then write(iulog,*) '' @@ -318,6 +322,9 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, select case (trim(phys_var_stdnames(name_idx))) end select !check variables + if (diff_found) then + overall_diff_found = .true. + end if end if !check if constituent end do !Suite-required variables @@ -342,11 +349,17 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, end if end do call check_field(file, input_var_names(:,const_input_idx), 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, & - min_difference, min_relative_value, is_first) + min_difference, min_relative_value, is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if else ! If not in standard names list, then just use constituent name as input file name: call check_field(file, [std_name], 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, min_difference, min_relative_value, & - is_first) + is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if end if end do ! Close check file: @@ -364,6 +377,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' end if + ! Endrun if differences were found on this timestep and err_on_fail=TRUE + if (overall_diff_found .and. err_on_fail .and. masterproc) then + call endrun('ERROR: Difference(s) found during ncdata check', file=__FILE__, line=__LINE__) + end if end subroutine physics_check_data end module physics_inputs_noreq diff --git a/test/unit/sample_files/write_init_files/physics_inputs_param.F90 b/test/unit/sample_files/write_init_files/physics_inputs_param.F90 index 3cdfb21a..3bbe1e48 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_param.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_param.F90 @@ -229,7 +229,7 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia end subroutine physics_read_data - subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value) + subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value, err_on_fail) use pio, only: file_desc_t, pio_nowrite use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX @@ -252,6 +252,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, integer, intent(in) :: timestep real(kind_phys), intent(in) :: min_difference real(kind_phys), intent(in) :: min_relative_value + logical, intent(in) :: err_on_fail ! Local variables: @@ -276,6 +277,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, logical :: file_found logical :: is_first logical :: is_read + logical :: diff_found + logical :: overall_diff_found character(len=std_name_len) :: std_name !Variable to hold constiutent standard name real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) type(ccpp_constituent_prop_ptr_t), pointer :: const_props(:) @@ -286,6 +289,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, missing_input_names = ' ' nullify(file) is_first = .true. + overall_diff_found = .false. if (masterproc) then write(iulog,*) '' @@ -330,16 +334,19 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, select case (trim(phys_var_stdnames(name_idx))) case ('potential_temperature') call check_field(file, input_var_names(:,name_idx), 'lev', timestep, theta, 'potential_temperature', min_difference, & - min_relative_value, is_first) + min_relative_value, is_first, diff_found) case ('air_pressure_at_sea_level') call check_field(file, input_var_names(:,name_idx), timestep, slp, 'air_pressure_at_sea_level', min_difference, min_relative_value, & - is_first) + is_first, diff_found) case ('gravitational_acceleration') call endrun('Cannot check status of g'//', g has no horizontal dimension') end select !check variables + if (diff_found) then + overall_diff_found = .true. + end if end if !check if constituent end do !Suite-required variables @@ -364,11 +371,17 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, end if end do call check_field(file, input_var_names(:,const_input_idx), 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, & - min_difference, min_relative_value, is_first) + min_difference, min_relative_value, is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if else ! If not in standard names list, then just use constituent name as input file name: call check_field(file, [std_name], 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, min_difference, min_relative_value, & - is_first) + is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if end if end do ! Close check file: @@ -386,6 +399,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' end if + ! Endrun if differences were found on this timestep and err_on_fail=TRUE + if (overall_diff_found .and. err_on_fail .and. masterproc) then + call endrun('ERROR: Difference(s) found during ncdata check', file=__FILE__, line=__LINE__) + end if end subroutine physics_check_data end module physics_inputs_param diff --git a/test/unit/sample_files/write_init_files/physics_inputs_protect.F90 b/test/unit/sample_files/write_init_files/physics_inputs_protect.F90 index c578c2fc..ffdaa70b 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_protect.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_protect.F90 @@ -226,7 +226,7 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia end subroutine physics_read_data - subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value) + subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value, err_on_fail) use pio, only: file_desc_t, pio_nowrite use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX @@ -249,6 +249,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, integer, intent(in) :: timestep real(kind_phys), intent(in) :: min_difference real(kind_phys), intent(in) :: min_relative_value + logical, intent(in) :: err_on_fail ! Local variables: @@ -273,6 +274,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, logical :: file_found logical :: is_first logical :: is_read + logical :: diff_found + logical :: overall_diff_found character(len=std_name_len) :: std_name !Variable to hold constiutent standard name real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) type(ccpp_constituent_prop_ptr_t), pointer :: const_props(:) @@ -283,6 +286,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, missing_input_names = ' ' nullify(file) is_first = .true. + overall_diff_found = .false. if (masterproc) then write(iulog,*) '' @@ -327,13 +331,16 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, select case (trim(phys_var_stdnames(name_idx))) case ('potential_temperature') call check_field(file, input_var_names(:,name_idx), 'lev', timestep, theta, 'potential_temperature', min_difference, & - min_relative_value, is_first) + min_relative_value, is_first, diff_found) case ('air_pressure_at_sea_level') call check_field(file, input_var_names(:,name_idx), timestep, slp, 'air_pressure_at_sea_level', min_difference, min_relative_value, & - is_first) + is_first, diff_found) end select !check variables + if (diff_found) then + overall_diff_found = .true. + end if end if !check if constituent end do !Suite-required variables @@ -358,11 +365,17 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, end if end do call check_field(file, input_var_names(:,const_input_idx), 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, & - min_difference, min_relative_value, is_first) + min_difference, min_relative_value, is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if else ! If not in standard names list, then just use constituent name as input file name: call check_field(file, [std_name], 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, min_difference, min_relative_value, & - is_first) + is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if end if end do ! Close check file: @@ -380,6 +393,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' end if + ! Endrun if differences were found on this timestep and err_on_fail=TRUE + if (overall_diff_found .and. err_on_fail .and. masterproc) then + call endrun('ERROR: Difference(s) found during ncdata check', file=__FILE__, line=__LINE__) + end if end subroutine physics_check_data end module physics_inputs_protect diff --git a/test/unit/sample_files/write_init_files/physics_inputs_scalar.F90 b/test/unit/sample_files/write_init_files/physics_inputs_scalar.F90 index 4159f127..99602499 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_scalar.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_scalar.F90 @@ -226,7 +226,7 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia end subroutine physics_read_data - subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value) + subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value, err_on_fail) use pio, only: file_desc_t, pio_nowrite use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX @@ -249,6 +249,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, integer, intent(in) :: timestep real(kind_phys), intent(in) :: min_difference real(kind_phys), intent(in) :: min_relative_value + logical, intent(in) :: err_on_fail ! Local variables: @@ -273,6 +274,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, logical :: file_found logical :: is_first logical :: is_read + logical :: diff_found + logical :: overall_diff_found character(len=std_name_len) :: std_name !Variable to hold constiutent standard name real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) type(ccpp_constituent_prop_ptr_t), pointer :: const_props(:) @@ -283,6 +286,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, missing_input_names = ' ' nullify(file) is_first = .true. + overall_diff_found = .false. if (masterproc) then write(iulog,*) '' @@ -327,12 +331,15 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, select case (trim(phys_var_stdnames(name_idx))) case ('potential_temperature') call check_field(file, input_var_names(:,name_idx), 'lev', timestep, theta, 'potential_temperature', min_difference, & - min_relative_value, is_first) + min_relative_value, is_first, diff_found) case ('air_pressure_at_sea_level') call endrun('Cannot check status of slp'//', slp has no horizontal dimension') end select !check variables + if (diff_found) then + overall_diff_found = .true. + end if end if !check if constituent end do !Suite-required variables @@ -357,11 +364,17 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, end if end do call check_field(file, input_var_names(:,const_input_idx), 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, & - min_difference, min_relative_value, is_first) + min_difference, min_relative_value, is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if else ! If not in standard names list, then just use constituent name as input file name: call check_field(file, [std_name], 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, min_difference, min_relative_value, & - is_first) + is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if end if end do ! Close check file: @@ -379,6 +392,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' end if + ! Endrun if differences were found on this timestep and err_on_fail=TRUE + if (overall_diff_found .and. err_on_fail .and. masterproc) then + call endrun('ERROR: Difference(s) found during ncdata check', file=__FILE__, line=__LINE__) + end if end subroutine physics_check_data end module physics_inputs_scalar diff --git a/test/unit/sample_files/write_init_files/physics_inputs_simple.F90 b/test/unit/sample_files/write_init_files/physics_inputs_simple.F90 index 1b55d8a3..737614df 100644 --- a/test/unit/sample_files/write_init_files/physics_inputs_simple.F90 +++ b/test/unit/sample_files/write_init_files/physics_inputs_simple.F90 @@ -226,7 +226,7 @@ subroutine physics_read_data(file, suite_names, timestep, read_initialized_varia end subroutine physics_read_data - subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value) + subroutine physics_check_data(file_name, suite_names, timestep, min_difference, min_relative_value, err_on_fail) use pio, only: file_desc_t, pio_nowrite use cam_abortutils, only: endrun use shr_kind_mod, only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_CX @@ -249,6 +249,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, integer, intent(in) :: timestep real(kind_phys), intent(in) :: min_difference real(kind_phys), intent(in) :: min_relative_value + logical, intent(in) :: err_on_fail ! Local variables: @@ -273,6 +274,8 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, logical :: file_found logical :: is_first logical :: is_read + logical :: diff_found + logical :: overall_diff_found character(len=std_name_len) :: std_name !Variable to hold constiutent standard name real(kind=kind_phys), pointer :: field_data_ptr(:,:,:) type(ccpp_constituent_prop_ptr_t), pointer :: const_props(:) @@ -283,6 +286,7 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, missing_input_names = ' ' nullify(file) is_first = .true. + overall_diff_found = .false. if (masterproc) then write(iulog,*) '' @@ -327,13 +331,16 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, select case (trim(phys_var_stdnames(name_idx))) case ('potential_temperature') call check_field(file, input_var_names(:,name_idx), 'lev', timestep, theta, 'potential_temperature', min_difference, & - min_relative_value, is_first) + min_relative_value, is_first, diff_found) case ('air_pressure_at_sea_level') call check_field(file, input_var_names(:,name_idx), timestep, slp, 'air_pressure_at_sea_level', min_difference, min_relative_value, & - is_first) + is_first, diff_found) end select !check variables + if (diff_found) then + overall_diff_found = .true. + end if end if !check if constituent end do !Suite-required variables @@ -358,11 +365,17 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, end if end do call check_field(file, input_var_names(:,const_input_idx), 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, & - min_difference, min_relative_value, is_first) + min_difference, min_relative_value, is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if else ! If not in standard names list, then just use constituent name as input file name: call check_field(file, [std_name], 'lev', timestep, field_data_ptr(:,:,constituent_idx), std_name, min_difference, min_relative_value, & - is_first) + is_first, diff_found) + if (diff_found) then + overall_diff_found = .true. + end if end if end do ! Close check file: @@ -380,6 +393,10 @@ subroutine physics_check_data(file_name, suite_names, timestep, min_difference, write(iulog,*) '********** End Physics Check Data Results **********' write(iulog,*) '' end if + ! Endrun if differences were found on this timestep and err_on_fail=TRUE + if (overall_diff_found .and. err_on_fail .and. masterproc) then + call endrun('ERROR: Difference(s) found during ncdata check', file=__FILE__, line=__LINE__) + end if end subroutine physics_check_data end module physics_inputs_simple From d1b20c9cedc3ee8b1d5f08d70c98b3936dabe888 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Tue, 10 Dec 2024 09:59:29 -0700 Subject: [PATCH 24/27] add metadata for orbital parameters in cam_control_mod (#325) Tag name (required for release branches): Originator(s): peverwhee Description (include the issue title, and the keyword ['closes', 'fixes', 'resolves'] followed by the issue number): Adds metadata for orbital parameters in cam_control_mod.F90 Describe any changes made to build system: N/A Describe any changes made to the namelist: N/A List any changes to the defaults for the input datasets (e.g. boundary datasets): N/A List all files eliminated and why: N/A List all files added and what they do: A src/control/cam_control_mod.meta - add metadata file for cam_control_mod.F90 List all existing files that have been modified, and describe the changes: (Helpful git command: `git diff --name-status development...`) M .gitmodules - update atmospheric_physics hash to grab changes in https://github.com/ESCOMP/atmospheric_physics/pull/173 M src/control/cam_control_mod.F90 - add necessary comments for CCPP parsing M src/data/registry.xml - notify the registry of the new metadata file M src/physics/units/physics_grid.meta - update "radians" to "rad" M test/unit/sample_files/phys_types_dup_section.meta - update "radians" to "rad" If there are new failures (compared to the `test/existing-test-failures.txt` file), have them OK'd by the gatekeeper, note them here, and add them to the file. If there are baseline differences, include the test and the reason for the diff. What is the nature of the change? Roundoff? derecho/intel/aux_sima: all non-existing failures PASS derecho/gnu/aux_sima: all non-existing failures PASS If this changes climate describe any run(s) done to evaluate the new climate in enough detail that it(they) could be reproduced: CAM-SIMA date used for the baseline comparison tests if different than latest: --- .gitmodules | 2 +- src/control/cam_control_mod.F90 | 4 ++- src/control/cam_control_mod.meta | 33 +++++++++++++++++++ src/data/registry.xml | 1 + src/physics/ncar_ccpp | 2 +- src/physics/utils/physics_grid.meta | 6 ++-- .../sample_files/phys_types_dup_section.meta | 4 +-- 7 files changed, 44 insertions(+), 8 deletions(-) create mode 100644 src/control/cam_control_mod.meta diff --git a/.gitmodules b/.gitmodules index fe5de260..5322028a 100644 --- a/.gitmodules +++ b/.gitmodules @@ -20,7 +20,7 @@ [submodule "ncar-physics"] path = src/physics/ncar_ccpp url = https://github.com/ESCOMP/atmospheric_physics - fxtag = 0ecfcc155ac0387ef9db3304611c6f3ef055ac1d + fxtag = e7a599f4bb1533f7cdcd8723b1f864e11578e96c fxrequired = AlwaysRequired fxDONOTUSEurl = https://github.com/ESCOMP/atmospheric_physics [submodule "ccs_config"] diff --git a/src/control/cam_control_mod.F90 b/src/control/cam_control_mod.F90 index 4dc86bae..d135eea8 100644 --- a/src/control/cam_control_mod.F90 +++ b/src/control/cam_control_mod.F90 @@ -28,10 +28,12 @@ module cam_control_mod logical, protected :: branch_run ! branch from a previous run; requires a restart file logical, protected :: post_assim ! We are resuming after a pause - logical, protected :: aqua_planet ! Flag to run model in "aqua planet" mode logical, protected :: brnch_retain_casename ! true => branch run may use same caseid as ! the run being branched from + !> \section arg_table_cam_control_mod Argument Table + !! \htmlinclude arg_table_cam_control_mod.html + logical, protected :: aqua_planet ! Flag to run model in "aqua planet" mode real(r8), protected :: eccen ! Earth's eccentricity factor (unitless) (typically 0 to 0.1) real(r8), protected :: obliqr ! Earth's obliquity in radians real(r8), protected :: lambm0 ! Mean longitude of perihelion at the diff --git a/src/control/cam_control_mod.meta b/src/control/cam_control_mod.meta new file mode 100644 index 00000000..d7b38dbd --- /dev/null +++ b/src/control/cam_control_mod.meta @@ -0,0 +1,33 @@ +[ccpp-table-properties] + name = cam_control_mod + type = module + +[ccpp-arg-table] + name = cam_control_mod + type = module +[ aqua_planet ] + standard_name = is_aqua_planet + units = flag + type = logical + dimensions = () +[ eccen ] + standard_name = planet_orbital_eccentricity_factor + units = 1 + type = real | kind = r8 + dimensions = () +[ obliqr ] + standard_name = planet_obliquity + long_name = planet's axial tilt (obliquity) + units = rad + type = real | kind = r8 + dimensions = () +[ lambm0 ] + standard_name = mean_longitude_of_perihelion_at_vernal_equinox + units = rad + type = real | kind = r8 + dimensions = () +[ mvelpp ] + standard_name = moving_vernal_equinox_longitude_of_perihelion_plus_pi + units = rad + type = real | kind = r8 + dimensions = () diff --git a/src/data/registry.xml b/src/data/registry.xml index 4a199b9f..0d7bbcf9 100644 --- a/src/data/registry.xml +++ b/src/data/registry.xml @@ -4,6 +4,7 @@ $SRCROOT/src/utils/spmd_utils.meta + $SRCROOT/src/control/cam_control_mod.meta $SRCROOT/src/control/cam_logfile.meta $SRCROOT/src/control/camsrfexch.meta $SRCROOT/src/control/runtime_obj.meta diff --git a/src/physics/ncar_ccpp b/src/physics/ncar_ccpp index 0ecfcc15..e7a599f4 160000 --- a/src/physics/ncar_ccpp +++ b/src/physics/ncar_ccpp @@ -1 +1 @@ -Subproject commit 0ecfcc155ac0387ef9db3304611c6f3ef055ac1d +Subproject commit e7a599f4bb1533f7cdcd8723b1f864e11578e96c diff --git a/src/physics/utils/physics_grid.meta b/src/physics/utils/physics_grid.meta index fcf934b5..fc4798d6 100644 --- a/src/physics/utils/physics_grid.meta +++ b/src/physics/utils/physics_grid.meta @@ -38,13 +38,13 @@ protected = True [ lat_rad ] standard_name = latitude - units = radians + units = rad type = real | kind = kind_phys dimensions = (horizontal_dimension) protected = True [ lon_rad ] standard_name = longitude - units = radians + units = rad type = real | kind = kind_phys dimensions = (horizontal_dimension) protected = True @@ -62,7 +62,7 @@ protected = True [ area ] standard_name = cell_angular_area - units = steradian + units = sr type = real | kind = kind_phys dimensions = (horizontal_dimension) protected = True diff --git a/test/unit/sample_files/phys_types_dup_section.meta b/test/unit/sample_files/phys_types_dup_section.meta index 65127e8e..23db9b12 100644 --- a/test/unit/sample_files/phys_types_dup_section.meta +++ b/test/unit/sample_files/phys_types_dup_section.meta @@ -13,13 +13,13 @@ protected = True [ latitude ] standard_name = latitude - units = radians + units = rad type = real | kind = kind_phys dimensions = (horizontal_dimension) protected = True [ longitude ] standard_name = longitude - units = radians + units = rad type = real | kind = kind_phys dimensions = (horizontal_dimension) protected = True From 37fdbfbf58cdebbb982a8c23857267e837c39e47 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Mon, 16 Dec 2024 11:09:31 -0500 Subject: [PATCH 25/27] Implements cam_thermo_water_update and CCPPized check_energy (#316) Originator(s): jimmielin Description (include the issue title, and the keyword ['closes', 'fixes', 'resolves'] followed by the issue number): All changes are bit-for-bit, except those noted: Implements `cam_thermo_water_update`: - updates `cp_or_cv_dycore` (`specific_heat_for_air_used_in_dycore`) in `air_composition.F90` for SE and MPAS dynamical cores - read `cp_or_cv_dycore` from CAM snapshot (refer to companion CAM PR) - energy formula (that has to be matching dycore) is recognized and set by null-dycore in `dyn_grid.F90` by looking at global attributes of the initial file; see `find_energy_formula` - added `is_first_timestep` logical state flag Ports `cam_thermo` and related updates in `air_composition` and `dp_coupling` from CAM 6.3.109 (https://github.com/ESCOMP/CAM/pull/761/files) - update to hydrostatic energy calculation - changes `get_cp`, `get_R` in `air_composition.F90` to use moist mixing ratios - **answer-changing:** update to moist-to-dry (for physics) conversion in `dp_coupling::derived_phys_dry` to account for all water tracers instead of just Q - **answer-changing:** update to not-really-"exner" calculation to use composition-dependent `cappav` instead of `cappa` Changes `vcoord` in `dyn_tests_utils` (old CAM) to `energy_formula` now in `cam_thermo_formula` (separated out into a different file to avoid dependency issues) - `vc_moist_pressure` is now `ENERGY_FORMULA_DYCORE_FV`; `vc_dry_pressure` is `_SE`; `vc_height` is `_MPAS` - these are just integer flags (0,1,2) and values are kept consistent with old CAM and their use in dynamics tests Ports global mean utility module (`gmean_mod.F90`), de-chunkized from CAM: - Implements `get_wght` in `physics_grid` for weighted sum calculation Imports `check_energy_chng` and `check_energy_fix` from `atmospheric_physics` Describe any changes made to build system: N/A Describe any changes made to the namelist: contained within ncar-physics List any changes to the defaults for the input datasets (e.g. boundary datasets): - Added `cp_or_cv_dycore` in CAM snapshots List all files eliminated and why: N/A List all files added and what they do: ``` - energy_formula A src/data/cam_thermo_formula.F90 A src/data/cam_thermo_formula.meta - gmean A src/utils/gmean_mod.F90 ``` List all existing files that have been modified, and describe the changes: (Helpful git command: `git diff --name-status development...`) ``` - ncar-physics update M .gitmodules M src/physics/ncar_ccpp - `is_first_timestep` M src/control/cam_comp.F90 - cam_thermo_water_update for cp_or_cv_dycore (include in registry; read from ic) M src/data/air_composition.F90 M src/data/cam_thermo.F90 M src/data/registry.xml M tools/stdnames_to_inputnames_dictionary.xml M src/dynamics/se/dp_coupling.F90 M src/dynamics/se/dycore/prim_advance_mod.F90 M src/dynamics/se/dyn_comp.F90 M src/dynamics/utils/dyn_thermo.F90 - energy_formula M src/physics/utils/phys_comp.F90 M src/dynamics/mpas/dyn_comp.F90 M src/dynamics/none/dyn_comp.F90 M src/dynamics/none/dyn_grid.F90 - gmean M src/physics/utils/physics_grid.F90 ``` Note: bit-for-bit in check_energy with CAM is tricky to validate without dycore updates to SE; may need to merge #301 first --------- Co-authored-by: Kuan-Chih Wang --- cime_config/config_component.xml | 3 +- src/control/cam_comp.F90 | 23 +- src/data/air_composition.F90 | 144 ++++++++--- src/data/cam_thermo.F90 | 232 +++++++++++------ src/data/cam_thermo_formula.F90 | 39 +++ src/data/cam_thermo_formula.meta | 17 ++ src/data/registry.xml | 51 +++- src/dynamics/mpas/dyn_comp.F90 | 25 ++ src/dynamics/mpas/dyn_coupling.F90 | 22 +- src/dynamics/none/dyn_comp.F90 | 3 + src/dynamics/none/dyn_grid.F90 | 81 ++++++ src/dynamics/se/dp_coupling.F90 | 125 ++++++---- src/dynamics/se/dycore/prim_advance_mod.F90 | 6 +- src/dynamics/se/dyn_comp.F90 | 22 ++ src/dynamics/utils/dyn_thermo.F90 | 33 +-- src/physics/utils/phys_comp.F90 | 2 + src/physics/utils/physics_grid.F90 | 67 +++-- src/utils/gmean_mod.F90 | 263 ++++++++++++++++++++ test/existing-test-failures.txt | 13 +- tools/stdnames_to_inputnames_dictionary.xml | 17 +- 20 files changed, 955 insertions(+), 233 deletions(-) create mode 100644 src/data/cam_thermo_formula.F90 create mode 100644 src/data/cam_thermo_formula.meta create mode 100644 src/utils/gmean_mod.F90 diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 5805131c..030c5f87 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -161,8 +161,7 @@ -nlev 145 --> - + --physics-suites adiabatic --physics-suites tj2016 --analytic_ic --physics-suites kessler --analytic_ic diff --git a/src/control/cam_comp.F90 b/src/control/cam_comp.F90 index 3daf0168..e3a178f8 100644 --- a/src/control/cam_comp.F90 +++ b/src/control/cam_comp.F90 @@ -29,6 +29,7 @@ module cam_comp use physics_types, only: phys_state, phys_tend use physics_types, only: dtime_phys use physics_types, only: calday + use physics_types, only: is_first_timestep, nstep use dyn_comp, only: dyn_import_t, dyn_export_t use perf_mod, only: t_barrierf, t_startf, t_stopf @@ -149,9 +150,6 @@ subroutine cam_init(caseid, ctitle, model_doi_url, & character(len=cx) :: errmsg !----------------------------------------------------------------------- - dtime_phys = 0.0_r8 - call mark_as_initialized('timestep_for_physics') - call init_pio_subsystem() ! Initializations using data passed from coupler. @@ -167,12 +165,20 @@ subroutine cam_init(caseid, ctitle, model_doi_url, & call cam_ctrl_set_orbit(eccen, obliqr, lambm0, mvelpp) - call timemgr_init( & dtime, calendar, start_ymd, start_tod, ref_ymd, & ref_tod, stop_ymd, stop_tod, curr_ymd, curr_tod, & perpetual_run, perpetual_ymd, initial_run_in) + dtime_phys = 0.0_r8 + call mark_as_initialized('timestep_for_physics') + + is_first_timestep = .true. + call mark_as_initialized('is_first_timestep') + + nstep = get_nstep() + call mark_as_initialized('current_timestep_number') + ! Get current fractional calendar day. Needs to be updated at every timestep. calday = get_curr_calday() call mark_as_initialized('fractional_calendar_days_on_end_of_current_timestep') @@ -268,6 +274,10 @@ subroutine cam_timestep_init() use phys_comp, only: phys_timestep_init use stepon, only: stepon_timestep_init + ! Update timestep flags in physics state + is_first_timestep = is_first_step() + nstep = get_nstep() + !---------------------------------------------------------- ! First phase of dynamics (at least couple from dynamics to physics) ! Return time-step for physics from dynamics. @@ -514,10 +524,6 @@ subroutine cam_final(cam_out, cam_in) type(cam_out_t), pointer :: cam_out ! Output from CAM to surface type(cam_in_t), pointer :: cam_in ! Input from merged surface to CAM - ! - ! Local variable - ! - integer :: nstep ! Current timestep number. !----------------------------------------------------------------------- call phys_final() @@ -540,7 +546,6 @@ subroutine cam_final(cam_out, cam_in) call shr_sys_flush( iulog ) ! Flush all output to the CAM log file if (masterproc) then - nstep = get_nstep() write(iulog,9300) nstep-1,nstep 9300 format (//'Number of completed timesteps:',i6,/,'Time step ',i6, & ' partially done to provide convectively adjusted and ', & diff --git a/src/data/air_composition.F90 b/src/data/air_composition.F90 index e84fc837..51e7dd6b 100644 --- a/src/data/air_composition.F90 +++ b/src/data/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 ccpp_kinds, only: kind_phys @@ -12,7 +13,9 @@ module air_composition save 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 @@ -225,7 +228,7 @@ subroutine air_composition_init() ! !************************************************************************ ! - ! add prognostic components of dry air + ! add prognostic components of air ! !************************************************************************ ! @@ -309,6 +312,7 @@ subroutine air_composition_init() ! case(wv_stdname) !water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water call air_species_info(wv_stdname, ix, mw) + wv_idx = ix ! set water species index for use in get_hydrostatic_energy thermodynamic_active_species_idx(icnst) = ix thermodynamic_active_species_cp (icnst) = cpwv thermodynamic_active_species_cv (icnst) = cv3 / mw @@ -510,26 +514,68 @@ 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, ncol, to_moist_factor) + subroutine dry_air_composition_update(mmr, ncol, to_dry_factor) - real(kind_phys), intent(in) :: mmr(:,:,:) ! constituents array + !(mmr = dry mixing ratio, if not, use to_dry_factor to convert!) + real(kind_phys), intent(in) :: mmr(:,:,:) ! mixing ratios for species dependent dry air integer, intent(in) :: ncol ! number of columns - real(kind_phys), optional, intent(in) :: to_moist_factor(:,:) + real(kind_phys), optional, intent(in) :: to_dry_factor(:,:) call get_R_dry(mmr(:ncol, :, :), thermodynamic_active_species_idx, & - rairv(:ncol, :), fact=to_moist_factor) + rairv(:ncol, :), fact=to_dry_factor) call get_cp_dry(mmr(:ncol,:,:), thermodynamic_active_species_idx, & - cpairv(:ncol,:), fact=to_moist_factor) + cpairv(:ncol,:), fact=to_dry_factor) call get_mbarv(mmr(:ncol,:,:), thermodynamic_active_species_idx, & - mbarv(:ncol,:), fact=to_moist_factor) + mbarv(:ncol,:), fact=to_dry_factor) cappav(:ncol,:) = rairv(:ncol,:) / cpairv(:ncol,:) - end subroutine air_composition_update + end subroutine dry_air_composition_update + + !=========================================================================== + !--------------------------------------------------------------------------- + ! water_composition_update: Update generalized cp or cv depending on dycore + ! (enthalpy for pressure-based dynamical cores and internal energy for z-based dynamical cores) + !--------------------------------------------------------------------------- + !=========================================================================== + subroutine water_composition_update(mmr, ncol, energy_formula, cp_or_cv_dycore, to_dry_factor) + use cam_thermo_formula, only: ENERGY_FORMULA_DYCORE_FV, ENERGY_FORMULA_DYCORE_SE, ENERGY_FORMULA_DYCORE_MPAS + use string_utils, only: stringify + + real(kind_phys), intent(in) :: mmr(:,:,:) ! constituents array + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: energy_formula ! energy formula for dynamical core + real(kind_phys), intent(out) :: cp_or_cv_dycore(:,:) ! enthalpy or heat capacity, dycore dependent [J K-1 kg-1] + real(kind_phys), optional, intent(in) :: to_dry_factor(:,:) + + character(len=*), parameter :: subname = 'water_composition_update' + + ! update enthalpy or internal energy scaling factor for energy consistency with CAM physics + if (energy_formula == ENERGY_FORMULA_DYCORE_FV) then + ! FV: moist pressure vertical coordinate does not need update. + else if (energy_formula == ENERGY_FORMULA_DYCORE_SE) then + ! SE + ! Note: species index subset to 1: because SIMA currently uses index 0. See GitHub issue #334 in ESCOMP/CAM-SIMA. + call get_cp(mmr(:ncol,:,:), .false., cp_or_cv_dycore(:ncol,:), & + factor=to_dry_factor, active_species_idx_dycore=thermodynamic_active_species_idx(1:), & + cpdry=cpairv(:ncol,:)) + else if (energy_formula == ENERGY_FORMULA_DYCORE_MPAS) then + ! MPAS + ! Note: species index subset to 1: because SIMA currently uses index 0. See GitHub issue #334 in ESCOMP/CAM-SIMA. + call get_R(mmr(:ncol,:,:), thermodynamic_active_species_idx(1:), & + cp_or_cv_dycore(:ncol,:), fact=to_dry_factor, Rdry=rairv(:ncol,:)) + + ! internal energy coefficient for MPAS + ! (equation 92 in Eldred et al. 2023; doi:10.1002/qj.4353) + cp_or_cv_dycore(:ncol,:) = cp_or_cv_dycore(:ncol,:) * (cpairv(:ncol,:) - rairv(:ncol,:)) / rairv(:ncol,:) + else + call endrun(subname//': dycore energy formula (value = '//stringify((/energy_formula/))//') not supported') + end if + end subroutine water_composition_update !=========================================================================== !*************************************************************************** @@ -639,27 +685,34 @@ 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: to_str ! Dummy arguments ! tracer: Tracer array + ! + ! if factor not present then tracer must be a dry mixing ratio + ! if factor present tracer*factor must be a dry mixing ratio + ! real(kind_phys), intent(in) :: tracer(:,:,:) - real(kind_phys), optional, intent(in) :: dp_dry(:,:) ! inv_cp: output inverse cp instead of cp logical, intent(in) :: inv_cp real(kind_phys), intent(out) :: cp(:,:) + ! factor: to convert tracer to dry mixing ratio + ! if provided, then tracer is not a dry mass mixing ratio + real(kind_phys), 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(kind_phys), optional, intent(in) :: cpdry(:,:) ! Local variables integer :: qdx, itrac real(kind_phys) :: sum_species(SIZE(cp, 1), SIZE(cp, 2)) real(kind_phys) :: sum_cp(SIZE(cp, 1), SIZE(cp, 2)) - real(kind_phys) :: factor(SIZE(cp, 1), SIZE(cp, 2)) + real(kind_phys) :: factor_local(SIZE(cp, 1), SIZE(cp, 2)) integer :: idx_local(thermodynamic_active_species_num) character(len=*), parameter :: subname = 'get_cp_1hd: ' @@ -675,28 +728,37 @@ 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_kind_phys / dp_dry + if (present(factor)) then + factor_local = factor else - factor = 1.0_kind_phys + factor_local = 1.0_kind_phys end if + sum_species = 1.0_kind_phys ! 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(:,:)) + sum_species(:,:) = sum_species(:,:) + (tracer(:,:,itrac) * factor_local(:,:)) end do - ! Get heat capacity at constant pressure (Cp) for dry air: - call get_cp_dry(tracer, idx_local, sum_cp, fact=factor) + 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 + ! Get heat capacity at constant pressure (Cp) for dry air: + call get_cp_dry(tracer, idx_local, sum_cp, fact=factor_local) + end if ! Add water species to Cp: 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(:,:)) + (thermodynamic_active_species_cp(qdx) * tracer(:,:,itrac) * factor_local(:,:)) end do + if (inv_cp) then cp = sum_species / sum_cp else @@ -707,7 +769,7 @@ 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: to_str @@ -715,14 +777,15 @@ subroutine get_cp_2hd(tracer, inv_cp, cp, dp_dry, active_species_idx_dycore) ! Dummy arguments ! tracer: Tracer array real(kind_phys), intent(in) :: tracer(:,:,:,:) - real(kind_phys), optional, intent(in) :: dp_dry(:,:,:) ! inv_cp: output inverse cp instead of cp logical, intent(in) :: inv_cp real(kind_phys), intent(out) :: cp(:,:,:) + real(kind_phys), optional, intent(in) :: factor(:,:,:) ! active_species_idx_dycore: array of indicies for index of ! thermodynamic active species in dycore tracer array ! (if different from physics index) integer, optional, intent(in) :: active_species_idx_dycore(:) + real(kind_phys), optional, intent(in) :: cpdry(:,:,:) ! Local variables integer :: jdx @@ -730,11 +793,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 @@ -843,9 +912,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: to_str + use physconst, only: rair ! Dummy arguments ! tracer: !tracer array @@ -856,6 +926,7 @@ subroutine get_R_1hd(tracer, active_species_idx, R, fact) real(kind_phys), intent(out) :: R(:, :) ! fact: optional factor for converting tracer to dry mixing ratio real(kind_phys), optional, intent(in) :: fact(:, :) + real(kind_phys), optional, intent(in) :: Rdry(:, :) ! Local variables integer :: qdx, itrac @@ -874,12 +945,19 @@ subroutine get_R_1hd(tracer, active_species_idx, R, fact) call endrun(subname//"SIZE mismatch in dimension 2 "// & to_str(SIZE(fact, 2))//' /= '//to_str(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_kind_phys 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_kind_phys ! all dry air species sum to 1 do qdx = dry_air_species_num + 1, thermodynamic_active_species_num @@ -934,7 +1012,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(kind_phys), intent(in) :: tracer(:,:,:) !tracer array integer, intent(in) :: active_species_idx(:) !index of active species in tracer real(kind_phys), intent(out) :: mbarv_in(:,:) !molecular weight of dry air diff --git a/src/data/cam_thermo.F90 b/src/data/cam_thermo.F90 index 59dd1c83..8330ef64 100644 --- a/src/data/cam_thermo.F90 +++ b/src/data/cam_thermo.F90 @@ -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 @@ -77,6 +79,7 @@ module cam_thermo ! mixing_ratio options integer, public, parameter :: DRY_MIXING_RATIO = 1 integer, public, parameter :: MASS_MIXING_RATIO = 2 + !> \section arg_table_cam_thermo Argument Table !! \htmlinclude cam_thermo.html !--------------- Variables below here are for WACCM-X --------------------- @@ -85,7 +88,7 @@ module cam_thermo ! kmcnd: molecular conductivity J m-1 s-1 K-1 real(kind_phys), public, protected, allocatable :: kmcnd(:,:) - !------------- Variables for consistent themodynamics -------------------- + !------------- Variables for consistent thermodynamics -------------------- ! ! @@ -208,51 +211,89 @@ 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, ncol, update_thermo_variables, to_moist_factor) - use air_composition, only: air_composition_update, update_zvirv - use string_utils, only: to_str - !----------------------------------------------------------------------- - ! Update the physics "constants" that vary - !------------------------------------------------------------------------- - - !------------------------------Arguments---------------------------------- + subroutine cam_thermo_dry_air_update(mmr, T, ncol, pver, update_thermo_variables, to_dry_factor) + use air_composition, only: dry_air_composition_update + use air_composition, only: update_zvirv + use string_utils, only: stringify - real(kind_phys), intent(in) :: mmr(:,:,:) ! constituents array - real(kind_phys), intent(in) :: T(:,:) ! temperature - integer, intent(in) :: ncol ! number of columns - logical, intent(in) :: update_thermo_variables ! true: calculate composition-dependent thermo variables - ! false: do not calculate composition-dependent thermo variables + real(kind_phys), intent(in) :: mmr(:,:,:) ! constituents array (mmr = dry mixing ratio, if not use to_dry_factor to convert) + real(kind_phys), intent(in) :: T(:,:) ! temperature + integer, intent(in) :: pver ! number of vertical levels + integer, intent(in) :: ncol ! number of columns + logical, intent(in) :: update_thermo_variables ! true: calculate composition-dependent thermo variables + ! false: do not calculate composition-dependent thermo variables + real(kind_phys), optional, intent(in) :: to_dry_factor(:,:) ! conversion factor to dry if mmr is wet or moist - real(kind_phys), optional, intent(in) :: to_moist_factor(:,:) - ! - !---------------------------Local storage------------------------------- - real(kind_phys):: sponge_factor(SIZE(mmr, 2)) - character(len=*), parameter :: subname = 'cam_thermo_update: ' + ! Local vars + real(kind_phys) :: sponge_factor(SIZE(mmr, 2)) + character(len=*), parameter :: subname = 'cam_thermo_dry_air_update: ' if (.not. update_thermo_variables) then return end if - if (present(to_moist_factor)) then - if (SIZE(to_moist_factor, 1) /= ncol) then - call endrun(subname//'DIM 1 of to_moist_factor is'//to_str(SIZE(to_moist_factor,1))//'but should be'//to_str(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 '//stringify((/SIZE(to_dry_factor,1)/))//' but should be '//stringify((/ncol/))) + end if + if (SIZE(to_dry_factor, 2) /= pver) then + call endrun(subname//'DIM 2 of to_dry_factor is '//stringify((/SIZE(to_dry_factor,2)/))//' but should be '//stringify((/pver/))) + end if end if + sponge_factor = 1.0_kind_phys - call air_composition_update(mmr, ncol, to_moist_factor=to_moist_factor) + call dry_air_composition_update(mmr, ncol, to_dry_factor=to_dry_factor) call get_molecular_diff_coef(T(:ncol,:), .true., sponge_factor, kmvis(:ncol,:), & - kmcnd(:ncol,:), tracer=mmr(:ncol,:,:), fact=to_moist_factor, & + kmcnd(:ncol,:), tracer=mmr(:ncol,:,:), fact=to_dry_factor, & active_species_idx_dycore=thermodynamic_active_species_idx) + + ! Calculate zvirv for WACCM-X. call update_zvirv() - end subroutine cam_thermo_update + end subroutine cam_thermo_dry_air_update + + ! + !*************************************************************************** + ! + ! cam_thermo_water_update: update water species dependent constants for physics + ! + !*************************************************************************** + ! + subroutine cam_thermo_water_update(mmr, ncol, pver, energy_formula, cp_or_cv_dycore, to_dry_factor) + use air_composition, only: water_composition_update + use string_utils, only: stringify + !----------------------------------------------------------------------- + ! Update the physics "constants" that vary + !------------------------------------------------------------------------- + + real(kind_phys), intent(in) :: mmr(:,:,:) ! constituents array (mmr = dry mixing ratio, if not use to_dry_factor to convert) + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: pver ! number of vertical levels + integer, intent(in) :: energy_formula + real(kind_phys), intent(out) :: cp_or_cv_dycore(:,:) ! enthalpy or heat capacity, dycore dependent [J K-1 kg-1] + real(kind_phys), optional, intent(in) :: to_dry_factor(:,:) + + character(len=*), parameter :: subname = 'cam_thermo_water_update: ' + + if (present(to_dry_factor)) then + if (SIZE(to_dry_factor, 1) /= ncol) then + call endrun(subname//'DIM 1 of to_dry_factor is '//stringify((/SIZE(to_dry_factor,1)/))//' but should be '//stringify((/ncol/))) + end if + if (SIZE(to_dry_factor, 2) /= pver) then + call endrun(subname//'DIM 2 of to_dry_factor is '//stringify((/SIZE(to_dry_factor,2)/))//' but should be '//stringify((/pver/))) + end if + end if + + call water_composition_update(mmr, ncol, energy_formula, cp_or_cv_dycore, to_dry_factor=to_dry_factor) + end subroutine cam_thermo_water_update !=========================================================================== @@ -1554,28 +1595,32 @@ 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_thermo_formula, only: ENERGY_FORMULA_DYCORE_FV, ENERGY_FORMULA_DYCORE_SE, ENERGY_FORMULA_DYCORE_MPAS 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 air_composition, only: dry_air_species_num + 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(kind_phys), intent(in) :: tracer(:,:,:) + logical, intent(in) :: moist_mixing_ratio ! pdel: pressure level thickness - real(kind_phys), intent(in) :: pdel(:,:) - ! cp_or_cv: dry air heat capacity under constant pressure or - ! constant volume (depends on vcoord) + real(kind_phys), intent(in) :: pdel_in(:,:) + ! cp_or_cv: air heat capacity under constant pressure or + ! constant volume (depends on energy formula) real(kind_phys), intent(in) :: cp_or_cv(:,:) real(kind_phys), intent(in) :: U(:,:) real(kind_phys), intent(in) :: V(:,:) real(kind_phys), intent(in) :: T(:,:) - integer, intent(in) :: vcoord ! vertical coordinate - real(kind_phys), intent(in), optional :: ps(:) + integer, intent(in) :: vcoord !REMOVECAM - vcoord or energy formula to use + real(kind_phys), intent(in), optional :: ptop(:) real(kind_phys), intent(in), optional :: phis(:) real(kind_phys), intent(in), optional :: z_mid(:,:) ! dycore_idx: use dycore index for thermodynamic active species @@ -1588,8 +1633,12 @@ subroutine get_hydrostatic_energy_1hd(tracer, pdel, cp_or_cv, U, V, T, & real(kind_phys), intent(out), optional :: te (:) ! KE: vertically integrated kinetic energy real(kind_phys), intent(out), optional :: ke (:) - ! SE: vertically integrated internal+geopotential energy + ! SE: vertically integrated enthalpy (pressure coordinate) + ! or internal energy (z coordinate) real(kind_phys), intent(out), optional :: se (:) + ! PO: vertically integrated PHIS term (pressure coordinate) + ! or potential energy (z coordinate) + real(kind_phys), intent(out), optional :: po (:) ! WV: vertically integrated water vapor real(kind_phys), intent(out), optional :: wv (:) ! liq: vertically integrated liquid @@ -1599,10 +1648,12 @@ subroutine get_hydrostatic_energy_1hd(tracer, pdel, cp_or_cv, U, V, T, & ! Local variables real(kind_phys) :: ke_vint(SIZE(tracer, 1)) ! Vertical integral of KE - real(kind_phys) :: se_vint(SIZE(tracer, 1)) ! Vertical integral of SE + real(kind_phys) :: se_vint(SIZE(tracer, 1)) ! Vertical integral of enthalpy or internal energy + real(kind_phys) :: po_vint(SIZE(tracer, 1)) ! Vertical integral of PHIS or potential energy real(kind_phys) :: wv_vint(SIZE(tracer, 1)) ! Vertical integral of wv real(kind_phys) :: liq_vint(SIZE(tracer, 1)) ! Vertical integral of liq real(kind_phys) :: ice_vint(SIZE(tracer, 1)) ! Vertical integral of ice + real(kind_phys) :: pdel(SIZE(tracer, 1),SIZE(tracer, 2)) ! moist pressure level thickness real(kind_phys) :: latsub ! latent heat of sublimation integer :: ierr @@ -1633,12 +1684,12 @@ subroutine get_hydrostatic_energy_1hd(tracer, pdel, cp_or_cv, U, V, T, & species_liq_idx(:) = thermodynamic_active_species_liq_idx_dycore(:) species_ice_idx(:) = thermodynamic_active_species_ice_idx_dycore(:) else - species_idx(:) = thermodynamic_active_species_idx(:) + species_idx(:) = thermodynamic_active_species_idx(1:) species_liq_idx(:) = thermodynamic_active_species_liq_idx(:) species_ice_idx(:) = thermodynamic_active_species_ice_idx(:) end if else - species_idx(:) = thermodynamic_active_species_idx(:) + species_idx(:) = thermodynamic_active_species_idx(1:) species_liq_idx(:) = thermodynamic_active_species_liq_idx(:) species_ice_idx(:) = thermodynamic_active_species_ice_idx(:) end if @@ -1649,78 +1700,96 @@ 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._kind_phys + se_vint = 0._kind_phys 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 ', & - 'moist/dry pressure vertical coordinate' - call endrun(subname//': ps and phis must be present for '// & - 'moist/dry pressure vertical coordinate') + case(ENERGY_FORMULA_DYCORE_FV, ENERGY_FORMULA_DYCORE_SE) + if (.not. present(ptop).or. (.not. present(phis))) then + write(iulog, *) subname, ' ptop and phis must be present for ', & + 'FV/SE energy formula' + call endrun(subname//': ptop and phis must be present for '// & + 'FV/SE energy formula') end if - ke_vint = 0._kind_phys - se_vint = 0._kind_phys - wv_vint = 0._kind_phys + 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_kind_phys * (U(idx, kdx)**2 + V(idx, kdx)**2) / gravit) + 0.5_kind_phys * (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') + case(ENERGY_FORMULA_DYCORE_MPAS) + if (.not. present(phis)) then + write(iulog, *) subname, ' phis must be present for ', & + 'MPAS energy formula' + call endrun(subname//': phis must be present for '// & + 'MPAS energy formula') end if - ke_vint = 0._kind_phys - se_vint = 0._kind_phys - wv_vint = 0._kind_phys + po_vint = 0._kind_phys do kdx = 1, SIZE(tracer, 2) do idx = 1, SIZE(tracer, 1) ke_vint(idx) = ke_vint(idx) + (pdel(idx, kdx) * & - 0.5_kind_phys * (U(idx, kdx)**2 + V(idx, kdx)**2) / gravit) + 0.5_kind_phys * (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 - write(iulog, *) subname, ' vertical coordinate not supported: ', vcoord - call endrun(subname//': vertical coordinate not supported') + write(iulog, *) subname, ' energy formula not supported: ', vcoord + call endrun(subname//': energy formula 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._kind_phys + 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._kind_phys 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 @@ -1734,7 +1803,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 @@ -1762,7 +1831,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 !=========================================================================== diff --git a/src/data/cam_thermo_formula.F90 b/src/data/cam_thermo_formula.F90 new file mode 100644 index 00000000..df202c9d --- /dev/null +++ b/src/data/cam_thermo_formula.F90 @@ -0,0 +1,39 @@ +module cam_thermo_formula + + use runtime_obj, only: unset_int + + implicit none + private + save + + ! saves energy formula to use for physics and dynamical core + ! for use in cam_thermo, air_composition and other modules + ! separated into cam_thermo_formula module for clean dependencies + + ! energy_formula options (was vcoord in CAM and stored in dyn_tests_utils) + integer, public, parameter :: ENERGY_FORMULA_DYCORE_FV = 0 ! vc_moist_pressure + integer, public, parameter :: ENERGY_FORMULA_DYCORE_SE = 1 ! vc_dry_pressure + integer, public, parameter :: ENERGY_FORMULA_DYCORE_MPAS = 2 ! vc_height + + !> \section arg_table_cam_thermo_formula Argument Table + !! \htmlinclude cam_thermo_formula.html + ! energy_formula_dycore: energy formula used for dynamical core + ! written by the dynamical core + integer, public :: energy_formula_dycore = unset_int + ! energy_formula_physics: energy formula used for physics + integer, public :: energy_formula_physics = unset_int + + ! Public subroutines + public :: cam_thermo_formula_init + +contains + subroutine cam_thermo_formula_init() + use phys_vars_init_check, only: mark_as_initialized + + ! Physics energy formulation is always FV (moist pressure coordinate) + energy_formula_physics = ENERGY_FORMULA_DYCORE_FV + call mark_as_initialized("total_energy_formula_for_physics") + + end subroutine cam_thermo_formula_init + +end module cam_thermo_formula diff --git a/src/data/cam_thermo_formula.meta b/src/data/cam_thermo_formula.meta new file mode 100644 index 00000000..f8bf04a1 --- /dev/null +++ b/src/data/cam_thermo_formula.meta @@ -0,0 +1,17 @@ +[ccpp-table-properties] + name = cam_thermo_formula + type = module + +[ccpp-arg-table] + name = cam_thermo_formula + type = module +[ energy_formula_dycore ] + standard_name = total_energy_formula_for_dycore + units = 1 + type = integer + dimensions = () +[ energy_formula_physics ] + standard_name = total_energy_formula_for_physics + units = 1 + type = integer + dimensions = () diff --git a/src/data/registry.xml b/src/data/registry.xml index 0d7bbcf9..91658e20 100644 --- a/src/data/registry.xml +++ b/src/data/registry.xml @@ -14,6 +14,7 @@ $SRCROOT/src/physics/utils/tropopause_climo_read.meta $SRCROOT/src/data/air_composition.meta $SRCROOT/src/data/cam_thermo.meta + $SRCROOT/src/data/cam_thermo_formula.meta $SRCROOT/src/data/ref_pres.meta $SRCROOT/src/dynamics/utils/vert_coord.meta $SRCROOT/src/dynamics/utils/hycoef.meta @@ -205,7 +206,7 @@ zi state_zi @@ -213,7 +214,7 @@ te_ini_phys state_te_ini_phys @@ -221,7 +222,7 @@ te_cur_phys state_te_cur_phys @@ -229,7 +230,7 @@ te_ini_dyn state_te_ini_dyn @@ -237,7 +238,7 @@ te_cur_dyn state_te_cur_dyn @@ -245,13 +246,34 @@ tw_ini state_tw_ini horizontal_dimension tw_cur state_tw_cur + + Total energy using dynamical core formula at the end of physics timestep + horizontal_dimension + 0.0 + + + flag indicating if dynamical core energy is not consistent with CAM physics and to perform adjustment of temperature and temperature tendency + .false. + .true. + + + + flag indicating if it is the first timestep of an initial run + reciprocal_of_dimensionless_exner_function_wrt_surface_air_pressure frontogenesis_function frontogenesis_angle - vertically_integrated_total_energy_of_initial_state_using_dycore_energy_formula - vertically_integrated_total_energy_of_current_state_using_dycore_energy_formula - vertically_integrated_water_vapor_and_condensed_water_of_initial_state - vertically_integrated_water_vapor_and_condensed_water_of_current_state + vertically_integrated_total_energy_using_dycore_energy_formula_at_start_of_physics_timestep + vertically_integrated_total_energy_using_dycore_energy_formula + vertically_integrated_total_water_at_start_of_physics_timestep + vertically_integrated_total_water + vertically_integrated_total_energy_at_end_of_physics_timestep tendency_of_air_temperature_due_to_model_physics @@ -416,6 +439,14 @@ horizontal_dimension vertical_layer_dimension zvir + + specific heat of air used in the dynamical core (enthalpy for pressure-based dynamical cores and internal energy for z-based dynamical cores) + horizontal_dimension vertical_layer_dimension + cp_or_cv_dycore + Run MPAS dynamical core to integrate the dynamical states with time. diff --git a/src/dynamics/mpas/dyn_coupling.F90 b/src/dynamics/mpas/dyn_coupling.F90 index 6757158f..a2066e16 100644 --- a/src/dynamics/mpas/dyn_coupling.F90 +++ b/src/dynamics/mpas/dyn_coupling.F90 @@ -2,7 +2,8 @@ module dyn_coupling ! Modules from CAM-SIMA. use cam_abortutils, only: check_allocate, endrun use cam_constituents, only: const_is_water_species, const_qmin, num_advected - use cam_thermo, only: cam_thermo_update + use cam_thermo, only: cam_thermo_dry_air_update, cam_thermo_water_update + use cam_thermo_formula, only: ENERGY_FORMULA_DYCORE_MPAS use dyn_comp, only: dyn_debug_print, dyn_exchange_constituent_state, reverse, mpas_dynamical_core, & ncells_solve use dynconst, only: constant_cpd => cpair, constant_g => gravit, constant_p0 => pref, & @@ -18,6 +19,7 @@ module dyn_coupling use physics_types, only: cappav, cpairv, rairv, zvirv, & dtime_phys, lagrangian_vertical, & phys_state, phys_tend + use physics_types, only: cp_or_cv_dycore use qneg, only: qneg_run use static_energy, only: update_dry_static_energy_run use string_utils, only: stringify @@ -326,15 +328,25 @@ subroutine set_physics_state_external() call endrun('Failed to find variable "constituent_properties"', subname, __LINE__) end if - ! Update `cappav`, `cpairv`, `rairv`, `zvirv`, etc. as needed by calling `cam_thermo_update`. + ! Update `cappav`, `cpairv`, `rairv`, `zvirv`, etc. as needed by calling `cam_thermo_dry_air_update`. ! Note that this subroutine expects constituents to be dry. - call cam_thermo_update( & - constituents, phys_state % t, ncells_solve, cam_runtime_opts % update_thermodynamic_variables()) + call cam_thermo_dry_air_update( & + constituents, phys_state % t, ncells_solve, pver, cam_runtime_opts % update_thermodynamic_variables()) + + ! update cp_or_cv_dycore in SIMA state. + ! (note: at this point q is dry) + call cam_thermo_water_update( & + mmr = constituents, & ! dry MMR + ncol = ncells_solve, & + pver = pver, & + energy_formula = ENERGY_FORMULA_DYCORE_MPAS, & + cp_or_cv_dycore = cp_or_cv_dycore & + ) ! This variable name is really misleading. It actually represents the reciprocal of Exner function ! with respect to surface pressure. This definition is sometimes used for boundary layer work. See ! the paragraph below equation 1.5.1c in doi:10.1007/978-94-009-3027-8. - ! Also note that `cappav` is updated externally by `cam_thermo_update`. + ! Also note that `cappav` is updated externally by `cam_thermo_dry_air_update`. do i = 1, ncells_solve phys_state % exner(i, :) = (phys_state % ps(i) / phys_state % pmid(i, :)) ** cappav(i, :) end do diff --git a/src/dynamics/none/dyn_comp.F90 b/src/dynamics/none/dyn_comp.F90 index 968e04e2..9ecb3022 100644 --- a/src/dynamics/none/dyn_comp.F90 +++ b/src/dynamics/none/dyn_comp.F90 @@ -60,6 +60,9 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) type(dyn_import_t), intent(out) :: dyn_in type(dyn_export_t), intent(out) :: dyn_out + ! Note: dynamical core energy formula is set in dyn_grid based on dynamical core + ! that provided the initial conditions file + end subroutine dyn_init !============================================================================== diff --git a/src/dynamics/none/dyn_grid.F90 b/src/dynamics/none/dyn_grid.F90 index bc714e22..ba1bf0ba 100644 --- a/src/dynamics/none/dyn_grid.F90 +++ b/src/dynamics/none/dyn_grid.F90 @@ -49,6 +49,7 @@ module dyn_grid ! Private module routines private :: find_units private :: find_dimension + private :: find_energy_formula !============================================================================== CONTAINS @@ -126,6 +127,7 @@ subroutine model_grid_init() ! We will handle errors for this routine call pio_seterrorhandling(fh_ini, PIO_BCAST_ERROR, oldmethod=err_handling) + ! Find the latitude variable and dimension(s) call cam_pio_find_var(fh_ini, (/ 'lat ', 'lat_d ', 'latitude' /), lat_name, & lat_vardesc, var_found) @@ -159,6 +161,11 @@ subroutine model_grid_init() write(iulog, *) subname, ': Grid is unstructured' end if end if + + ! Find the dynamical core from which snapshot was saved to populate energy formula used + ! Some information about the grid is needed to determine this. + call find_energy_formula(fh_ini, grid_is_latlon) + ! Find the longitude variable and dimension(s) call cam_pio_find_var(fh_ini, (/ 'lon ', 'lon_d ', 'longitude' /), lon_name, & lon_vardesc, var_found) @@ -626,4 +633,78 @@ subroutine find_dimension(file, dim_names, found_name, dim_len) end if end subroutine find_dimension + !=========================================================================== + + subroutine find_energy_formula(file, grid_is_latlon) + use pio, only: file_desc_t + use pio, only: pio_inq_att, pio_global, PIO_NOERR + use cam_thermo_formula, only: energy_formula_physics, energy_formula_dycore + use cam_thermo_formula, only: ENERGY_FORMULA_DYCORE_SE, ENERGY_FORMULA_DYCORE_FV, ENERGY_FORMULA_DYCORE_MPAS + use physics_types, only: dycore_energy_consistency_adjust + use phys_vars_init_check, only: mark_as_initialized + + ! Find which dynamical core is used in and set the energy formulation + ! (also called vc_dycore in CAM) + ! + ! This functionality is only used to recognize the originating dynamical core + ! from the snapshot file in order to set the energy formulation when running + ! with the null dycore. Other dynamical cores set energy_formula_dycore at their + ! initialization. + + type(file_desc_t), intent(inout) :: file + logical, intent(in) :: grid_is_latlon + + ! Local variables + integer :: ierr, xtype + character(len=*), parameter :: subname = 'find_energy_formula' + + energy_formula_dycore = -1 + + ! Is FV dycore? (has lat lon dimension) + if(grid_is_latlon) then + energy_formula_dycore = ENERGY_FORMULA_DYCORE_FV + dycore_energy_consistency_adjust = .false. + if(masterproc) then + write(iulog, *) subname, ': Null dycore will use FV dycore energy formula' + endif + else + ! Is SE dycore? + ierr = pio_inq_att(file, pio_global, 'ne', xtype) + if (ierr == PIO_NOERR) then + ! Has ne property - is SE dycore. + ! if has fv_nphys then is physics grid (ne..pg..), but the energy formulation is the same. + energy_formula_dycore = ENERGY_FORMULA_DYCORE_SE + dycore_energy_consistency_adjust = .true. + if(masterproc) then + write(iulog, *) subname, ': Null dycore will use SE dycore energy formula' + endif + else + ! Is unstructured and is MPAS dycore + ! there are no global attributes to identify MPAS dycore, so this has to do for now. + energy_formula_dycore = ENERGY_FORMULA_DYCORE_MPAS + dycore_energy_consistency_adjust = .true. + if(masterproc) then + write(iulog, *) subname, ': Null dycore will use MPAS dycore energy formula' + endif + endif + endif + + if(energy_formula_dycore /= -1) then + call mark_as_initialized("total_energy_formula_for_dycore") + endif + call mark_as_initialized("flag_for_dycore_energy_consistency_adjustment") + + ! Mark other energy variables calculated by check_energy_timestep_init + ! here since it will always run when required + call mark_as_initialized("specific_heat_of_air_used_in_dycore") + call mark_as_initialized("vertically_integrated_total_energy_using_physics_energy_formula_at_start_of_physics_timestep") + call mark_as_initialized("vertically_integrated_total_energy_using_physics_energy_formula") + call mark_as_initialized("vertically_integrated_total_energy_using_dycore_energy_formula_at_start_of_physics_timestep") + call mark_as_initialized("vertically_integrated_total_energy_using_dycore_energy_formula") + call mark_as_initialized("vertically_integrated_total_water_at_start_of_physics_timestep") + call mark_as_initialized("vertically_integrated_total_water") + call mark_as_initialized("vertically_integrated_total_energy_at_end_of_physics_timestep") + + end subroutine find_energy_formula + end module dyn_grid diff --git a/src/dynamics/se/dp_coupling.F90 b/src/dynamics/se/dp_coupling.F90 index 8b56e9d9..572f663f 100644 --- a/src/dynamics/se/dp_coupling.F90 +++ b/src/dynamics/se/dp_coupling.F90 @@ -582,18 +582,22 @@ subroutine derived_phys_dry(cam_runtime_opts, phys_state, phys_tend) use cam_constituents, only: const_qmin use runtime_obj, only: wv_stdname use physics_types, only: lagrangian_vertical - use physconst, only: cpair, gravit, zvir, cappa - use cam_thermo, only: cam_thermo_update - use physics_types, only: cpairv, rairv, zvirv + use physconst, only: cpair, gravit, zvir + 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: dry_air_species_num + use physics_types, only: cpairv, rairv, zvirv, cappav + use physics_types, only: cp_or_cv_dycore use physics_grid, only: columns_on_task use geopotential_temp, only: geopotential_temp_run use static_energy, only: update_dry_static_energy_run use qneg, only: qneg_run -! use check_energy, only: check_energy_timestep_init use hycoef, only: hyai, ps0 use shr_vmath_mod, only: shr_vmath_log use shr_kind_mod, only: shr_kind_cx use dyn_comp, only: ixo, ixo2, ixh, ixh2 + use cam_thermo_formula,only: ENERGY_FORMULA_DYCORE_SE ! arguments type(runtime_options), intent(in) :: cam_runtime_opts ! Runtime settings object @@ -607,7 +611,7 @@ subroutine derived_phys_dry(cam_runtime_opts, phys_state, phys_tend) !constituent properties pointer type(ccpp_constituent_prop_ptr_t), pointer :: const_prop_ptr(:) - integer :: m, i, k + integer :: m, i, k, m_cnst integer :: ix_q !Needed for "geopotential_temp" CCPP scheme @@ -622,6 +626,7 @@ subroutine derived_phys_dry(cam_runtime_opts, phys_state, phys_tend) real(r8) :: mmrSum_O_O2_H ! Sum of mass mixing ratios for O, O2, and H real(r8), parameter :: mmrMin=1.e-20_r8 ! lower limit of o2, o, and h mixing ratios real(r8), parameter :: N2mmrMin=1.e-6_r8 ! lower limit of o2, o, and h mixing ratios + real(r8), parameter :: H2lim=6.e-5_r8 ! H2 limiter: 10x global H2 MMR (Roble, 1995) !---------------------------------------------------------------------------- ! Nullify pointers @@ -683,14 +688,23 @@ subroutine derived_phys_dry(cam_runtime_opts, phys_state, phys_tend) end do ! wet pressure variables (should be removed from physics!) + factor_array(:,:) = 1.0_kind_phys + !$omp parallel do num_threads(horz_num_threads) private (k, i, m_cnst) + do m_cnst = dry_air_species_num + 1, thermodynamic_active_species_num + ! include all water species in the factor array. + m = thermodynamic_active_species_idx(m_cnst) + do k = 1, nlev + do i = 1, pcols + ! at this point all q's are dry + factor_array(i,k) = factor_array(i,k) + const_data_ptr(i,k,m) + end do + end do + end do !$omp parallel do num_threads(horz_num_threads) private (k, i) - do k=1,nlev - do i=1, pcols - ! to be consistent with total energy formula in physic's check_energy module only - ! include water vapor in moist dp - factor_array(i,k) = 1._kind_phys+const_data_ptr(i,k,ix_q) - phys_state%pdel(i,k) = phys_state%pdeldry(i,k)*factor_array(i,k) + do k = 1, nlev + do i = 1, pcols + phys_state%pdel(i,k) = phys_state%pdeldry(i,k) * factor_array(i,k) end do end do @@ -721,31 +735,12 @@ subroutine derived_phys_dry(cam_runtime_opts, phys_state, phys_tend) do k = 1, nlev do i = 1, pcols phys_state%rpdel(i,k) = 1._kind_phys/phys_state%pdel(i,k) - phys_state%exner(i,k) = (phys_state%pint(i,pver+1)/phys_state%pmid(i,k))**cappa - end do - end do - - ! all tracers (including moisture) are in dry mixing ratio units - ! physics expect water variables moist - factor_array(:,1:nlev) = 1._kind_phys/factor_array(:,1:nlev) - - !$omp parallel do num_threads(horz_num_threads) private (m, k, i) - do m=1, num_advected - do k = 1, nlev - do i=1, pcols - !This should ideally check if a constituent is a wet - !mixing ratio or not, but until that is working properly - !in the CCPP framework just check for the water species status - !instead, which is all that CAM physics requires: - if (const_is_water_species(m)) then - const_data_ptr(i,k,m) = factor_array(i,k)*const_data_ptr(i,k,m) - end if - end do end do end do !------------------------------------------------------------ - ! Ensure O2 + O + H (N2) mmr greater than one. + ! Apply limiters to mixing ratios of major species (WACCMX): + ! Ensure N2 = 1 - (O2 + O + H) mmr is greater than 0 ! Check for unusually large H2 values and set to lower value. !------------------------------------------------------------ if (cam_runtime_opts%waccmx_option() == 'ionosphere' .or. & @@ -769,8 +764,8 @@ subroutine derived_phys_dry(cam_runtime_opts, phys_state, phys_tend) endif - if(const_data_ptr(i,k,ixh2) .gt. 6.e-5_r8) then - const_data_ptr(i,k,ixh2) = 6.e-5_r8 + if(const_data_ptr(i,k,ixh2) > H2lim) then + const_data_ptr(i,k,ixh2) = H2lim endif end do @@ -789,11 +784,61 @@ subroutine derived_phys_dry(cam_runtime_opts, phys_state, phys_tend) ! Compute molecular viscosity(kmvis) and conductivity(kmcnd). ! Update zvirv registry variable; calculated for WACCM-X. !----------------------------------------------------------------------------- + if (dry_air_species_num > 0) then + call cam_thermo_dry_air_update( & + mmr = const_data_ptr, & ! dry MMR + T = phys_state%t, & + ncol = pcols, & + pver = pver, & + update_thermo_variables = cam_runtime_opts%update_thermodynamic_variables() & + ) + else + zvirv(:,:) = zvir + end if - call cam_thermo_update(const_data_ptr, phys_state%t, pcols, & - cam_runtime_opts%update_thermodynamic_variables()) + ! + ! update cp_or_cv_dycore in SIMA state. + ! (note: at this point q is dry) + ! + call cam_thermo_water_update( & + mmr = const_data_ptr, & ! dry MMR + ncol = pcols, & + pver = pver, & + energy_formula = ENERGY_FORMULA_DYCORE_SE, & + cp_or_cv_dycore = cp_or_cv_dycore & + ) - !Call geopotential_temp CCPP scheme: + !$omp parallel do num_threads(horz_num_threads) private (k, i) + do k = 1, nlev + do i = 1, pcols + phys_state%exner(i,k) = (phys_state%pint(i,pver+1)/phys_state%pmid(i,k))**cappav(i,k) + end do + end do + + ! ========= Q is dry ^^^ ---- Q is moist vvv ========= ! + + ! + ! CAM physics expects that: water tracers (including moisture) are moist; the rest dry mixing ratio + ! at this point Q is converted to moist. + ! + factor_array(:,1:nlev) = 1._kind_phys/factor_array(:,1:nlev) + + !$omp parallel do num_threads(horz_num_threads) private (m, k, i) + do m = 1, num_advected + do k = 1, nlev + do i = 1, pcols + ! This should ideally check if a constituent is a wet + ! mixing ratio or not, but until that is working properly + ! in the CCPP framework just check for the water species status + ! instead, which is all that CAM physics requires: + if (const_is_water_species(m)) then + const_data_ptr(i,k,m) = factor_array(i,k)*const_data_ptr(i,k,m) + end if + end do + end do + end do + + ! Call geopotential_temp CCPP scheme: call geopotential_temp_run(pver, lagrangian_vertical, pver, 1, & pverp, 1, num_advected, phys_state%lnpint, & phys_state%pint, phys_state%pmid, phys_state%pdel, & @@ -807,12 +852,6 @@ subroutine derived_phys_dry(cam_runtime_opts, phys_state, phys_tend) phys_state%phis, phys_state%dse, cpairv, & errflg, errmsg) -!Remove once check_energy scheme exists in CAMDEN: -#if 0 - ! Compute energy and water integrals of input state - call check_energy_timestep_init(phys_state, phys_tend, pbuf_chnk) -#endif - end subroutine derived_phys_dry !========================================================================================= diff --git a/src/dynamics/se/dycore/prim_advance_mod.F90 b/src/dynamics/se/dycore/prim_advance_mod.F90 index 1341b9f4..cf88d7f9 100644 --- a/src/dynamics/se/dycore/prim_advance_mod.F90 +++ b/src/dynamics/se/dycore/prim_advance_mod.F90 @@ -1674,8 +1674,12 @@ subroutine calc_tot_energy_dynamics(elem,fvm,nets,nete,tl,tl_qdp,outfld_name_suf 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) + + ! TODO: need to port cam6_3_109 changes to total energy using get_hydrostatic_energy + ! https://github.com/ESCOMP/CAM/pull/761/files#diff-946bde17289e2f42e43e64413610aa11d102deda8b5199ddaa5b71e67e5d517a + do k = 1, nlev do j=1,np do i = 1, np diff --git a/src/dynamics/se/dyn_comp.F90 b/src/dynamics/se/dyn_comp.F90 index ab52d91c..4f70ae2c 100644 --- a/src/dynamics/se/dyn_comp.F90 +++ b/src/dynamics/se/dyn_comp.F90 @@ -566,6 +566,9 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) use dyn_thermo, only: get_molecular_diff_coef_reference !use cam_history, only: addfld, add_default, horiz_only, register_vector_field use gravity_waves_sources, only: gws_init + use cam_thermo_formula, only: energy_formula_dycore, ENERGY_FORMULA_DYCORE_SE + use physics_types, only: dycore_energy_consistency_adjust + use phys_vars_init_check, only: mark_as_initialized !SE dycore: use prim_advance_mod, only: prim_advance_init @@ -642,6 +645,14 @@ subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) real(r8) :: tau0, krange, otau0, scale real(r8) :: km_sponge_factor_local(nlev+1) !---------------------------------------------------------------------------- + ! Set dynamical core energy formula for use in cam_thermo. + energy_formula_dycore = ENERGY_FORMULA_DYCORE_SE + call mark_as_initialized("total_energy_formula_for_dycore") + + ! Dynamical core energy is not consistent with CAM physics and requires + ! temperature and temperature tendency adjustment at end of physics. + dycore_energy_consistency_adjust = .true. + call mark_as_initialized("flag_for_dycore_energy_consistency_adjustment") ! Now allocate and set condenstate vars allocate(cnst_name_gll(qsize), stat=iret) ! constituent names for gll tracers @@ -1852,6 +1863,17 @@ subroutine read_inidat(dyn_in) call mark_as_initialized("tendency_of_air_temperature_due_to_model_physics") call mark_as_initialized("tendency_of_eastward_wind_due_to_model_physics") call mark_as_initialized("tendency_of_northward_wind_due_to_model_physics") + call mark_as_initialized("specific_heat_of_air_used_in_dycore") + + ! These energy variables are calculated by check_energy_timestep_init + ! but need to be marked here + call mark_as_initialized("vertically_integrated_total_energy_using_physics_energy_formula_at_start_of_physics_timestep") + call mark_as_initialized("vertically_integrated_total_energy_using_physics_energy_formula") + call mark_as_initialized("vertically_integrated_total_energy_using_dycore_energy_formula_at_start_of_physics_timestep") + call mark_as_initialized("vertically_integrated_total_energy_using_dycore_energy_formula") + call mark_as_initialized("vertically_integrated_total_water_at_start_of_physics_timestep") + call mark_as_initialized("vertically_integrated_total_water") + call mark_as_initialized("vertically_integrated_total_energy_at_end_of_physics_timestep") end subroutine read_inidat diff --git a/src/dynamics/utils/dyn_thermo.F90 b/src/dynamics/utils/dyn_thermo.F90 index c4c4723c..9b465031 100644 --- a/src/dynamics/utils/dyn_thermo.F90 +++ b/src/dynamics/utils/dyn_thermo.F90 @@ -61,7 +61,7 @@ subroutine get_cp(tracer,inv_cp,cp,dp_dry,active_species_idx_dycore) !Declare local variables: real(kind_phys), allocatable :: tracer_phys(:,:,:,:) real(kind_phys), allocatable :: cp_phys(:,:,:) - real(kind_phys), allocatable :: dp_dry_phys(:,:,:) + real(kind_phys), allocatable :: factor_phys(:,:,:) !check_allocate variables: integer :: iret !allocate status integer @@ -70,11 +70,16 @@ subroutine get_cp(tracer,inv_cp,cp,dp_dry,active_species_idx_dycore) !Check if kinds are different: if (kind_phys == kind_dyn) then - !The dynamics and physics kind is the same, so just call the physics - !routine directly: - call get_cp_phys(tracer,inv_cp,cp, & - dp_dry=dp_dry, & - active_species_idx_dycore=active_species_idx_dycore) + ! The dynamics and physics kind is the same, so just call the physics + ! routine directly: + if(present(dp_dry)) then + call get_cp_phys(tracer,inv_cp,cp, & + factor=1.0_kind_phys/dp_dry, & + active_species_idx_dycore=active_species_idx_dycore) + else + call get_cp_phys(tracer,inv_cp,cp, & + active_species_idx_dycore=active_species_idx_dycore) + endif else @@ -95,18 +100,18 @@ subroutine get_cp(tracer,inv_cp,cp,dp_dry,active_species_idx_dycore) !Allocate and set optional variables: if (present(dp_dry)) then - allocate(dp_dry_phys(size(dp_dry, 1), size(dp_dry, 2), size(dp_dry,3)), stat=iret) + allocate(factor_phys(size(dp_dry, 1), size(dp_dry, 2), size(dp_dry,3)), stat=iret) call check_allocate(iret, subname, & - 'dp_dry_phys', & + 'factor_phys', & file=__FILE__, line=__LINE__) !Set optional local variable: - dp_dry_phys = real(dp_dry, kind_phys) + factor_phys = 1.0_kind_phys/real(dp_dry, kind_phys) end if - !Call physics routine using local vriables with matching kinds: + !Call physics routine using local variables with matching kinds: call get_cp_phys(tracer_phys,inv_cp,cp_phys, & - dp_dry=dp_dry_phys, & + factor=factor_phys, & active_species_idx_dycore=active_species_idx_dycore) !Set output variables back to dynamics kind: @@ -116,8 +121,8 @@ subroutine get_cp(tracer,inv_cp,cp,dp_dry,active_species_idx_dycore) deallocate(tracer_phys) deallocate(cp_phys) - if (allocated(dp_dry_phys)) then - deallocate(dp_dry_phys) + if (allocated(factor_phys)) then + deallocate(factor_phys) end if @@ -957,7 +962,7 @@ subroutine get_rho_dry(tracer,temp,ptop,dp_dry,tracer_mass,& end if - !Call physics routine using local vriables with matching kinds: + !Call physics routine using local variables with matching kinds: call get_rho_dry_phys(tracer_phys,temp_phys, & ptop_phys, dp_dry_phys,tracer_mass, & rho_dry=rho_dry_phys, & diff --git a/src/physics/utils/phys_comp.F90 b/src/physics/utils/phys_comp.F90 index 5dbfc20a..aa1feef6 100644 --- a/src/physics/utils/phys_comp.F90 +++ b/src/physics/utils/phys_comp.F90 @@ -174,10 +174,12 @@ subroutine phys_init() use physics_grid, only: columns_on_task use vert_coord, only: pver, pverp use cam_thermo, only: cam_thermo_init + use cam_thermo_formula, only: cam_thermo_formula_init use physics_types, only: allocate_physics_types_fields use cam_ccpp_cap, only: cam_ccpp_physics_initialize call cam_thermo_init(columns_on_task, pver, pverp) + call cam_thermo_formula_init() call allocate_physics_types_fields(columns_on_task, pver, pverp, & set_init_val_in=.true., reallocate_in=.false.) diff --git a/src/physics/utils/physics_grid.F90 b/src/physics/utils/physics_grid.F90 index 39fc0f99..8dd3dca3 100644 --- a/src/physics/utils/physics_grid.F90 +++ b/src/physics/utils/physics_grid.F90 @@ -39,8 +39,10 @@ module physics_grid public :: get_rlat_p ! latitude of a physics column in radians public :: get_rlon_p ! longitude of a physics column in radians public :: get_area_p ! area of a physics column in radians squared + public :: get_wght_p ! weight of a physics column in radians squared public :: get_rlat_all_p ! latitudes of physics cols on task (radians) public :: get_rlon_all_p ! longitudes of physics cols on task (radians) + public :: get_wght_all_p ! weights of physics cols on task public :: get_dyn_col_p ! dynamics local blk number and blk offset(s) public :: global_index_p ! global column index of a physics column public :: local_index_p ! local column index of a physics column @@ -376,8 +378,6 @@ end subroutine phys_grid_init !======================================================================== real(r8) function get_dlat_p(index) - use cam_logfile, only: iulog - use cam_abortutils, only: endrun ! latitude of a physics column in degrees ! Dummy argument @@ -396,8 +396,6 @@ end function get_dlat_p !======================================================================== real(r8) function get_dlon_p(index) - use cam_logfile, only: iulog - use cam_abortutils, only: endrun ! longitude of a physics column in degrees ! Dummy argument @@ -416,8 +414,6 @@ end function get_dlon_p !======================================================================== real(r8) function get_rlat_p(index) - use cam_logfile, only: iulog - use cam_abortutils, only: endrun ! latitude of a physics column in radians ! Dummy argument @@ -436,8 +432,6 @@ end function get_rlat_p !======================================================================== real(r8) function get_rlon_p(index) - use cam_logfile, only: iulog - use cam_abortutils, only: endrun ! longitude of a physics column in radians ! Dummy argument @@ -456,8 +450,6 @@ end function get_rlon_p !======================================================================== real(r8) function get_area_p(index) - use cam_logfile, only: iulog - use cam_abortutils, only: endrun ! area of a physics column in radians squared ! Dummy argument @@ -475,9 +467,25 @@ end function get_area_p !======================================================================== + real(r8) function get_wght_p(index) + ! weight of a physics column in radians squared + + ! Dummy argument + integer, intent(in) :: index + ! Local variables + character(len=128) :: errmsg + character(len=*), parameter :: subname = 'get_wght_p' + + ! Check that input is valid: + call check_phys_input(subname, index) + + get_wght_p = phys_columns(index)%weight + + end function get_wght_p + + !======================================================================== + subroutine get_rlat_all_p(rlatdim, rlats) - use cam_logfile, only: iulog - use cam_abortutils, only: endrun !----------------------------------------------------------------------- ! ! get_rlat_all_p: Return all latitudes (in radians) on task. @@ -506,8 +514,6 @@ end subroutine get_rlat_all_p !======================================================================== subroutine get_rlon_all_p(rlondim, rlons) - use cam_logfile, only: iulog - use cam_abortutils, only: endrun !----------------------------------------------------------------------- ! ! get_rlon_all_p: Return all longitudes (in radians) on task. @@ -535,8 +541,35 @@ end subroutine get_rlon_all_p !======================================================================== + subroutine get_wght_all_p(wghtdim, wghts) + !----------------------------------------------------------------------- + ! + ! get_wght_all_p: Return all weights on task. + ! + !----------------------------------------------------------------------- + ! Dummy Arguments + integer, intent(in) :: wghtdim ! declared size of output array + real(r8), intent(out) :: wghts(wghtdim) ! array of weights + + ! Local variables + integer :: index ! loop index + character(len=128) :: errmsg + character(len=*), parameter :: subname = 'get_wght_all_p: ' + + !----------------------------------------------------------------------- + + ! Check that input is valid: + call check_phys_input(subname, wghtdim) + + do index = 1, wghtdim + wghts(index) = phys_columns(index)%weight + end do + + end subroutine get_wght_all_p + + !======================================================================== + subroutine get_dyn_col_p(index, blk_num, blk_ind) - use cam_logfile, only: iulog use cam_abortutils, only: endrun ! Return the dynamics local block number and block offset(s) for ! the physics column indicated by . @@ -568,8 +601,6 @@ end subroutine get_dyn_col_p !======================================================================== integer function global_index_p(index) - use cam_logfile, only: iulog - use cam_abortutils, only: endrun ! global column index of a physics column ! Dummy argument @@ -586,8 +617,6 @@ integer function global_index_p(index) end function global_index_p integer function local_index_p(index) - use cam_logfile, only: iulog - use cam_abortutils, only: endrun ! global column index of a physics column ! Dummy argument diff --git a/src/utils/gmean_mod.F90 b/src/utils/gmean_mod.F90 new file mode 100644 index 00000000..7959ebf0 --- /dev/null +++ b/src/utils/gmean_mod.F90 @@ -0,0 +1,263 @@ +module gmean_mod + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Perform global mean calculations for energy conservation and other checks. + ! + ! Method: + ! Reproducible (scalable): + ! Convert to fixed point (integer representation) to enable + ! reproducibility when using MPI collectives. + ! If error checking is on (via setting reprosum_diffmax > 0 and + ! reprosum_recompute = .true. in user_nl_cpl), shr_reprosum_calc will + ! check the accuracy of its computation with a fast but + ! non-reproducible algorithm. If any error is reported, report + ! the difference and the expected sum and abort run (call endrun) + ! + ! gmean_mod in to_be_ccppized is different from the CAM version and + ! has chunk support removed. + ! + ! + !----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use physics_grid, only: pcols => columns_on_task + use perf_mod, only: t_startf, t_stopf + use cam_logfile, only: iulog + + implicit none + private + + public :: gmean ! compute global mean of 2D fields on physics decomposition + + interface gmean + module procedure gmean_arr + module procedure gmean_scl + end interface gmean + + private :: gmean_fixed_repro + private :: gmean_float_norepro + + ! Set do_gmean_tests to .true. to run a gmean challenge test + logical, private :: do_gmean_tests = .false. + +CONTAINS + + ! + !======================================================================== + ! + + subroutine gmean_arr (arr, arr_gmean, nflds) + use shr_strconvert_mod, only: toString + use spmd_utils, only: masterproc + use cam_abortutils, only: endrun + use shr_reprosum_mod, only: shr_reprosum_reldiffmax, shr_reprosum_recompute, shr_reprosum_tolExceeded + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Compute the global mean of each field in "arr" in the physics grid + ! + ! Method is to call shr_reprosum_calc (called from gmean_fixed_repro) + !----------------------------------------------------------------------- + ! + ! Arguments + ! + integer, intent(in) :: nflds ! number of fields + real(r8), intent(in) :: arr(pcols, nflds) + real(r8), intent(out) :: arr_gmean(nflds) ! global means + ! + ! Local workspace + ! + real(r8) :: rel_diff(2, nflds) + integer :: ifld ! field index + integer :: num_err + logical :: write_warning + ! + !----------------------------------------------------------------------- + ! + call t_startf('gmean_arr') + call t_startf ('gmean_fixed_repro') + call gmean_fixed_repro(arr, arr_gmean, rel_diff, nflds) + call t_stopf ('gmean_fixed_repro') + + ! check that "fast" reproducible sum is accurate enough. If not, calculate + ! using old method + write_warning = masterproc + num_err = 0 + if (shr_reprosum_tolExceeded('gmean', nflds, write_warning, & + iulog, rel_diff)) then + if (shr_reprosum_recompute) then + do ifld = 1, nflds + if (rel_diff(1, ifld) > shr_reprosum_reldiffmax) then + call gmean_float_norepro(arr(:,ifld), arr_gmean(ifld), ifld) + num_err = num_err + 1 + end if + end do + end if + end if + call t_stopf('gmean_arr') + if (num_err > 0) then + call endrun('gmean: '//toString(num_err)//' reprosum errors found') + end if + + end subroutine gmean_arr + + ! + !======================================================================== + ! + + subroutine gmean_scl (arr, gmean) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Compute the global mean of a single field in "arr" in the physics grid + ! + !----------------------------------------------------------------------- + ! + ! Arguments + ! + real(r8), intent(in) :: arr(pcols) + ! Input array + real(r8), intent(out) :: gmean ! global means + ! + ! Local workspace + ! + integer, parameter :: nflds = 1 + real(r8) :: gmean_array(nflds) + real(r8) :: array(pcols, nflds) + integer :: ncols, lchnk + + array(:ncols, 1) = arr(:ncols) + call gmean_arr(array, gmean_array, nflds) + gmean = gmean_array(1) + + end subroutine gmean_scl + + ! + !======================================================================== + ! + + subroutine gmean_float_norepro(arr, repro_sum, index) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Compute the global mean of in the physics chunked + ! decomposition using a fast but non-reproducible algorithm. + ! Log that value along with the value computed by + ! shr_reprosum_calc () + ! + !----------------------------------------------------------------------- + + use physconst, only: pi + use spmd_utils, only: masterproc, masterprocid, mpicom + use mpi, only: mpi_real8, mpi_sum + use physics_grid, only: get_wght_p + ! + ! Arguments + ! + real(r8), intent(in) :: arr(pcols) + real(r8), intent(in) :: repro_sum ! Value computed by reprosum + integer, intent(in) :: index ! Index of field in original call + ! + ! Local workspace + ! + integer :: icol + integer :: ierr + real(r8) :: wght + real(r8) :: check + real(r8) :: check_sum + real(r8), parameter :: pi4 = 4.0_r8 * pi + + ! + !----------------------------------------------------------------------- + ! + ! Calculate and print out non-reproducible value + check = 0.0_r8 + do icol = 1, pcols + wght = get_wght_p(icol) + check = check + arr(icol) * wght + end do + call MPI_reduce(check, check_sum, 1, mpi_real8, mpi_sum, & + masterprocid, mpicom, ierr) + + ! normalization + check_sum = check_sum / pi4 + + if (masterproc) then + write(iulog, '(a,i0,2(a,e20.13e2))') 'gmean(', index, ') = ', & + check_sum, ', reprosum reported ', repro_sum + end if + + end subroutine gmean_float_norepro + + ! + !======================================================================== + ! + subroutine gmean_fixed_repro(arr, arr_gmean, rel_diff, nflds) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Compute the global mean of each field in "arr" in the physics grid + ! with a reproducible yet scalable implementation + ! based on a fixed-point algorithm. + ! + !----------------------------------------------------------------------- + use spmd_utils, only: mpicom + use physics_grid, only: get_wght_all_p + use physics_grid, only: ngcols_p => num_global_phys_cols + use physconst, only: pi + use shr_reprosum_mod, only: shr_reprosum_calc + use cam_abortutils, only: check_allocate + ! + ! Arguments + ! + integer, intent(in) :: nflds ! number of fields + real(r8), intent(in) :: arr(pcols,nflds) + ! arr_gmean: output global sums + real(r8), intent(out) :: arr_gmean(nflds) + ! rel_diff: relative and absolute differences from shr_reprosum_calc + real(r8), intent(out) :: rel_diff(2, nflds) + ! + ! Local workspace + ! + real(r8), parameter :: pi4 = 4.0_r8 * pi + character(len=*), parameter :: subname = 'gmean_fixed_repro: ' + + integer :: icol, ifld ! column, field indices + integer :: errflg + + real(r8) :: wght(pcols) ! integration weights + real(r8), allocatable :: xfld(:,:) ! weighted summands + + errflg = 0 + + allocate(xfld(pcols, nflds), stat=errflg) + call check_allocate(errflg, subname, 'xfld(pcols, nflds)', & + file=__FILE__, line=__LINE__) + + ! pre-weight summands + call get_wght_all_p(pcols, wght) + + do ifld = 1, nflds + do icol = 1, pcols + xfld(icol, ifld) = arr(icol, ifld) * wght(icol) + end do + end do + + ! call fixed-point algorithm + call shr_reprosum_calc ( & + arr = xfld, & + arr_gsum = arr_gmean, & + nsummands = pcols, & ! # of local summands + dsummands = pcols, & ! declared first dimension of arr. + nflds = nflds, & + commid = mpicom, & + rel_diff = rel_diff & + ) + + deallocate(xfld) + ! final normalization + arr_gmean(:) = arr_gmean(:) / pi4 + + end subroutine gmean_fixed_repro + +end module gmean_mod diff --git a/test/existing-test-failures.txt b/test/existing-test-failures.txt index 253b5633..05e0a145 100644 --- a/test/existing-test-failures.txt +++ b/test/existing-test-failures.txt @@ -2,12 +2,7 @@ SMS_Ln2.mpasa480_mpasa480.FKESSLER.derecho_intel.cam-outfrq_kessler_mpas_derecho SMS_Ln2.mpasa480_mpasa480.FKESSLER.derecho_gnu.cam-outfrq_kessler_mpas_derecho (Overall: FAIL) - will fail until MPAS is fully integrated -SMS_Ln9.ne5pg3_ne5pg3_mg37.FTJ16.derecho_intel.cam-outfrq_se_cslam (Overall: FAIL) -SMS_Ln9.ne5pg3_ne5pg3_mg37.FKESSLER.derecho_intel.cam-outfrq_se_cslam (Overall: FAIL) -SMS_Ln2.ne3pg3_ne3pg3_mg37.FPHYStest.derecho_intel.cam-outfrq_kessler_derecho (Overall: FAIL) -SMS_Ln9.ne5pg3_ne5pg3_mg37.FCAM7.derecho_intel.cam-outfrq_se_cslam_analy_ic (Overall: FAIL) -SMS_Ln9.ne5pg3_ne5pg3_mg37.FTJ16.derecho_gnu.cam-outfrq_se_cslam (Overall: FAIL) -SMS_Ln9.ne5pg3_ne5pg3_mg37.FKESSLER.derecho_gnu.cam-outfrq_se_cslam (Overall: FAIL) -SMS_Ln2.ne3pg3_ne3pg3_mg37.FPHYStest.derecho_gnu.cam-outfrq_kessler_derecho (Overall: FAIL) -SMS_Ln9.ne5pg3_ne5pg3_mg37.FCAM7.derecho_gnu.cam-outfrq_se_cslam_analy_ic (Overall: FAIL) - - will fail until https://github.com/ESCOMP/CAM-SIMA/pull/316 is merged +SMS_Ln9.ne5pg3_ne5pg3_mg37.FCAM7.derecho_intel.cam-outfrq_se_cslam_analy_ic (Overall: PEND) details: +SMS_Ln9.ne5pg3_ne5pg3_mg37.FCAM7.derecho_gnu.cam-outfrq_se_cslam_analy_ic (Overall: PEND) details: + - build failure due to dadadj_apply_qv_tendency removal, needs to be updated to use constituent tendency updater atmospheric_physics#179 + - also expected runtime failure CAM-SIMA#335 diff --git a/tools/stdnames_to_inputnames_dictionary.xml b/tools/stdnames_to_inputnames_dictionary.xml index 0ac72a21..dbd84b99 100644 --- a/tools/stdnames_to_inputnames_dictionary.xml +++ b/tools/stdnames_to_inputnames_dictionary.xml @@ -160,42 +160,47 @@ state_zi - + te_ini_phys state_te_ini_phys - + te_cur_phys state_te_cur_phys - + te_ini_dyn state_te_ini_dyn - + te_cur_dyn state_te_cur_dyn - + tw_ini state_tw_ini - + tw_cur state_tw_cur + + + cp_or_cv_dycore + + RHO From 2ed783aacea3046afc0c0e97f3b6252aff41473b Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Mon, 16 Dec 2024 12:08:04 -0500 Subject: [PATCH 26/27] Update standard names for tropopause_find (#329) Tag name (required for release branches): Originator(s): @jimmielin Description (include the issue title, and the keyword ['closes', 'fixes', 'resolves'] followed by the issue number): Fixes #308 by updating tropopause_find standard names. Describe any changes made to build system: N/A Describe any changes made to the namelist: N/A List any changes to the defaults for the input datasets (e.g. boundary datasets): N/A List all files eliminated and why: N/A List all files added and what they do: N/A List all existing files that have been modified, and describe the changes: (Helpful git command: `git diff --name-status development...`) Updates standard names for tropopause_find M src/physics/utils/tropopause_climo_read.F90 M src/physics/utils/tropopause_climo_read.meta If there are new failures (compared to the `test/existing-test-failures.txt` file), have them OK'd by the gatekeeper, note them here, and add them to the file. If there are baseline differences, include the test and the reason for the diff. What is the nature of the change? Roundoff? derecho/intel/aux_sima: derecho/gnu/aux_sima: If this changes climate describe any run(s) done to evaluate the new climate in enough detail that it(they) could be reproduced: CAM-SIMA date used for the baseline comparison tests if different than latest: --- .gitmodules | 2 +- src/physics/ncar_ccpp | 2 +- src/physics/utils/tropopause_climo_read.F90 | 4 ++-- src/physics/utils/tropopause_climo_read.meta | 10 +++++----- 4 files changed, 9 insertions(+), 9 deletions(-) diff --git a/.gitmodules b/.gitmodules index 5322028a..0fdc3af0 100644 --- a/.gitmodules +++ b/.gitmodules @@ -20,7 +20,7 @@ [submodule "ncar-physics"] path = src/physics/ncar_ccpp url = https://github.com/ESCOMP/atmospheric_physics - fxtag = e7a599f4bb1533f7cdcd8723b1f864e11578e96c + fxtag = 491e56247815ef23bfd8dba65d1e3c3b78ba164a fxrequired = AlwaysRequired fxDONOTUSEurl = https://github.com/ESCOMP/atmospheric_physics [submodule "ccs_config"] diff --git a/src/physics/ncar_ccpp b/src/physics/ncar_ccpp index e7a599f4..491e5624 160000 --- a/src/physics/ncar_ccpp +++ b/src/physics/ncar_ccpp @@ -1 +1 @@ -Subproject commit e7a599f4bb1533f7cdcd8723b1f864e11578e96c +Subproject commit 491e56247815ef23bfd8dba65d1e3c3b78ba164a diff --git a/src/physics/utils/tropopause_climo_read.F90 b/src/physics/utils/tropopause_climo_read.F90 index 7033d91b..c9369142 100644 --- a/src/physics/utils/tropopause_climo_read.F90 +++ b/src/physics/utils/tropopause_climo_read.F90 @@ -233,8 +233,8 @@ subroutine tropopause_climo_read_file() !-------------------------------------------------------- ! Mark variables as initialized so they are not read from initial conditions !-------------------------------------------------------- - call mark_as_initialized('tropopause_air_pressure_from_climatology_dataset') - call mark_as_initialized('tropopause_calendar_days_from_climatology') + call mark_as_initialized('tropopause_air_pressure_from_tropopause_climatology_dataset') + call mark_as_initialized('tropopause_calendar_days_from_tropopause_climatology') end subroutine tropopause_climo_read_file end module tropopause_climo_read diff --git a/src/physics/utils/tropopause_climo_read.meta b/src/physics/utils/tropopause_climo_read.meta index 6d4d8538..e42cc9b0 100644 --- a/src/physics/utils/tropopause_climo_read.meta +++ b/src/physics/utils/tropopause_climo_read.meta @@ -6,18 +6,18 @@ name = tropopause_climo_read type = module [ tropp_slices ] - standard_name = number_of_months_in_year + standard_name = number_of_time_slices_in_tropopause_climatology_dataset units = 1 type = integer dimensions = () [ tropp_p_loc ] - standard_name = tropopause_air_pressure_from_climatology_dataset + standard_name = tropopause_air_pressure_from_tropopause_climatology_dataset units = Pa type = real | kind = kind_phys - dimensions = (horizontal_dimension, number_of_months_in_year) + dimensions = (horizontal_dimension, number_of_time_slices_in_tropopause_climatology_dataset) [ tropp_days ] - standard_name = tropopause_calendar_days_from_climatology + standard_name = tropopause_calendar_days_from_tropopause_climatology long_name = Climatological tropopause calendar day indices from file units = 1 type = real | kind = kind_phys - dimensions = (number_of_months_in_year) + dimensions = (number_of_time_slices_in_tropopause_climatology_dataset) From a6d62898450bbaf74468bef9edcbc14d08609f1f Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Mon, 16 Dec 2024 13:21:58 -0500 Subject: [PATCH 27/27] Improve robustness of cam open/close file register code to fix issues with history output (#333) Tag name (required for release branches): Originator(s): @jimmielin Description (include the issue title, and the keyword ['closes', 'fixes', 'resolves'] followed by the issue number): - Fixes #332 (`max_mdims` used before defined) - Fixes #331 (unassociated `of%file_desc` in `cam_register_open_file` leading to crash with >2 history files) Describe any changes made to build system: N/A Describe any changes made to the namelist: N/A List any changes to the defaults for the input datasets (e.g. boundary datasets): N/A List all files eliminated and why: N/A List all files added and what they do: N/A List all existing files that have been modified, and describe the changes: (Helpful git command: `git diff --name-status development...`) ``` Fixes #331 M src/history/cam_hist_file.F90 Fixes #332 M src/utils/cam_abortutils.F90 ``` If there are new failures (compared to the `test/existing-test-failures.txt` file), have them OK'd by the gatekeeper, note them here, and add them to the file. If there are baseline differences, include the test and the reason for the diff. What is the nature of the change? Roundoff? derecho/intel/aux_sima: derecho/gnu/aux_sima: If this changes climate describe any run(s) done to evaluate the new climate in enough detail that it(they) could be reproduced: CAM-SIMA date used for the baseline comparison tests if different than latest: --- src/history/cam_hist_file.F90 | 1 + src/utils/cam_abortutils.F90 | 20 +++++++++++++------- 2 files changed, 14 insertions(+), 7 deletions(-) diff --git a/src/history/cam_hist_file.F90 b/src/history/cam_hist_file.F90 index 525440a1..7e8b75e8 100644 --- a/src/history/cam_hist_file.F90 +++ b/src/history/cam_hist_file.F90 @@ -1015,6 +1015,7 @@ subroutine config_define_file(this, restart, logname, host, model_doi_url) end do end do ! Determine the maximum number of dimensions + max_mdims = 0 do field_index = 1, size(this%field_list) max_mdims = max(max_mdims, size(this%field_list(field_index)%dimensions())) end do diff --git a/src/utils/cam_abortutils.F90 b/src/utils/cam_abortutils.F90 index ca6cd2ce..241c00ea 100644 --- a/src/utils/cam_abortutils.F90 +++ b/src/utils/cam_abortutils.F90 @@ -80,25 +80,31 @@ subroutine cam_register_open_file(file, file_name) end do ! If we get here, go ahead and register the file if (associated(open_files_pool)) then + ! Reuse pooled structure and point to the next pool entry of_new => open_files_pool + open_files_pool => open_files_pool%next allocate(of_new%file_desc, stat=ierr) call check_allocate(ierr, subname, 'of_file%file_desc', file=__FILE__, & line=__LINE__) of_new%file_desc = file of_new%file_name = file_name - allocate(open_files_pool%next) - open_files_pool%next => open_files_pool + nullify(of_new%next) else allocate(of_new) allocate(of_new%file_desc) of_new%file_desc = file of_new%file_name = file_name - open_files_pool => of_new - end if - open_files_tail => of_new - if (.not. associated(open_files_head)) then - open_files_head => of_new + nullify(of_new%next) end if + + ! Add the registered file to the tail of the open files list + if(associated(open_files_tail)) then + open_files_tail%next => of_new + open_files_tail => of_new + else + open_files_head => of_new + open_files_tail => of_new + endif end subroutine cam_register_open_file subroutine cam_register_close_file(file, log_shutdown_in)