From b0f4c626972b60c77de966378726a977128e4082 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Mon, 10 Jun 2024 14:18:04 -0400 Subject: [PATCH 01/24] add coupler_atmos_tracer_driver_gather_data, coupler_sfc_boundary_layer --- full/coupler_main.F90 | 20 +++++------------ full/full_coupler_mod.F90 | 45 ++++++++++++++++++++++++++++++++++++--- 2 files changed, 47 insertions(+), 18 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 4ae80dbd..cf784204 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -512,25 +512,15 @@ program coupler_main call fms_mpp_clock_begin(coupler_clocks%atmos_loop) do na = 1, num_atmos_calls if (do_chksum) call atmos_ice_land_chksum('top_of_atmos_loop-', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) Time_atmos = Time_atmos + Time_step_atmos - if (do_atmos) then - call fms_mpp_clock_begin(coupler_clocks%atmos_tracer_driver_gather_data) - call atmos_tracer_driver_gather_data(Atm%fields, Atm%tr_bot) - call fms_mpp_clock_end(coupler_clocks%atmos_tracer_driver_gather_data) - endif - - if (do_flux) then - call fms_mpp_clock_begin(coupler_clocks%sfc_boundary_layer) - call sfc_boundary_layer( REAL(dt_atmos), Time_atmos, & - Atm, Land, Ice, Land_ice_atmos_boundary ) - if (do_chksum) call atmos_ice_land_chksum('sfc+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - call fms_mpp_clock_end(coupler_clocks%sfc_boundary_layer) - endif + if (do_atmos) call coupler_atmos_tracer_driver_gather_data(Atm, coupler_clocks) + if (do_flux) call coupler_sfc_boundary_layer(Atm, Land, Ice, Land_ice_atmos_boundary, & + Atmos_ice_boundary,Atmos_land_boundary, Time_atmos, (nc-1)*num_atmos_calls+na, coupler_clocks) + !$OMP PARALLEL & !$OMP& NUM_THREADS(conc_nthreads) & !$OMP& DEFAULT(NONE) & diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index b5837e72..21b6765c 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -103,13 +103,12 @@ module full_coupler_mod public :: ice_model_fast_cleanup, unpack_land_ice_boundary public :: update_ice_model_slow public :: update_ocean_model, update_slow_ice_and_ocean - public :: sfc_boundary_layer, send_ice_mask_sic + public :: send_ice_mask_sic public :: flux_down_from_atmos, flux_up_to_atmos public :: flux_land_to_ice public :: flux_ice_to_ocean_finish public :: flux_ocean_from_ice_stocks, flux_ice_to_ocean_stocks public :: flux_atmos_to_ocean, flux_ex_arrays_dealloc - public :: atmos_tracer_driver_gather_data public :: atmos_model_restart, land_model_restart, ice_model_restart, ocean_model_restart @@ -132,7 +131,8 @@ module full_coupler_mod coupler_exchange_fast_to_slow_ice, coupler_set_ice_surface_fields public :: coupler_generate_sfc_xgrid - + public :: coupler_atmos_tracer_driver_gather_data, coupler_sfc_boundary_layer + public :: coupler_clock_type #include @@ -1866,4 +1866,43 @@ subroutine coupler_generate_sfc_xgrid(Land, Ice, coupler_clocks) end subroutine coupler_generate_sfc_xgrid + !> \brief This subroutine calls atmo_tracer_driver_gather_data. + !! Clocks are set before and after the call. + subroutine coupler_atmos_tracer_driver_gather_data(Atm, coupler_clocks) + + implicit none + + type(atmos_data_type), intent(inout) :: Atm !< Atm + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + call fms_mpp_clock_begin(coupler_clocks%atmos_tracer_driver_gather_data) + call atmos_tracer_driver_gather_data(Atm%fields, Atm%tr_bot) + call fms_mpp_clock_end(coupler_clocks%atmos_tracer_driver_gather_data) + + end subroutine coupler_atmos_tracer_driver_gather_data + + !> \brief This subroutine calls coupler_sfc_boundary_layer. Chksums are computed + !! if do_chksum = .True. Clocks are set for runtime statistics. + subroutine coupler_sfc_boundary_layer(Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_ice_boundary,& + Atmos_land_boundary, Time_atmos, current_time_step, coupler_clocks) + + implicit none + type(atmos_data_type), intent(inout) :: Atm !< Atm + type(land_data_type), intent(inout) :: Land !< Land + type(ice_data_type), intent(inout) :: Ice !< Ice + type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary + type(atmos_ice_boundary_type), intent(inout) :: Atmos_ice_boundary ! Date: Mon, 10 Jun 2024 14:24:22 -0400 Subject: [PATCH 02/24] fix compiler errors --- full/full_coupler_mod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 21b6765c..2a202cbc 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -1889,10 +1889,10 @@ subroutine coupler_sfc_boundary_layer(Atm, Land, Ice, Land_ice_atmos_boundary, A type(atmos_data_type), intent(inout) :: Atm !< Atm type(land_data_type), intent(inout) :: Land !< Land type(ice_data_type), intent(inout) :: Ice !< Ice - type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary - type(atmos_ice_boundary_type), intent(inout) :: Atmos_ice_boundary ! Date: Mon, 10 Jun 2024 14:29:04 -0400 Subject: [PATCH 03/24] dt_atmos is an integer? --- full/full_coupler_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 2a202cbc..f544308c 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -1897,7 +1897,7 @@ subroutine coupler_sfc_boundary_layer(Atm, Land, Ice, Land_ice_atmos_boundary, A type(coupler_clock_type), intent(in) :: coupler_clocks !< coupler_clocks call fms_mpp_clock_begin(coupler_clocks%sfc_boundary_layer) - call sfc_boundary_layer( dt_atmos, Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary ) + call sfc_boundary_layer( real(dt_atmos), Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary ) if (do_chksum) call atmos_ice_land_chksum('sfc+', current_time_step, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) call fms_mpp_clock_end(coupler_clocks%sfc_boundary_layer) From af41247d856cbbf9bb5033d9265a141b80b15c0a Mon Sep 17 00:00:00 2001 From: mlee03 Date: Tue, 11 Jun 2024 07:29:48 -0400 Subject: [PATCH 04/24] coupler_chksum_obj --- full/coupler_main.F90 | 28 +++++++++++---------- full/full_coupler_mod.F90 | 53 ++++++++++++++++++++++++++++++++++++++- 2 files changed, 67 insertions(+), 14 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index cf784204..93bd17db 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -339,21 +339,22 @@ program coupler_main use iso_fortran_env implicit none - !> model defined types - type (atmos_data_type) :: Atm - type (land_data_type) :: Land - type (ice_data_type) :: Ice + !> model defined types. + !! Targets to pointers in coupler_chksum_obj + type (atmos_data_type), target :: Atm + type (land_data_type), target :: Land + type (ice_data_type), target :: Ice ! allow members of ocean type to be aliased (ap) - type (ocean_public_type), target :: Ocean + type (ocean_public_type), target :: Ocean type (ocean_state_type), pointer :: Ocean_state => NULL() - type(atmos_land_boundary_type) :: Atmos_land_boundary - type(atmos_ice_boundary_type) :: Atmos_ice_boundary - type(land_ice_atmos_boundary_type) :: Land_ice_atmos_boundary - type(land_ice_boundary_type) :: Land_ice_boundary - type(ice_ocean_boundary_type) :: Ice_ocean_boundary - type(ocean_ice_boundary_type) :: Ocean_ice_boundary - type(ice_ocean_driver_type), pointer :: ice_ocean_driver_CS => NULL() + type(atmos_land_boundary_type), target :: Atmos_land_boundary + type(atmos_ice_boundary_type), target :: Atmos_ice_boundary + type(land_ice_atmos_boundary_type), target :: Land_ice_atmos_boundary + type(land_ice_boundary_type), target :: Land_ice_boundary + type(ice_ocean_boundary_type), target :: Ice_ocean_boundary + type(ocean_ice_boundary_type), target :: Ocean_ice_boundary + type(ice_ocean_driver_type), pointer :: ice_ocean_driver_CS => NULL() type(FmsTime_type) :: Time type(FmsTime_type) :: Time_step_atmos, Time_step_cpld @@ -371,6 +372,7 @@ program coupler_main character(len=32) :: timestamp type(coupler_clock_type) :: coupler_clocks + class(coupler_chksum_type) :: coupler_chksum_obj integer :: outunit character(len=80) :: text @@ -426,7 +428,7 @@ program coupler_main call coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, Atmos_ice_boundary, & Ocean_ice_boundary, Ice_ocean_boundary, Land_ice_atmos_boundary, Land_ice_boundary, & Ice_ocean_driver_CS, Ice_bc_restart, Ocn_bc_restart, ensemble_pelist, slow_ice_ocean_pelist, & - conc_nthreads, coupler_clocks, Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, & + conc_nthreads, coupler_clocks, coupler_chksum_obj, Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, & num_cpld_calls, num_atmos_calls, Time, Time_start, Time_end, Time_restart, Time_restart_current) if (do_chksum) call coupler_chksum('coupler_init+', 0, Atm, Land, Ice) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index f544308c..bf9b924c 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -276,6 +276,29 @@ module full_coupler_mod integer :: ocean_model_init integer :: flux_exchange_init end type coupler_clock_type + + type coupler_chksum_type + integer :: current_time_step + character(128) :: id + type(atmos_data_type), pointer :: Atm + type(land_data_type), pointer :: Land + type(ice_data_type), pointer :: Ice + type(ocean_public_type), pointer :: Ocean + type(atmos_land_boundary_type), pointer :: Atmos_land_boundary + type(atmos_ice_boundary_type), pointer :: Atmos_ice_boundary + type(land_ice_atmos_boundary_type), pointer :: Land_ice_boundary + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary + type(ocean_ice_boundary_type), pointer :: Ocean_ice_boundary + contains + procedure :: coupler_atmos_ice_land_ocean_chksum + procedure :: coupler_atmos_ice_land_chksum + procedure :: slow_ice_chksum + procedure :: ocean_chksum + procedure :: set_coupler_chksum_obj + end type coupler_chksum_type + + end type coupler_chksum_type + character(len=80) :: text character(len=48), parameter :: mod_name = 'coupler_main_mod' @@ -293,7 +316,7 @@ module full_coupler_mod subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, Atmos_ice_boundary, & Ocean_ice_boundary, Ice_ocean_boundary, Land_ice_atmos_boundary, Land_ice_boundary, & Ice_ocean_driver_CS, Ice_bc_restart, Ocn_bc_restart, ensemble_pelist, slow_ice_ocean_pelist, conc_nthreads, & - coupler_clocks, Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, & + coupler_clocks, coupler_chksum_obj, Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, & num_cpld_calls, num_atmos_calls, Time, Time_start, Time_end, Time_restart, Time_restart_current) implicit none @@ -317,6 +340,7 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, integer, allocatable, dimension(:), intent(inout) :: slow_ice_ocean_pelist type(coupler_clock_type) :: coupler_clocks + class(coupler_chksum_type) :: coupler_chksum_obj type(FMSTime_type), intent(inout) :: Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean type(FMSTime_type), intent(inout) :: Time, Time_start, Time_end, Time_restart, Time_restart_current @@ -1091,6 +1115,18 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, CALL fms_diag_grid_end() !----------------------------------------------------------------------- + + !> Initialize coupler_chksum_obj + coupler_chksum_obj%Atm => Atm + coupler_chksum_obj%Land => Land + coupler_chksum_obj%Ice => Ice + coupler_chksum_obj%Ocean => Ocean + coupler_chksum_obj%Atmos_land_boundary => Atmos_land_boundary + coupler_chksum_obj%Atmos_ice_boundary => Atmos_ice_boundary + coupler_chksum_obj%Land_ice_boundary => Land_ice_boundary + coupler_chksum_obj%Ice_ocean_boundary => Ice_ocean_boundary + coupler_chksum_obj%Ocean_ice_boundary => Ocean_ice_boundary + if ( do_endpoint_chksum ) then call coupler_atmos_ice_land_ocean_chksum('coupler_init+', 0, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary) @@ -1298,7 +1334,22 @@ subroutine coupler_restart(Atm, Ice, Ocean, Ocn_bc_restart, Ice_bc_restart, & end subroutine coupler_restart !-------------------------------------------------------------------------- + + !> \brief This function sets the current_type_step and id in the coupler_chksum_type + !! It returns itself + function set_coupler_chksum_obj(self, current_time_step, id) return(self) + implicit none + class(coupler_chksum_type), intent(inout) :: self + integer, intent(in) :: current_time_step + character(:), intent(in) :: id + + self%current_time_step = current_time_step + self%id = id + return self + + end function set_coupler_chksum_obj + !> \brief Print out checksums for several atm, land and ice variables subroutine coupler_chksum(id, timestep, Atm, Land, Ice) From cc4f04919ea81e5ccd2072f28ffd5974be3e1dc2 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Tue, 11 Jun 2024 14:32:23 -0400 Subject: [PATCH 05/24] chksum object update --- full/coupler_main.F90 | 4 +- full/full_coupler_mod.F90 | 80 +++++++++++++++++++-------------------- 2 files changed, 40 insertions(+), 44 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 93bd17db..4a1f1918 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -372,7 +372,7 @@ program coupler_main character(len=32) :: timestamp type(coupler_clock_type) :: coupler_clocks - class(coupler_chksum_type) :: coupler_chksum_obj + class(coupler_chksum_type) :: coupler_chksum_ojb integer :: outunit character(len=80) :: text @@ -550,7 +550,7 @@ program coupler_main ! ---- atmosphere dynamics ---- if (do_atmos) then call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_dynamics) - call update_atmos_model_dynamics( Atm ) + call update_atmos_model_dynamics( Atm, chksum%set_id('id', timestep )) call fms_mpp_clock_end(coupler_clocks%update_atmos_model_dynamics) endif if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_dynamics', (nc-1)*num_atmos_calls+na, & diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index bf9b924c..b243b88d 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -278,8 +278,6 @@ module full_coupler_mod end type coupler_clock_type type coupler_chksum_type - integer :: current_time_step - character(128) :: id type(atmos_data_type), pointer :: Atm type(land_data_type), pointer :: Land type(ice_data_type), pointer :: Ice @@ -289,17 +287,10 @@ module full_coupler_mod type(land_ice_atmos_boundary_type), pointer :: Land_ice_boundary type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary type(ocean_ice_boundary_type), pointer :: Ocean_ice_boundary - contains - procedure :: coupler_atmos_ice_land_ocean_chksum - procedure :: coupler_atmos_ice_land_chksum - procedure :: slow_ice_chksum - procedure :: ocean_chksum - procedure :: set_coupler_chksum_obj - end type coupler_chksum_type - + contains + procedure :: coupler_chksum_type_init end type coupler_chksum_type - - + character(len=80) :: text character(len=48), parameter :: mod_name = 'coupler_main_mod' @@ -1117,15 +1108,8 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, !----------------------------------------------------------------------- !> Initialize coupler_chksum_obj - coupler_chksum_obj%Atm => Atm - coupler_chksum_obj%Land => Land - coupler_chksum_obj%Ice => Ice - coupler_chksum_obj%Ocean => Ocean - coupler_chksum_obj%Atmos_land_boundary => Atmos_land_boundary - coupler_chksum_obj%Atmos_ice_boundary => Atmos_ice_boundary - coupler_chksum_obj%Land_ice_boundary => Land_ice_boundary - coupler_chksum_obj%Ice_ocean_boundary => Ice_ocean_boundary - coupler_chksum_obj%Ocean_ice_boundary => Ocean_ice_boundary + call coupler_chksum_obj%coupler_chksum_obj_init(self, Atm, Land, Ice, Ocean, Atmos_land_boundary, + Atmos_ice_boundary, Land_ice_boundary, Ice_ocean_boundary, Ocean_ice_boundary) if ( do_endpoint_chksum ) then call coupler_atmos_ice_land_ocean_chksum('coupler_init+', 0, Atm, Land, Ice, & @@ -1147,7 +1131,33 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, end subroutine coupler_init !####################################################################### + subroutine coupler_chksum_obj_init(self, Atm, Land, Ice, Ocean, Atmos_land_boundary, Atmos_ice_boundary, & + Land_ice_boundary, Ice_ocean_boundary, Ocean_ice_boundary) + implicit none + class(coupler_chksum_type), intent(inout) :: self + type(atmos_data_type), intent(in) :: Atm + type(land_data_type), intent(in) :: Land + type(ice_data_type), intent(in) :: Ice + type(atmos_land_boundary_type), intent(in) :: Atmos_land_boundary + type(atmos_ice_boundary_type), intent(in) :: Atmos_ice_boundary + type(land_ice_boundary_type), intent(in :: Land_ice_boundary + type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary + type(ocean_ice_boundary_type), intent(in) :: Ocean_ice_boundary + + self%Atm => Atm + self%Land => Land + self%Ice => Ice + self%Ocean => Ocean + self%Atmos_land_boundary => Atmos_land_boundary + self%Atmos_ice_boundary => Atmos_ice_boundary + self%Land_ice_boundary => Land_ice_boundary + self%Ice_ocean_boundary => Ice_ocean_boundary + self%Ocean_ice_boundary => Ocean_ice_boundary + + end subroutine coupler_chksum_type_init + + subroutine coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_boundary, Atmos_ice_boundary,& Atmos_land_boundary, Ice_ocean_boundary, Ocean_ice_boundary, Ocn_bc_restart, & Ice_bc_restart, Time, Time_start, Time_end, Time_restart_current) @@ -1335,21 +1345,6 @@ end subroutine coupler_restart !-------------------------------------------------------------------------- - !> \brief This function sets the current_type_step and id in the coupler_chksum_type - !! It returns itself - function set_coupler_chksum_obj(self, current_time_step, id) return(self) - implicit none - class(coupler_chksum_type), intent(inout) :: self - integer, intent(in) :: current_time_step - character(:), intent(in) :: id - - self%current_time_step = current_time_step - self%id = id - - return self - - end function set_coupler_chksum_obj - !> \brief Print out checksums for several atm, land and ice variables subroutine coupler_chksum(id, timestep, Atm, Land, Ice) @@ -1933,24 +1928,25 @@ end subroutine coupler_atmos_tracer_driver_gather_data !> \brief This subroutine calls coupler_sfc_boundary_layer. Chksums are computed !! if do_chksum = .True. Clocks are set for runtime statistics. - subroutine coupler_sfc_boundary_layer(Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_ice_boundary,& - Atmos_land_boundary, Time_atmos, current_time_step, coupler_clocks) + subroutine coupler_sfc_boundary_layer(Atm, Land, Ice, Land_ice_atmos_boundary, & + Time_atmos, current_type_step, coupler_chksum_bundle, coupler_clocks) implicit none type(atmos_data_type), intent(inout) :: Atm !< Atm type(land_data_type), intent(inout) :: Land !< Land type(ice_data_type), intent(inout) :: Ice !< Ice type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary !< Land_ice_atmos_boundary - type(atmos_ice_boundary_type), intent(inout) :: Atmos_ice_boundary ! Date: Tue, 11 Jun 2024 20:17:37 -0400 Subject: [PATCH 06/24] omg --- full/coupler_main.F90 | 14 ++++++---- full/full_coupler_mod.F90 | 56 ++++++++++++++++++++++----------------- 2 files changed, 40 insertions(+), 30 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 4a1f1918..b3094226 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -363,6 +363,7 @@ program coupler_main integer :: num_atmos_calls, na integer :: num_cpld_calls, nc + integer :: current_timestep type(FmsNetcdfDomainFile_t), dimension(:), pointer :: Ice_bc_restart => NULL() type(FmsNetcdfDomainFile_t), dimension(:), pointer :: Ocn_bc_restart => NULL() @@ -372,7 +373,7 @@ program coupler_main character(len=32) :: timestamp type(coupler_clock_type) :: coupler_clocks - class(coupler_chksum_type) :: coupler_chksum_ojb + type(coupler_chksum_type) :: coupler_chksum_obj integer :: outunit character(len=80) :: text @@ -513,15 +514,18 @@ program coupler_main call fms_mpp_clock_begin(coupler_clocks%atmos_loop) do na = 1, num_atmos_calls - if (do_chksum) call atmos_ice_land_chksum('top_of_atmos_loop-', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) Time_atmos = Time_atmos + Time_step_atmos + current_timestep = (nc-1)*num_atmos_calls+na + + if (do_chksum) call atmos_ice_land_chksum('top_of_atmos_loop-', current_timestep, Atm, Land, Ice, & + Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) if (do_atmos) call coupler_atmos_tracer_driver_gather_data(Atm, coupler_clocks) if (do_flux) call coupler_sfc_boundary_layer(Atm, Land, Ice, Land_ice_atmos_boundary, & - Atmos_ice_boundary,Atmos_land_boundary, Time_atmos, (nc-1)*num_atmos_calls+na, coupler_clocks) + Time_atmos, current_timestep, coupler_chksum_obj, coupler_clocks) + !$OMP PARALLEL & !$OMP& NUM_THREADS(conc_nthreads) & @@ -550,7 +554,7 @@ program coupler_main ! ---- atmosphere dynamics ---- if (do_atmos) then call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_dynamics) - call update_atmos_model_dynamics( Atm, chksum%set_id('id', timestep )) + call update_atmos_model_dynamics(Atm) call fms_mpp_clock_end(coupler_clocks%update_atmos_model_dynamics) endif if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_dynamics', (nc-1)*num_atmos_calls+na, & diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index b243b88d..a74c9623 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -133,7 +133,7 @@ module full_coupler_mod public :: coupler_generate_sfc_xgrid public :: coupler_atmos_tracer_driver_gather_data, coupler_sfc_boundary_layer - public :: coupler_clock_type + public :: coupler_clock_type, coupler_chksum_type #include @@ -282,13 +282,14 @@ module full_coupler_mod type(land_data_type), pointer :: Land type(ice_data_type), pointer :: Ice type(ocean_public_type), pointer :: Ocean + type(land_ice_atmos_boundary_type), pointer :: Land_ice_atmos_boundary type(atmos_land_boundary_type), pointer :: Atmos_land_boundary type(atmos_ice_boundary_type), pointer :: Atmos_ice_boundary - type(land_ice_atmos_boundary_type), pointer :: Land_ice_boundary - type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary - type(ocean_ice_boundary_type), pointer :: Ocean_ice_boundary + type(land_ice_boundary_type), pointer :: Land_ice_boundary + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary + type(ocean_ice_boundary_type), pointer :: Ocean_ice_boundary contains - procedure :: coupler_chksum_type_init + procedure :: coupler_chksum_obj_init end type coupler_chksum_type character(len=80) :: text @@ -331,7 +332,7 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, integer, allocatable, dimension(:), intent(inout) :: slow_ice_ocean_pelist type(coupler_clock_type) :: coupler_clocks - class(coupler_chksum_type) :: coupler_chksum_obj + type(coupler_chksum_type) :: coupler_chksum_obj type(FMSTime_type), intent(inout) :: Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean type(FMSTime_type), intent(inout) :: Time, Time_start, Time_end, Time_restart, Time_restart_current @@ -1108,8 +1109,9 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, !----------------------------------------------------------------------- !> Initialize coupler_chksum_obj - call coupler_chksum_obj%coupler_chksum_obj_init(self, Atm, Land, Ice, Ocean, Atmos_land_boundary, - Atmos_ice_boundary, Land_ice_boundary, Ice_ocean_boundary, Ocean_ice_boundary) + call coupler_chksum_obj%coupler_chksum_obj_init(Atm, Land, Ice, Ocean, Land_ice_atmos_boundary, & + Atmos_land_boundary,Atmos_ice_boundary, Land_ice_boundary, & + Ice_ocean_boundary, Ocean_ice_boundary) if ( do_endpoint_chksum ) then call coupler_atmos_ice_land_ocean_chksum('coupler_init+', 0, Atm, Land, Ice, & @@ -1131,31 +1133,34 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, end subroutine coupler_init !####################################################################### - subroutine coupler_chksum_obj_init(self, Atm, Land, Ice, Ocean, Atmos_land_boundary, Atmos_ice_boundary, & - Land_ice_boundary, Ice_ocean_boundary, Ocean_ice_boundary) + subroutine coupler_chksum_obj_init(self, Atm, Land, Ice, Ocean, Land_ice_atmos_boundary, Atmos_land_boundary, & + Atmos_ice_boundary, Land_ice_boundary, Ice_ocean_boundary, Ocean_ice_boundary) implicit none class(coupler_chksum_type), intent(inout) :: self - type(atmos_data_type), intent(in) :: Atm - type(land_data_type), intent(in) :: Land - type(ice_data_type), intent(in) :: Ice - type(atmos_land_boundary_type), intent(in) :: Atmos_land_boundary - type(atmos_ice_boundary_type), intent(in) :: Atmos_ice_boundary - type(land_ice_boundary_type), intent(in :: Land_ice_boundary - type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary - type(ocean_ice_boundary_type), intent(in) :: Ocean_ice_boundary + type(atmos_data_type), target, intent(in) :: Atm + type(land_data_type), target, intent(in) :: Land + type(ice_data_type), target, intent(in) :: Ice + type(ocean_public_type), target, intent(in) :: Ocean + type(land_ice_atmos_boundary_type), target, intent(in) :: Land_ice_atmos_boundary + type(atmos_land_boundary_type), target, intent(in) :: Atmos_land_boundary + type(atmos_ice_boundary_type), target, intent(in) :: Atmos_ice_boundary + type(land_ice_boundary_type), target, intent(in) :: Land_ice_boundary + type(ice_ocean_boundary_type), target, intent(in) :: Ice_ocean_boundary + type(ocean_ice_boundary_type), target, intent(in) :: Ocean_ice_boundary self%Atm => Atm self%Land => Land self%Ice => Ice self%Ocean => Ocean + self%Land_ice_atmos_boundary => Land_ice_atmos_boundary self%Atmos_land_boundary => Atmos_land_boundary self%Atmos_ice_boundary => Atmos_ice_boundary self%Land_ice_boundary => Land_ice_boundary self%Ice_ocean_boundary => Ice_ocean_boundary self%Ocean_ice_boundary => Ocean_ice_boundary - end subroutine coupler_chksum_type_init + end subroutine coupler_chksum_obj_init subroutine coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_boundary, Atmos_ice_boundary,& @@ -1929,7 +1934,7 @@ end subroutine coupler_atmos_tracer_driver_gather_data !> \brief This subroutine calls coupler_sfc_boundary_layer. Chksums are computed !! if do_chksum = .True. Clocks are set for runtime statistics. subroutine coupler_sfc_boundary_layer(Atm, Land, Ice, Land_ice_atmos_boundary, & - Time_atmos, current_type_step, coupler_chksum_bundle, coupler_clocks) + Time_atmos, current_time_step, coupler_chksum_obj, coupler_clocks) implicit none type(atmos_data_type), intent(inout) :: Atm !< Atm @@ -1938,17 +1943,18 @@ subroutine coupler_sfc_boundary_layer(Atm, Land, Ice, Land_ice_atmos_boundary, & type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary !< Land_ice_atmos_boundary type(FmsTime_type), intent(in) :: Time_atmos !< Atmos time integer, intent(in) :: current_time_step !< (nc-1)*num_atmos_cal + na - type(coupler_clock_type), intent(in) :: coupler_clocks !< coupler_clocks + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks call fms_mpp_clock_begin(coupler_clocks%sfc_boundary_layer) call sfc_boundary_layer( real(dt_atmos), Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary ) if (do_chksum) call atmos_ice_land_chksum('sfc+', current_time_step, Atm, Land, Ice, & - Land_ice_atmos_boundary, coupler_chksum_bundle%Atmos_ice_boundary, & - coupler_chksum_boundle%Atmos_land_boundary) - + Land_ice_atmos_boundary, coupler_chksum_obj%Atmos_ice_boundary, & + coupler_chksum_obj%Atmos_land_boundary) + call fms_mpp_clock_end(coupler_clocks%sfc_boundary_layer) - + end subroutine coupler_sfc_boundary_layer From 91a1a0356843ec9bd144cc4e10ff9becb4d9813e Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 12 Jun 2024 07:17:14 -0400 Subject: [PATCH 07/24] turn of and on chksums --- full/full_coupler_mod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index a74c9623..28d97e68 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -1113,6 +1113,7 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, Atmos_land_boundary,Atmos_ice_boundary, Land_ice_boundary, & Ice_ocean_boundary, Ocean_ice_boundary) + do_endpoint_chksum = .False. if ( do_endpoint_chksum ) then call coupler_atmos_ice_land_ocean_chksum('coupler_init+', 0, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary) @@ -1949,7 +1950,7 @@ subroutine coupler_sfc_boundary_layer(Atm, Land, Ice, Land_ice_atmos_boundary, & call fms_mpp_clock_begin(coupler_clocks%sfc_boundary_layer) call sfc_boundary_layer( real(dt_atmos), Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary ) - if (do_chksum) call atmos_ice_land_chksum('sfc+', current_time_step, Atm, Land, Ice, & + call atmos_ice_land_chksum('sfc+', current_time_step, Atm, Land, Ice, & Land_ice_atmos_boundary, coupler_chksum_obj%Atmos_ice_boundary, & coupler_chksum_obj%Atmos_land_boundary) From a213bf22f3e8fbe74b415b61a5284ca84863ec46 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 12 Jun 2024 10:23:27 -0400 Subject: [PATCH 08/24] remove trailing whitespace --- full/coupler_main.F90 | 4 ++-- full/full_coupler_mod.F90 | 30 +++++++++++++++--------------- 2 files changed, 17 insertions(+), 17 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index b3094226..c9e392a0 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -345,7 +345,7 @@ program coupler_main type (land_data_type), target :: Land type (ice_data_type), target :: Ice ! allow members of ocean type to be aliased (ap) - type (ocean_public_type), target :: Ocean + type (ocean_public_type), target :: Ocean type (ocean_state_type), pointer :: Ocean_state => NULL() type(atmos_land_boundary_type), target :: Atmos_land_boundary @@ -526,7 +526,7 @@ program coupler_main if (do_flux) call coupler_sfc_boundary_layer(Atm, Land, Ice, Land_ice_atmos_boundary, & Time_atmos, current_timestep, coupler_chksum_obj, coupler_clocks) - + !$OMP PARALLEL & !$OMP& NUM_THREADS(conc_nthreads) & !$OMP& DEFAULT(NONE) & diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 28d97e68..b312fffb 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -132,7 +132,7 @@ module full_coupler_mod public :: coupler_generate_sfc_xgrid public :: coupler_atmos_tracer_driver_gather_data, coupler_sfc_boundary_layer - + public :: coupler_clock_type, coupler_chksum_type #include @@ -276,9 +276,9 @@ module full_coupler_mod integer :: ocean_model_init integer :: flux_exchange_init end type coupler_clock_type - + type coupler_chksum_type - type(atmos_data_type), pointer :: Atm + type(atmos_data_type), pointer :: Atm type(land_data_type), pointer :: Land type(ice_data_type), pointer :: Ice type(ocean_public_type), pointer :: Ocean @@ -291,7 +291,7 @@ module full_coupler_mod contains procedure :: coupler_chksum_obj_init end type coupler_chksum_type - + character(len=80) :: text character(len=48), parameter :: mod_name = 'coupler_main_mod' @@ -1149,7 +1149,7 @@ subroutine coupler_chksum_obj_init(self, Atm, Land, Ice, Ocean, Land_ice_atmos_b type(land_ice_boundary_type), target, intent(in) :: Land_ice_boundary type(ice_ocean_boundary_type), target, intent(in) :: Ice_ocean_boundary type(ocean_ice_boundary_type), target, intent(in) :: Ocean_ice_boundary - + self%Atm => Atm self%Land => Land self%Ice => Ice @@ -1159,11 +1159,11 @@ subroutine coupler_chksum_obj_init(self, Atm, Land, Ice, Ocean, Land_ice_atmos_b self%Atmos_ice_boundary => Atmos_ice_boundary self%Land_ice_boundary => Land_ice_boundary self%Ice_ocean_boundary => Ice_ocean_boundary - self%Ocean_ice_boundary => Ocean_ice_boundary + self%Ocean_ice_boundary => Ocean_ice_boundary end subroutine coupler_chksum_obj_init - + subroutine coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_boundary, Atmos_ice_boundary,& Atmos_land_boundary, Ice_ocean_boundary, Ocean_ice_boundary, Ocn_bc_restart, & Ice_bc_restart, Time, Time_start, Time_end, Time_restart_current) @@ -1350,7 +1350,7 @@ subroutine coupler_restart(Atm, Ice, Ocean, Ocn_bc_restart, Ice_bc_restart, & end subroutine coupler_restart !-------------------------------------------------------------------------- - + !> \brief Print out checksums for several atm, land and ice variables subroutine coupler_chksum(id, timestep, Atm, Land, Ice) @@ -1923,8 +1923,8 @@ end subroutine coupler_generate_sfc_xgrid subroutine coupler_atmos_tracer_driver_gather_data(Atm, coupler_clocks) implicit none - - type(atmos_data_type), intent(inout) :: Atm !< Atm + + type(atmos_data_type), intent(inout) :: Atm !< Atm type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks call fms_mpp_clock_begin(coupler_clocks%atmos_tracer_driver_gather_data) call atmos_tracer_driver_gather_data(Atm%fields, Atm%tr_bot) @@ -1946,17 +1946,17 @@ subroutine coupler_sfc_boundary_layer(Atm, Land, Ice, Land_ice_atmos_boundary, & integer, intent(in) :: current_time_step !< (nc-1)*num_atmos_cal + na type(coupler_chksum_type), intent(in) :: coupler_chksum_obj type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks - + call fms_mpp_clock_begin(coupler_clocks%sfc_boundary_layer) call sfc_boundary_layer( real(dt_atmos), Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary ) call atmos_ice_land_chksum('sfc+', current_time_step, Atm, Land, Ice, & Land_ice_atmos_boundary, coupler_chksum_obj%Atmos_ice_boundary, & coupler_chksum_obj%Atmos_land_boundary) - + call fms_mpp_clock_end(coupler_clocks%sfc_boundary_layer) - + end subroutine coupler_sfc_boundary_layer - - + + end module full_coupler_mod From 9cb6438ead21d210d84147957ec5edc7f37f3f4d Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 12 Jun 2024 10:26:49 -0400 Subject: [PATCH 09/24] intent(inout) --- full/full_coupler_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index b312fffb..06a2648e 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -331,8 +331,8 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, integer, allocatable, dimension(:,:), intent(inout) :: ensemble_pelist integer, allocatable, dimension(:), intent(inout) :: slow_ice_ocean_pelist - type(coupler_clock_type) :: coupler_clocks - type(coupler_chksum_type) :: coupler_chksum_obj + type(coupler_clock_type), intent(inout) :: coupler_clocks + type(coupler_chksum_type), intent(inout) :: coupler_chksum_obj type(FMSTime_type), intent(inout) :: Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean type(FMSTime_type), intent(inout) :: Time, Time_start, Time_end, Time_restart, Time_restart_current From 3ef50f83e15e63fd0070a8570517d67117c398af Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 12 Jun 2024 10:31:28 -0400 Subject: [PATCH 10/24] remove test stuff --- full/full_coupler_mod.F90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 06a2648e..bc99c26d 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -1113,7 +1113,6 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, Atmos_land_boundary,Atmos_ice_boundary, Land_ice_boundary, & Ice_ocean_boundary, Ocean_ice_boundary) - do_endpoint_chksum = .False. if ( do_endpoint_chksum ) then call coupler_atmos_ice_land_ocean_chksum('coupler_init+', 0, Atm, Land, Ice, & Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary) @@ -1950,9 +1949,9 @@ subroutine coupler_sfc_boundary_layer(Atm, Land, Ice, Land_ice_atmos_boundary, & call fms_mpp_clock_begin(coupler_clocks%sfc_boundary_layer) call sfc_boundary_layer( real(dt_atmos), Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary ) - call atmos_ice_land_chksum('sfc+', current_time_step, Atm, Land, Ice, & - Land_ice_atmos_boundary, coupler_chksum_obj%Atmos_ice_boundary, & - coupler_chksum_obj%Atmos_land_boundary) + if(do_chksum) call atmos_ice_land_chksum('sfc+', current_time_step, Atm, Land, Ice, & + Land_ice_atmos_boundary, coupler_chksum_obj%Atmos_ice_boundary, & + coupler_chksum_obj%Atmos_land_boundary) call fms_mpp_clock_end(coupler_clocks%sfc_boundary_layer) From 0fa24c964f12efee20f68bca0de18bb2f6fe9d8a Mon Sep 17 00:00:00 2001 From: mlee03 Date: Thu, 13 Jun 2024 12:58:28 -0400 Subject: [PATCH 11/24] chksum object --- full/coupler_main.F90 | 77 ++++++------ full/full_coupler_mod.F90 | 247 +++++++++++++++++++------------------- 2 files changed, 160 insertions(+), 164 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index c9e392a0..ea51eddb 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -432,7 +432,7 @@ program coupler_main conc_nthreads, coupler_clocks, coupler_chksum_obj, Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, & num_cpld_calls, num_atmos_calls, Time, Time_start, Time_end, Time_restart, Time_restart_current) - if (do_chksum) call coupler_chksum('coupler_init+', 0, Atm, Land, Ice) + if (do_chksum) call coupler_chksum('coupler_init+', 0, coupler_chksum_obj) call fms_mpp_set_current_pelist() call fms_mpp_clock_end(coupler_clocks%initialization) !end initialization @@ -448,10 +448,8 @@ program coupler_main do nc = 1, num_cpld_calls if (do_chksum) then - call coupler_chksum('top_of_coupled_loop+', nc, Atm, Land, Ice) - call coupler_atmos_ice_land_ocean_chksum('MAIN_LOOP-', nc, Atm, Land, Ice,& - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, & - Ocean, Ice_ocean_boundary) + call coupler_chksum('top_of_coupled_loop+', nc, coupler_chksum_obj) + call coupler_atmos_ice_land_ocean_chksum('MAIN_LOOP-', nc, coupler_chksum_obj) end if ! Calls to flux_ocean_to_ice and flux_ice_to_ocean are all PE communication @@ -472,18 +470,16 @@ program coupler_main end if if (do_chksum) then - call coupler_chksum('flux_ocn2ice+', nc, Atm, Land, Ice) - call coupler_atmos_ice_land_ocean_chksum('flux_ocn2ice+', nc, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, & - Ocean, Ice_ocean_boundary) + call coupler_chksum('flux_ocn2ice+', nc, coupler_chksum_obj) + call coupler_atmos_ice_land_ocean_chksum('flux_ocn2ice+', nc, coupler_chksum_obj) end if ! needs to sit here rather than at the end of the coupler loop. if (check_stocks > 0) call coupler_flux_check_stocks(nc, Time, Atm, Land, Ice, Ocean_state, coupler_clocks) if (do_ice .and. Ice%pe) then - if (Ice%slow_ice_pe) & - call coupler_unpack_ocean_ice_boundary(nc, Time_flux_ocean_to_ice, Ice, Ocean_ice_boundary, coupler_clocks) + if (Ice%slow_ice_pe) call coupler_unpack_ocean_ice_boundary(nc, Time_flux_ocean_to_ice, Ice, Ocean_ice_boundary,& + coupler_clocks, coupler_chksum_obj) ! This could be a point where the model is serialized if the fast and ! slow ice are on different PEs. call fms_mpp_set_current_pelist(Ice%pelist) @@ -501,8 +497,7 @@ program coupler_main if (.NOT.(do_ice.and.Ice%pe) .OR. (ice_npes.NE.atmos_npes)) call fms_mpp_set_current_pelist(Atm%pelist) - if(do_chksum) call atmos_ice_land_chksum('set_ice_surface+', nc, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + if(do_chksum) call atmos_ice_land_chksum('set_ice_surface+', nc, coupler_chksum_obj) call fms_mpp_clock_begin(coupler_clocks%atm) @@ -518,8 +513,7 @@ program coupler_main Time_atmos = Time_atmos + Time_step_atmos current_timestep = (nc-1)*num_atmos_calls+na - if (do_chksum) call atmos_ice_land_chksum('top_of_atmos_loop-', current_timestep, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + if (do_chksum) call atmos_ice_land_chksum('top_of_atmos_loop-', current_timestep, coupler_chksum_obj) if (do_atmos) call coupler_atmos_tracer_driver_gather_data(Atm, coupler_clocks) @@ -535,7 +529,7 @@ program coupler_main !$OMP& SHARED(Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, Atmos_ice_boundary) & !$OMP& SHARED(Ocean_ice_boundary) & !$OMP& SHARED(do_debug, do_chksum, do_atmos, do_land, do_ice, do_concurrent_radiation, omp_sec, imb_sec) & -!$OMP& SHARED(coupler_clocks) +!$OMP& SHARED(coupler_clocks, coupler_chksum_obj) !$ if (omp_get_thread_num() == 0) then !$OMP PARALLEL & !$OMP& NUM_THREADS(1) & @@ -545,7 +539,7 @@ program coupler_main !$OMP& SHARED(Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, Atmos_ice_boundary) & !$OMP& SHARED(Ocean_ice_boundary) & !$OMP& SHARED(do_debug, do_chksum, do_atmos, do_land, do_ice, do_concurrent_radiation, omp_sec, imb_sec) & -!$OMP& SHARED(coupler_clocks) +!$OMP& SHARED(coupler_clocks, coupler_chksum_obj) !$ call omp_set_num_threads(atmos_nthreads) !$ dsec=omp_get_wtime() @@ -558,7 +552,7 @@ program coupler_main call fms_mpp_clock_end(coupler_clocks%update_atmos_model_dynamics) endif if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_dynamics', (nc-1)*num_atmos_calls+na, & - Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + coupler_chksum_obj) if (do_debug) call fms_memutils_print_memuse_stats( 'update dyn') ! ---- SERIAL atmosphere radiation ---- @@ -568,7 +562,7 @@ program coupler_main call fms_mpp_clock_end(coupler_clocks%serial_radiation) endif if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_radiation(ser)', (nc-1)*num_atmos_calls+na, & - Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + coupler_chksum_obj) if (do_debug) call fms_memutils_print_memuse_stats( 'update serial rad') ! ---- atmosphere down ---- @@ -577,8 +571,8 @@ program coupler_main call update_atmos_model_down( Land_ice_atmos_boundary, Atm ) call fms_mpp_clock_end(coupler_clocks%update_atmos_model_down) endif - if (do_chksum) call atmos_ice_land_chksum('update_atmos_down+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + if (do_chksum) call atmos_ice_land_chksum('update_atmos_down+', (nc-1)*num_atmos_calls+na, & + coupler_chksum_obj) if (do_debug) call fms_memutils_print_memuse_stats( 'update down') call fms_mpp_clock_begin(coupler_clocks%flux_down_from_atmos) @@ -587,8 +581,8 @@ program coupler_main Atmos_land_boundary, & Atmos_ice_boundary ) call fms_mpp_clock_end(coupler_clocks%flux_down_from_atmos) - if (do_chksum) call atmos_ice_land_chksum('flux_down_from_atmos+', (nc-1)*num_atmos_calls+na, Atm, Land, & - Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + if (do_chksum) call atmos_ice_land_chksum('flux_down_from_atmos+', (nc-1)*num_atmos_calls+na,& + coupler_chksum_obj) ! -------------------------------------------------------------- ! ---- land model ---- @@ -599,8 +593,8 @@ program coupler_main endif if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Atm%pelist) call fms_mpp_clock_end(coupler_clocks%update_land_model_fast) - if (do_chksum) call atmos_ice_land_chksum('update_land_fast+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + if (do_chksum) call atmos_ice_land_chksum('update_land_fast+', (nc-1)*num_atmos_calls+na, & + coupler_chksum_obj) if (do_debug) call fms_memutils_print_memuse_stats( 'update land') ! ---- ice model ---- @@ -611,8 +605,8 @@ program coupler_main endif if (ice_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Atm%pelist) call fms_mpp_clock_end(coupler_clocks%update_ice_model_fast) - if (do_chksum) call atmos_ice_land_chksum('update_ice_fast+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + if (do_chksum) call atmos_ice_land_chksum('update_ice_fast+', (nc-1)*num_atmos_calls+na,& + coupler_chksum_obj) if (do_debug) call fms_memutils_print_memuse_stats( 'update ice') ! -------------------------------------------------------------- @@ -621,15 +615,14 @@ program coupler_main call flux_up_to_atmos( Time_atmos, Land, Ice, Land_ice_atmos_boundary, & Atmos_land_boundary, Atmos_ice_boundary ) call fms_mpp_clock_end(coupler_clocks%flux_up_to_atmos) - if (do_chksum) call atmos_ice_land_chksum('flux_up2atmos+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + if (do_chksum) call atmos_ice_land_chksum('flux_up2atmos+', (nc-1)*num_atmos_calls+na,coupler_chksum_obj) call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_up) if (do_atmos) & call update_atmos_model_up( Land_ice_atmos_boundary, Atm) call fms_mpp_clock_end(coupler_clocks%update_atmos_model_up) - if (do_chksum) call atmos_ice_land_chksum('update_atmos_up+', (nc-1)*num_atmos_calls+na, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + if (do_chksum) call atmos_ice_land_chksum('update_atmos_up+', (nc-1)*num_atmos_calls+na, & + coupler_chksum_obj) if (do_debug) call fms_memutils_print_memuse_stats( 'update up') call flux_atmos_to_ocean(Time_atmos, Atm, Atmos_ice_boundary, Ice) @@ -674,8 +667,8 @@ program coupler_main call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_state) call update_atmos_model_state( Atm ) - if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_state+', (nc-1)*num_atmos_calls+na, Atm, Land, & - Ice,Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_state+', (nc-1)*num_atmos_calls+na,& + coupler_chksum_obj) if (do_debug) call fms_memutils_print_memuse_stats( 'update state') call fms_mpp_clock_end(coupler_clocks%update_atmos_model_state) @@ -692,8 +685,7 @@ program coupler_main if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Atm%pelist) !----------------------------------------------------------------------- call fms_mpp_clock_end(coupler_clocks%update_land_model_slow) - if (do_chksum) call atmos_ice_land_chksum('update_land_slow+', nc, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + if (do_chksum) call atmos_ice_land_chksum('update_land_slow+', nc, coupler_chksum_obj) ! ! need flux call to put runoff and p_surf on ice grid @@ -701,8 +693,7 @@ program coupler_main call fms_mpp_clock_begin(coupler_clocks%flux_land_to_ice) call flux_land_to_ice( Time, Land, Ice, Land_ice_boundary ) call fms_mpp_clock_end(coupler_clocks%flux_land_to_ice) - if (do_chksum) call atmos_ice_land_chksum('fluxlnd2ice+', nc, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + if (do_chksum) call atmos_ice_land_chksum('fluxlnd2ice+', nc, coupler_chksum_obj) Atmos_ice_boundary%p = 0.0 ! call flux_atmos_to_ice_slow ? Time = Time_atmos @@ -743,7 +734,7 @@ program coupler_main call fms_mpp_clock_end(coupler_clocks%update_ice_model_slow_slow) endif - if (do_chksum) call slow_ice_chksum('update_ice_slow+', nc, Ice, Ocean_ice_boundary) + if (do_chksum) call slow_ice_chksum('update_ice_slow+', nc, coupler_chksum_obj) endif ! End of Ice%pe block if(Atm%pe) then @@ -772,7 +763,7 @@ program coupler_main call update_slow_ice_and_ocean(ice_ocean_driver_CS, Ice, Ocean_state, Ocean, & Ice_ocean_boundary, Time_ocean, Time_step_cpld ) else - if (do_chksum) call ocean_chksum('update_ocean_model-', nc, Ocean, Ice_ocean_boundary) + if (do_chksum) call ocean_chksum('update_ocean_model-', nc, coupler_chksum_obj) ! update_ocean_model since fluxes don't change here if (do_ocean) & @@ -780,7 +771,7 @@ program coupler_main Time_ocean, Time_step_cpld ) endif - if (do_chksum) call ocean_chksum('update_ocean_model+', nc, Ocean, Ice_ocean_boundary) + if (do_chksum) call ocean_chksum('update_ocean_model+', nc, coupler_chksum_obj) ! Get stocks from "Ice_ocean_boundary" and add them to Ocean stocks. ! This call is just for record keeping of stocks transfer and ! does not modify either Ocean or Ice_ocean_boundary @@ -815,7 +806,7 @@ program coupler_main endif !-------------- - if (do_chksum) call coupler_chksum('MAIN_LOOP+', nc, Atm, Land, Ice) + if (do_chksum) call coupler_chksum('MAIN_LOOP+', nc, coupler_chksum_obj) write( text,'(a,i6)' )'Main loop at coupling timestep=', nc call fms_memutils_print_memuse_stats(text) outunit= fms_mpp_stdout() @@ -837,10 +828,10 @@ program coupler_main call fms_mpp_clock_end(coupler_clocks%main) call fms_mpp_clock_begin(coupler_clocks%termination) - if (do_chksum) call coupler_chksum('coupler_end-', nc, Atm, Land, Ice) + if (do_chksum) call coupler_chksum('coupler_end-', nc, coupler_chksum_obj) call coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_boundary, Atmos_ice_boundary,& Atmos_land_boundary, Ice_ocean_boundary, Ocean_ice_boundary, Ocn_bc_restart, Ice_bc_restart, & - Time, Time_start, Time_end, Time_restart_current) + Time, Time_start, Time_end, Time_restart_current, coupler_chksum_obj) call fms_mpp_clock_end(coupler_clocks%termination) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index bc99c26d..ddf9c564 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -278,6 +278,7 @@ module full_coupler_mod end type coupler_clock_type type coupler_chksum_type + private type(atmos_data_type), pointer :: Atm type(land_data_type), pointer :: Land type(ice_data_type), pointer :: Ice @@ -289,7 +290,8 @@ module full_coupler_mod type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary type(ocean_ice_boundary_type), pointer :: Ocean_ice_boundary contains - procedure :: coupler_chksum_obj_init + procedure, public :: coupler_chksum_obj_init + procedure, public :: get_component end type coupler_chksum_type character(len=80) :: text @@ -1114,11 +1116,10 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, Ice_ocean_boundary, Ocean_ice_boundary) if ( do_endpoint_chksum ) then - call coupler_atmos_ice_land_ocean_chksum('coupler_init+', 0, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary) + call coupler_atmos_ice_land_ocean_chksum('coupler_init+', 0, coupler_chksum_obj) if (Ice%slow_ice_PE) then call fms_mpp_set_current_pelist(Ice%slow_pelist) - call slow_ice_chksum('coupler_init+', 0, Ice, Ocean_ice_boundary) + call slow_ice_chksum('coupler_init+', 0, coupler_chksum_obj) end if end if @@ -1133,11 +1134,11 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, end subroutine coupler_init !####################################################################### - subroutine coupler_chksum_obj_init(self, Atm, Land, Ice, Ocean, Land_ice_atmos_boundary, Atmos_land_boundary, & + subroutine coupler_chksum_obj_init(this, Atm, Land, Ice, Ocean, Land_ice_atmos_boundary, Atmos_land_boundary, & Atmos_ice_boundary, Land_ice_boundary, Ice_ocean_boundary, Ocean_ice_boundary) implicit none - class(coupler_chksum_type), intent(inout) :: self + class(coupler_chksum_type), intent(inout) :: this type(atmos_data_type), target, intent(in) :: Atm type(land_data_type), target, intent(in) :: Land type(ice_data_type), target, intent(in) :: Ice @@ -1149,23 +1150,53 @@ subroutine coupler_chksum_obj_init(self, Atm, Land, Ice, Ocean, Land_ice_atmos_b type(ice_ocean_boundary_type), target, intent(in) :: Ice_ocean_boundary type(ocean_ice_boundary_type), target, intent(in) :: Ocean_ice_boundary - self%Atm => Atm - self%Land => Land - self%Ice => Ice - self%Ocean => Ocean - self%Land_ice_atmos_boundary => Land_ice_atmos_boundary - self%Atmos_land_boundary => Atmos_land_boundary - self%Atmos_ice_boundary => Atmos_ice_boundary - self%Land_ice_boundary => Land_ice_boundary - self%Ice_ocean_boundary => Ice_ocean_boundary - self%Ocean_ice_boundary => Ocean_ice_boundary + this%Atm => Atm + this%Land => Land + this%Ice => Ice + this%Ocean => Ocean + this%Land_ice_atmos_boundary => Land_ice_atmos_boundary + this%Atmos_land_boundary => Atmos_land_boundary + this%Atmos_ice_boundary => Atmos_ice_boundary + this%Land_ice_boundary => Land_ice_boundary + this%Ice_ocean_boundary => Ice_ocean_boundary + this%Ocean_ice_boundary => Ocean_ice_boundary end subroutine coupler_chksum_obj_init + !> Function get_component returns the requested component in the coupler_chksum_type object + !! Users are required to provide the component to be retrieved as an input argument. For example, + !! coupler_chksum_obj%get_component(Atm) will modify Atm to be Atm = coupler_chksum_obj%Atm + subroutine get_component(this, retrieve_component ) + implicit none + class(coupler_chksum_type), intent(in) :: this !< the coupler_chksum_type object + class(*), intent(inout) :: retrieve_component !< requested component to be retrieve. + !! retrieve_component can be of type atmos_data_type, land_data_type, ice_data_type, + !! ocean_public_type, land_ice_atmos_boundary_type, atmos_land_boundary_type, + !! atmos_ice_boundary_type, land_ice_boundary_type, ice_ocean_boundary_type, + !! ocean_ice_boundary_type + + select type(retrieve_component) + type is(atmos_data_type) ; retrieve_component = this%Atm + type is(land_data_type) ; retrieve_component = this%Land + type is(ice_data_type) ; retrieve_component = this%Ice + type is(ocean_public_type) ; retrieve_component = this%Ocean + type is(land_ice_atmos_boundary_type) ; retrieve_component = this%Land_ice_atmos_boundary + type is(atmos_land_boundary_type) ; retrieve_component = this%Atmos_land_boundary + type is(atmos_ice_boundary_type) ; retrieve_component = this%Atmos_ice_boundary + type is(land_ice_boundary_type) ; retrieve_component = this%Land_ice_boundary + type is(ice_ocean_boundary_type) ; retrieve_component = this%Ice_ocean_boundary + type is(ocean_ice_boundary_type) ; retrieve_component = this%Ocean_ice_boundary + class default + call fms_mpp_error(FATAL, "getting component of coupler_chksum_type object, cannot recognize & + & component to be retrieved.") + end select + + end subroutine get_component + subroutine coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_boundary, Atmos_ice_boundary,& Atmos_land_boundary, Ice_ocean_boundary, Ocean_ice_boundary, Ocn_bc_restart, & - Ice_bc_restart, Time, Time_start, Time_end, Time_restart_current) + Ice_bc_restart, Time, Time_start, Time_end, Time_restart_current, coupler_chksum_obj) implicit none @@ -1182,15 +1213,16 @@ subroutine coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_bounda type(FmsNetcdfDomainFile_t), dimension(:), pointer, intent(inout) :: Ocn_bc_restart type(FmsNetcdfDomainFile_t), dimension(:), pointer, intent(inout) :: Ice_bc_restart + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj + type(FmsTime_type), intent(in) :: Time, Time_start, Time_end, Time_restart_current integer :: num_ice_bc_restart, num_ocn_bc_restart if ( do_endpoint_chksum ) then - call coupler_atmos_ice_land_ocean_chksum('coupler_end', 0, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary) + call coupler_atmos_ice_land_ocean_chksum('coupler_end', 0, coupler_chksum_obj) if (Ice%slow_ice_PE) then call fms_mpp_set_current_pelist(Ice%slow_pelist) - call slow_ice_chksum('coupler_end', 0, Ice, Ocean_ice_boundary) + call slow_ice_chksum('coupler_end', 0, coupler_chksum_obj) end if endif call fms_mpp_set_current_pelist() @@ -1351,16 +1383,13 @@ end subroutine coupler_restart !-------------------------------------------------------------------------- !> \brief Print out checksums for several atm, land and ice variables - subroutine coupler_chksum(id, timestep, Atm, Land, Ice) + subroutine coupler_chksum(id, timestep, coupler_chksum_obj) implicit none - type(atmos_data_type), intent(in) :: Atm - type(land_data_type), intent(in) :: Land - type(ice_data_type), intent(in) :: Ice - - character(len=*), intent(in) :: id - integer , intent(in) :: timestep + character(len=*), intent(in) :: id !< id to label CHECKSUMS in stdout + integer , intent(in) :: timestep !< timestep + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< obj pointing to component types type :: tracer_ind_type integer :: atm, ice, lnd ! indices of the tracer in the respective models @@ -1371,10 +1400,8 @@ subroutine coupler_chksum(id, timestep, Atm, Land, Ice) type(tracer_ind_type), allocatable :: tr_table(:) character(32) :: tr_name - call fms_tracer_manager_get_number_tracers (MODEL_ATMOS, num_tracers=n_atm_tr_tot, & - num_prog=n_atm_tr) - call fms_tracer_manager_get_number_tracers (MODEL_LAND, num_tracers=n_lnd_tr_tot, & - num_prog=n_lnd_tr) + call fms_tracer_manager_get_number_tracers (MODEL_ATMOS, num_tracers=n_atm_tr_tot, num_prog=n_atm_tr) + call fms_tracer_manager_get_number_tracers (MODEL_LAND, num_tracers=n_lnd_tr_tot, num_prog=n_lnd_tr) ! Assemble the table of tracer number translation by matching names of ! prognostic tracers in the atmosphere and surface models; skip all atmos. @@ -1393,47 +1420,47 @@ subroutine coupler_chksum(id, timestep, Atm, Land, Ice) 100 FORMAT("CHECKSUM::",A32," = ",Z20) 101 FORMAT("CHECKSUM::",A16,a,'%',a," = ",Z20) - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) + if (coupler_chksum_obj%Atm%pe) then + call fms_mpp_set_current_pelist(coupler_chksum_obj%Atm%pelist) outunit = fms_mpp_stdout() write(outunit,*) 'BEGIN CHECKSUM(Atm):: ', id, timestep - write(outunit,100) 'atm%t_bot', fms_mpp_chksum(atm%t_bot) - write(outunit,100) 'atm%z_bot', fms_mpp_chksum(atm%z_bot) - write(outunit,100) 'atm%p_bot', fms_mpp_chksum(atm%p_bot) - write(outunit,100) 'atm%u_bot', fms_mpp_chksum(atm%u_bot) - write(outunit,100) 'atm%v_bot', fms_mpp_chksum(atm%v_bot) - write(outunit,100) 'atm%p_surf', fms_mpp_chksum(atm%p_surf) - write(outunit,100) 'atm%gust', fms_mpp_chksum(atm%gust) + write(outunit,100) 'atm%t_bot', fms_mpp_chksum(coupler_chksum_obj%Atm%t_bot) + write(outunit,100) 'atm%z_bot', fms_mpp_chksum(coupler_chksum_obj%Atm%z_bot) + write(outunit,100) 'atm%p_bot', fms_mpp_chksum(coupler_chksum_obj%Atm%p_bot) + write(outunit,100) 'atm%u_bot', fms_mpp_chksum(coupler_chksum_obj%Atm%u_bot) + write(outunit,100) 'atm%v_bot', fms_mpp_chksum(coupler_chksum_obj%Atm%v_bot) + write(outunit,100) 'atm%p_surf', fms_mpp_chksum(coupler_chksum_obj%Atm%p_surf) + write(outunit,100) 'atm%gust', fms_mpp_chksum(coupler_chksum_obj%Atm%gust) do tr = 1,n_exch_tr n = tr_table(tr)%atm if (n /= NO_TRACER) then call fms_tracer_manager_get_tracer_names( MODEL_ATMOS, tr_table(tr)%atm, tr_name ) - write(outunit,100) 'atm%'//trim(tr_name), fms_mpp_chksum(Atm%tr_bot(:,:,n)) + write(outunit,100) 'atm%'//trim(tr_name), fms_mpp_chksum(coupler_chksum_obj%Atm%tr_bot(:,:,n)) endif enddo - write(outunit,100) 'land%t_surf', fms_mpp_chksum(land%t_surf) - write(outunit,100) 'land%t_ca', fms_mpp_chksum(land%t_ca) - write(outunit,100) 'land%rough_mom', fms_mpp_chksum(land%rough_mom) - write(outunit,100) 'land%rough_heat', fms_mpp_chksum(land%rough_heat) - write(outunit,100) 'land%rough_scale', fms_mpp_chksum(land%rough_scale) + write(outunit,100) 'land%t_surf', fms_mpp_chksum(coupler_chksum_obj%Land%t_surf) + write(outunit,100) 'land%t_ca', fms_mpp_chksum(coupler_chksum_obj%Land%t_ca) + write(outunit,100) 'land%rough_mom', fms_mpp_chksum(coupler_chksum_obj%Land%rough_mom) + write(outunit,100) 'land%rough_heat', fms_mpp_chksum(coupler_chksum_obj%Land%rough_heat) + write(outunit,100) 'land%rough_scale', fms_mpp_chksum(coupler_chksum_obj%Land%rough_scale) do tr = 1,n_exch_tr n = tr_table(tr)%lnd if (n /= NO_TRACER) then call fms_tracer_manager_get_tracer_names( MODEL_ATMOS, tr_table(tr)%atm, tr_name ) #ifndef _USE_LEGACY_LAND_ - write(outunit,100) 'land%'//trim(tr_name), fms_mpp_chksum(Land%tr(:,:,n)) + write(outunit,100) 'land%'//trim(tr_name), fms_mpp_chksum(coupler_chksum_obj%Land%tr(:,:,n)) #else - write(outunit,100) 'land%'//trim(tr_name), fms_mpp_chksum(Land%tr(:,:,:,n)) + write(outunit,100) 'land%'//trim(tr_name), fms_mpp_chksum(coupler_chksum_obj%Land%tr(:,:,:,n)) #endif endif enddo - write(outunit,100) 'ice%t_surf', fms_mpp_chksum(ice%t_surf) - write(outunit,100) 'ice%rough_mom', fms_mpp_chksum(ice%rough_mom) - write(outunit,100) 'ice%rough_heat', fms_mpp_chksum(ice%rough_heat) - write(outunit,100) 'ice%rough_moist', fms_mpp_chksum(ice%rough_moist) + write(outunit,100) 'ice%t_surf', fms_mpp_chksum(coupler_chksum_obj%Ice%t_surf) + write(outunit,100) 'ice%rough_mom', fms_mpp_chksum(coupler_chksum_obj%Ice%rough_mom) + write(outunit,100) 'ice%rough_heat', fms_mpp_chksum(coupler_chksum_obj%Ice%rough_heat) + write(outunit,100) 'ice%rough_moist', fms_mpp_chksum(coupler_chksum_obj%Ice%rough_moist) write(outunit,*) 'STOP CHECKSUM(Atm):: ', id, timestep !endif @@ -1442,7 +1469,7 @@ subroutine coupler_chksum(id, timestep, Atm, Land, Ice) !call mpp_set_current_pelist(Ocean%pelist) write(outunit,*) 'BEGIN CHECKSUM(Ice):: ', id, timestep - call fms_coupler_type_write_chksums(Ice%ocean_fields, outunit, 'ice%') + call fms_coupler_type_write_chksums(coupler_chksum_obj%Ice%ocean_fields, outunit, 'ice%') write(outunit,*) 'STOP CHECKSUM(Ice):: ', id, timestep endif @@ -1457,7 +1484,6 @@ end subroutine coupler_chksum !> \brief This subroutine calls subroutine that will print out checksums of the elements !! of the appropriate type. -!! !! For coupled models typically these types are not defined on all processors. !! It is assumed that the appropriate pelist has been set before entering this routine. !! This can be achieved in the following way. @@ -1473,40 +1499,32 @@ end subroutine coupler_chksum !! call mpp_set_current_pelist() !! ~~~~~~~~~~ !! after you exit. This is only necessary if you need to return to the global pelist. - subroutine atmos_ice_land_chksum(id, timestep, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, & - Atmos_land_boundary) - - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - type (atmos_data_type), intent(in) :: Atm - type (land_data_type), intent(in) :: Land - type (ice_data_type), intent(in) :: Ice - type(land_ice_atmos_boundary_type), intent(in) :: Land_ice_atmos_boundary - type(atmos_ice_boundary_type), intent(in) :: Atmos_ice_boundary - type(atmos_land_boundary_type), intent(in) :: Atmos_land_boundary - - call atmos_data_type_chksum( id, timestep, Atm) - call lnd_ice_atm_bnd_type_chksum(id, timestep, Land_ice_atmos_boundary) - - if (Ice%fast_ice_pe) then - call fms_mpp_set_current_pelist(Ice%fast_pelist) - call ice_data_type_chksum( id, timestep, Ice) - call atm_ice_bnd_type_chksum(id, timestep, Atmos_ice_boundary) + subroutine atmos_ice_land_chksum(id, timestep, coupler_chksum_obj) + + character(len=*), intent(in) :: id !< id to label CHECKSUMS in stdout + integer , intent(in) :: timestep !< timestep + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< object pointing to component types + + call atmos_data_type_chksum( id, timestep, coupler_chksum_obj%Atm) + call lnd_ice_atm_bnd_type_chksum(id, timestep, coupler_chksum_obj%Land_ice_atmos_boundary) + + if (coupler_chksum_obj%Ice%fast_ice_pe) then + call fms_mpp_set_current_pelist(coupler_chksum_obj%Ice%fast_pelist) + call ice_data_type_chksum( id, timestep, coupler_chksum_obj%Ice) + call atm_ice_bnd_type_chksum(id, timestep, coupler_chksum_obj%Atmos_ice_boundary) endif - if (Land%pe) then - call fms_mpp_set_current_pelist(Land%pelist) - call land_data_type_chksum( id, timestep, Land) - call atm_lnd_bnd_type_chksum(id, timestep, Atmos_land_boundary) + if (coupler_chksum_obj%Land%pe) then + call fms_mpp_set_current_pelist(coupler_chksum_obj%Land%pelist) + call land_data_type_chksum( id, timestep, coupler_chksum_obj%Land) + call atm_lnd_bnd_type_chksum(id, timestep, coupler_chksum_obj%Atmos_land_boundary) endif - call fms_mpp_set_current_pelist(Atm%pelist) + call fms_mpp_set_current_pelist(coupler_chksum_obj%Atm%pelist) end subroutine atmos_ice_land_chksum !> \brief This subroutine calls subroutine that will print out checksums of the elements !! of the appropriate type. -!! !! For coupled models typically these types are not defined on all processors. !! It is assumed that the appropriate pelist has been set before entering this routine. !! This can be achieved in the following way. @@ -1522,22 +1540,20 @@ end subroutine atmos_ice_land_chksum !! call mpp_set_current_pelist() !! ~~~~~~~~~~ !! after you exit. This is only necessary if you need to return to the global pelist. - subroutine slow_ice_chksum(id, timestep, Ice, Ocean_ice_boundary) + subroutine slow_ice_chksum(id, timestep, coupler_chksum_obj) - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - type(ice_data_type), intent(in) :: Ice - type(ocean_ice_boundary_type), intent(in) :: Ocean_ice_boundary + character(len=*), intent(in) :: id ! \brief This subroutine calls subroutine that will print out checksums of the elements !! of the appropriate type. -!! !! For coupled models typically these types are not defined on all processors. !! It is assumed that the appropriate pelist has been set before entering this routine. !! This can be achieved in the following way. @@ -1553,15 +1569,14 @@ end subroutine slow_ice_chksum !! call mpp_set_current_pelist() !! ~~~~~~~~~~ !! after you exit. This is only necessary if you need to return to the global pelist. - subroutine ocean_chksum(id, timestep, Ocean, Ice_ocean_boundary) + subroutine ocean_chksum(id, timestep, coupler_chksum_obj) character(len=*), intent(in) :: id !< ID labelling the set of CHECKSUMS integer , intent(in) :: timestep !< Timestep - type (ocean_public_type), intent(in) :: Ocean !< Ocean - type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary ! \brief This subroutine calls coupler_chksum as well as atmos_ice_land_chksum and ocean_chksum - subroutine coupler_atmos_ice_land_ocean_chksum(id, timestep, Atm, Land, Ice, Land_ice_atmos_boundary,& - Atmos_ice_boundary, Atmos_land_boundary, Ocean, Ice_ocean_boundary, Ocean_ice_boundary) + subroutine coupler_atmos_ice_land_ocean_chksum(id, timestep, coupler_chksum_obj) implicit none character(len=*), intent(in) :: id !< ID labelling the set of checksums integer , intent(in) :: timestep !< timestep - type(atmos_data_type), intent(in) :: Atm !< Atm - type(land_data_type), intent(in) :: Land !< Land - type(ice_data_type), intent(in) :: Ice !< Ice - type(land_ice_atmos_boundary_type), intent(in) :: Land_ice_atmos_boundary !< Land_ice_atmos_boundary - type(atmos_ice_boundary_type), intent(in) :: Atmos_ice_boundary !< Atmos_ice_boundary - type(atmos_land_boundary_type), intent(in) :: Atmos_land_boundary !< Atmos_land_boundary - type(ocean_public_type), intent(in) :: Ocean !< Ocean - type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary !< Ice_ocean_boundary - type(ocean_ice_boundary_type), intent(in), optional :: Ocean_ice_boundary !< Ocean_ice_boundary - - if (Atm%pe) then - call fms_mpp_set_current_pelist(Atm%pelist) - call atmos_ice_land_chksum(trim(id), timestep, Atm, Land, Ice, & - Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj + + if (coupler_chksum_obj%Atm%pe) then + call fms_mpp_set_current_pelist(coupler_chksum_obj%Atm%pelist) + call atmos_ice_land_chksum(trim(id), timestep, coupler_chksum_obj) endif - if (Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(Ocean%pelist) - call ocean_chksum(trim(id), timestep, Ocean, Ice_ocean_boundary) + if (coupler_chksum_obj%Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(coupler_chksum_obj%Ocean%pelist) + call ocean_chksum(trim(id), timestep, coupler_chksum_obj) endif call fms_mpp_set_current_pelist() @@ -1791,15 +1796,15 @@ end subroutine coupler_flux_ocean_to_ice !> \brief This subroutine calls flux_ocean_to_ice !! Clocks are set before and after call flux_ice_to_ocean. Current pelist is set when optional !! arguments are present and set_current_slow_ice_ocean_pelist=.True. - subroutine coupler_flux_ice_to_ocean(Ice, Ocean, Ice_ocean_boundary, coupler_clocks,& + subroutine coupler_flux_ice_to_ocean(Ice, Ocean, Ice_ocean_boundary, coupler_clocks, & slow_ice_ocean_pelist, set_current_slow_ice_ocean_pelist) implicit none type(ice_data_type), intent(inout) :: Ice !< Ice type(ocean_public_type), intent(inout) :: Ocean !< Ocean - type(ice_ocean_boundary_type), intent(inout) :: Ice_ocean_boundary !< Ice_ocean_boundary - type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + type(ice_ocean_boundary_type), intent(inout) :: Ice_ocean_boundary !< Ice_ocean_boundary + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks integer, dimension(:), optional, intent(in) :: slow_ice_ocean_pelist !< slow_ice_ocean_pelist !> if true, will call mpp_set_current_pelist(slow_ice_ocean_pelist) logical, optional, intent(in) :: set_current_slow_ice_ocean_pelist @@ -1829,7 +1834,8 @@ end subroutine coupler_flux_ice_to_ocean !> \brief This subroutine calls flux_ocean_to_ice_finish and unpack_ocean_ice_boundary. !! Clocks and pelists are set before/after the calls. Checksum is computed if do_chksum=.True. - subroutine coupler_unpack_ocean_ice_boundary(nc, Time_flux_ocean_to_ice, Ice, Ocean_ice_boundary, coupler_clocks) + subroutine coupler_unpack_ocean_ice_boundary(nc, Time_flux_ocean_to_ice, Ice, Ocean_ice_boundary, coupler_clocks, & + coupler_chksum_obj) implicit none @@ -1838,6 +1844,7 @@ subroutine coupler_unpack_ocean_ice_boundary(nc, Time_flux_ocean_to_ice, Ice, Oc type(ice_data_type), intent(inout) :: Ice !< Ice type(ocean_ice_boundary_type), intent(inout) :: Ocean_ice_boundary !< Ocean_ice_boundary type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj call fms_mpp_set_current_pelist(Ice%slow_pelist) call fms_mpp_clock_begin(coupler_clocks%set_ice_surface_slow) @@ -1845,7 +1852,7 @@ subroutine coupler_unpack_ocean_ice_boundary(nc, Time_flux_ocean_to_ice, Ice, Oc ! This may do data override or diagnostics on Ice_ocean_boundary. call flux_ocean_to_ice_finish( Time_flux_ocean_to_ice, Ice, Ocean_Ice_Boundary ) call unpack_ocean_ice_boundary( Ocean_ice_boundary, Ice ) - if (do_chksum) call slow_ice_chksum('update_ice_slow+', nc, Ice, Ocean_ice_boundary) + if (do_chksum) call slow_ice_chksum('update_ice_slow+', nc, coupler_chksum_obj) call fms_mpp_clock_end(coupler_clocks%set_ice_surface_slow) @@ -1871,7 +1878,7 @@ end subroutine coupler_exchange_slow_to_fast_ice !> \brief This subroutine calls exchange_fast_to_slow_ice. Clocks are set before and after the call. !! The current pelist is set if the optional argument set_ice_current_pelist is set to true. subroutine coupler_exchange_fast_to_slow_ice(Ice, coupler_clocks, set_ice_current_pelist) - + implicit none type(ice_data_type), intent(inout) :: Ice !< Ice type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks @@ -1949,9 +1956,7 @@ subroutine coupler_sfc_boundary_layer(Atm, Land, Ice, Land_ice_atmos_boundary, & call fms_mpp_clock_begin(coupler_clocks%sfc_boundary_layer) call sfc_boundary_layer( real(dt_atmos), Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary ) - if(do_chksum) call atmos_ice_land_chksum('sfc+', current_time_step, Atm, Land, Ice, & - Land_ice_atmos_boundary, coupler_chksum_obj%Atmos_ice_boundary, & - coupler_chksum_obj%Atmos_land_boundary) + if(do_chksum) call atmos_ice_land_chksum('sfc+', current_time_step, coupler_chksum_obj) call fms_mpp_clock_end(coupler_clocks%sfc_boundary_layer) From 115049b2ce8e1daa0eb834c9bc10fc58e8d9b9fe Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 14 Jun 2024 07:33:58 -0400 Subject: [PATCH 12/24] comments --- full/full_coupler_mod.F90 | 51 +++++++++++++++++++++------------------ 1 file changed, 28 insertions(+), 23 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index ddf9c564..094e9c87 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -277,21 +277,24 @@ module full_coupler_mod integer :: flux_exchange_init end type coupler_clock_type + !> The purpose of objects of coupler_chksum_type is to simplify the list + !! of arguments required for chksum related subroutines in full_coupler_mod. + !! The members of this type point to the model components type coupler_chksum_type private - type(atmos_data_type), pointer :: Atm - type(land_data_type), pointer :: Land - type(ice_data_type), pointer :: Ice - type(ocean_public_type), pointer :: Ocean - type(land_ice_atmos_boundary_type), pointer :: Land_ice_atmos_boundary - type(atmos_land_boundary_type), pointer :: Atmos_land_boundary - type(atmos_ice_boundary_type), pointer :: Atmos_ice_boundary - type(land_ice_boundary_type), pointer :: Land_ice_boundary - type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary - type(ocean_ice_boundary_type), pointer :: Ocean_ice_boundary + type(atmos_data_type), pointer :: Atm !< pointer to Atm + type(land_data_type), pointer :: Land !< pointer to Land + type(ice_data_type), pointer :: Ice !< pointer to Ice + type(ocean_public_type), pointer :: Ocean !< pointer to Ocean + type(land_ice_atmos_boundary_type), pointer :: Land_ice_atmos_boundary !< pointer to Land_ice_atmos_boundary + type(atmos_land_boundary_type), pointer :: Atmos_land_boundary !< pointer to Atmos_land_boundary + type(atmos_ice_boundary_type), pointer :: Atmos_ice_boundary !< pointer to Atmos_ice_boundary + type(land_ice_boundary_type), pointer :: Land_ice_boundary !< pointer to Land_ice_boundary + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary !< pointer to Ice_ocean_boundary + type(ocean_ice_boundary_type), pointer :: Ocean_ice_boundary !< pointer to Ocean_ice_boundary contains - procedure, public :: coupler_chksum_obj_init - procedure, public :: get_component + procedure, public :: coupler_chksum_obj_init !< associates the pointers above to model components + procedure, public :: get_component !< subroutine to retrieve the requested component of an object of this type end type coupler_chksum_type character(len=80) :: text @@ -1134,21 +1137,23 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, end subroutine coupler_init !####################################################################### + + !> This subroutine associates the pointer in an object of coupler_chksum_type to the component models subroutine coupler_chksum_obj_init(this, Atm, Land, Ice, Ocean, Land_ice_atmos_boundary, Atmos_land_boundary, & Atmos_ice_boundary, Land_ice_boundary, Ice_ocean_boundary, Ocean_ice_boundary) implicit none - class(coupler_chksum_type), intent(inout) :: this - type(atmos_data_type), target, intent(in) :: Atm - type(land_data_type), target, intent(in) :: Land - type(ice_data_type), target, intent(in) :: Ice - type(ocean_public_type), target, intent(in) :: Ocean - type(land_ice_atmos_boundary_type), target, intent(in) :: Land_ice_atmos_boundary - type(atmos_land_boundary_type), target, intent(in) :: Atmos_land_boundary - type(atmos_ice_boundary_type), target, intent(in) :: Atmos_ice_boundary - type(land_ice_boundary_type), target, intent(in) :: Land_ice_boundary - type(ice_ocean_boundary_type), target, intent(in) :: Ice_ocean_boundary - type(ocean_ice_boundary_type), target, intent(in) :: Ocean_ice_boundary + class(coupler_chksum_type), intent(inout) :: this !< self + type(atmos_data_type), target, intent(in) :: Atm !< Atm + type(land_data_type), target, intent(in) :: Land !< Land + type(ice_data_type), target, intent(in) :: Ice !< Ice + type(ocean_public_type), target, intent(in) :: Ocean !< Ocean + type(land_ice_atmos_boundary_type), target, intent(in) :: Land_ice_atmos_boundary !< Land_ice_atmos_boundary + type(atmos_land_boundary_type), target, intent(in) :: Atmos_land_boundary !< Atmos_land_boundary + type(atmos_ice_boundary_type), target, intent(in) :: Atmos_ice_boundary !< Atmos_ice_boundary + type(land_ice_boundary_type), target, intent(in) :: Land_ice_boundary !< Land_ice_boundary + type(ice_ocean_boundary_type), target, intent(in) :: Ice_ocean_boundary !< Ice_ocean_boundary + type(ocean_ice_boundary_type), target, intent(in) :: Ocean_ice_boundary !< Ocean_ice_boundary this%Atm => Atm this%Land => Land From 4fa6c2dd902d600fffadeadf60a0e610a3750b20 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 14 Jun 2024 09:26:08 -0400 Subject: [PATCH 13/24] add components_obj --- full/coupler_main.F90 | 65 ++++---- full/full_coupler_mod.F90 | 304 ++++++++++++++++++++++++-------------- 2 files changed, 223 insertions(+), 146 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index ea51eddb..e2ad15f3 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -340,7 +340,7 @@ program coupler_main implicit none !> model defined types. - !! Targets to pointers in coupler_chksum_obj + !! Targets to pointers in coupler_components_obj type (atmos_data_type), target :: Atm type (land_data_type), target :: Land type (ice_data_type), target :: Ice @@ -372,8 +372,9 @@ program coupler_main type(FmsTime_type) :: Time_restart_current character(len=32) :: timestamp - type(coupler_clock_type) :: coupler_clocks - type(coupler_chksum_type) :: coupler_chksum_obj + type(coupler_clock_type) :: coupler_clocks + type(coupler_components_type) :: coupler_components_obj + type(coupler_chksum_type) :: coupler_chksum_obj integer :: outunit character(len=80) :: text @@ -429,10 +430,11 @@ program coupler_main call coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, Atmos_ice_boundary, & Ocean_ice_boundary, Ice_ocean_boundary, Land_ice_atmos_boundary, Land_ice_boundary, & Ice_ocean_driver_CS, Ice_bc_restart, Ocn_bc_restart, ensemble_pelist, slow_ice_ocean_pelist, & - conc_nthreads, coupler_clocks, coupler_chksum_obj, Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, & - num_cpld_calls, num_atmos_calls, Time, Time_start, Time_end, Time_restart, Time_restart_current) + conc_nthreads, coupler_clocks, coupler_components_obj, coupler_chksum_obj, & + Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, num_cpld_calls, & + num_atmos_calls, Time, Time_start, Time_end, Time_restart, Time_restart_current) - if (do_chksum) call coupler_chksum('coupler_init+', 0, coupler_chksum_obj) + if (do_chksum) call coupler_chksum_obj%coupler_chksum('coupler_init+', 0) call fms_mpp_set_current_pelist() call fms_mpp_clock_end(coupler_clocks%initialization) !end initialization @@ -448,8 +450,8 @@ program coupler_main do nc = 1, num_cpld_calls if (do_chksum) then - call coupler_chksum('top_of_coupled_loop+', nc, coupler_chksum_obj) - call coupler_atmos_ice_land_ocean_chksum('MAIN_LOOP-', nc, coupler_chksum_obj) + call coupler_chksum_obj%coupler_chksum('top_of_coupled_loop+', nc) + call coupler_chksum_obj%coupler_atmos_ice_land_ocean_chksum('MAIN_LOOP-', nc) end if ! Calls to flux_ocean_to_ice and flux_ice_to_ocean are all PE communication @@ -470,8 +472,8 @@ program coupler_main end if if (do_chksum) then - call coupler_chksum('flux_ocn2ice+', nc, coupler_chksum_obj) - call coupler_atmos_ice_land_ocean_chksum('flux_ocn2ice+', nc, coupler_chksum_obj) + call coupler_chksum_obj%coupler_chksum('flux_ocn2ice+', nc) + call coupler_chksum_obj%coupler_atmos_ice_land_ocean_chksum('flux_ocn2ice+', nc) end if ! needs to sit here rather than at the end of the coupler loop. @@ -497,7 +499,7 @@ program coupler_main if (.NOT.(do_ice.and.Ice%pe) .OR. (ice_npes.NE.atmos_npes)) call fms_mpp_set_current_pelist(Atm%pelist) - if(do_chksum) call atmos_ice_land_chksum('set_ice_surface+', nc, coupler_chksum_obj) + if(do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('set_ice_surface+', nc) call fms_mpp_clock_begin(coupler_clocks%atm) @@ -513,7 +515,7 @@ program coupler_main Time_atmos = Time_atmos + Time_step_atmos current_timestep = (nc-1)*num_atmos_calls+na - if (do_chksum) call atmos_ice_land_chksum('top_of_atmos_loop-', current_timestep, coupler_chksum_obj) + if (do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('top_of_atmos_loop-', current_timestep) if (do_atmos) call coupler_atmos_tracer_driver_gather_data(Atm, coupler_clocks) @@ -551,8 +553,7 @@ program coupler_main call update_atmos_model_dynamics(Atm) call fms_mpp_clock_end(coupler_clocks%update_atmos_model_dynamics) endif - if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_dynamics', (nc-1)*num_atmos_calls+na, & - coupler_chksum_obj) + if (do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('update_atmos_model_dynamics', current_timestep) if (do_debug) call fms_memutils_print_memuse_stats( 'update dyn') ! ---- SERIAL atmosphere radiation ---- @@ -561,8 +562,8 @@ program coupler_main call update_atmos_model_radiation( Land_ice_atmos_boundary, Atm ) call fms_mpp_clock_end(coupler_clocks%serial_radiation) endif - if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_radiation(ser)', (nc-1)*num_atmos_calls+na, & - coupler_chksum_obj) + if (do_chksum) & + call coupler_chksum_obj%atmos_ice_land_chksum('update_atmos_model_radiation(ser)', current_timestep) if (do_debug) call fms_memutils_print_memuse_stats( 'update serial rad') ! ---- atmosphere down ---- @@ -571,8 +572,7 @@ program coupler_main call update_atmos_model_down( Land_ice_atmos_boundary, Atm ) call fms_mpp_clock_end(coupler_clocks%update_atmos_model_down) endif - if (do_chksum) call atmos_ice_land_chksum('update_atmos_down+', (nc-1)*num_atmos_calls+na, & - coupler_chksum_obj) + if (do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('update_atmos_down+', current_timestep) if (do_debug) call fms_memutils_print_memuse_stats( 'update down') call fms_mpp_clock_begin(coupler_clocks%flux_down_from_atmos) @@ -581,8 +581,7 @@ program coupler_main Atmos_land_boundary, & Atmos_ice_boundary ) call fms_mpp_clock_end(coupler_clocks%flux_down_from_atmos) - if (do_chksum) call atmos_ice_land_chksum('flux_down_from_atmos+', (nc-1)*num_atmos_calls+na,& - coupler_chksum_obj) + if (do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('flux_down_from_atmos+', current_timestep) ! -------------------------------------------------------------- ! ---- land model ---- @@ -593,8 +592,7 @@ program coupler_main endif if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Atm%pelist) call fms_mpp_clock_end(coupler_clocks%update_land_model_fast) - if (do_chksum) call atmos_ice_land_chksum('update_land_fast+', (nc-1)*num_atmos_calls+na, & - coupler_chksum_obj) + if (do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('update_land_fast+', current_timestep) if (do_debug) call fms_memutils_print_memuse_stats( 'update land') ! ---- ice model ---- @@ -605,8 +603,7 @@ program coupler_main endif if (ice_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Atm%pelist) call fms_mpp_clock_end(coupler_clocks%update_ice_model_fast) - if (do_chksum) call atmos_ice_land_chksum('update_ice_fast+', (nc-1)*num_atmos_calls+na,& - coupler_chksum_obj) + if (do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('update_ice_fast+', current_timestep) if (do_debug) call fms_memutils_print_memuse_stats( 'update ice') ! -------------------------------------------------------------- @@ -615,14 +612,13 @@ program coupler_main call flux_up_to_atmos( Time_atmos, Land, Ice, Land_ice_atmos_boundary, & Atmos_land_boundary, Atmos_ice_boundary ) call fms_mpp_clock_end(coupler_clocks%flux_up_to_atmos) - if (do_chksum) call atmos_ice_land_chksum('flux_up2atmos+', (nc-1)*num_atmos_calls+na,coupler_chksum_obj) + if (do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('flux_up2atmos+', current_timestep) call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_up) if (do_atmos) & call update_atmos_model_up( Land_ice_atmos_boundary, Atm) call fms_mpp_clock_end(coupler_clocks%update_atmos_model_up) - if (do_chksum) call atmos_ice_land_chksum('update_atmos_up+', (nc-1)*num_atmos_calls+na, & - coupler_chksum_obj) + if (do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('update_atmos_up+', current_timestep) if (do_debug) call fms_memutils_print_memuse_stats( 'update up') call flux_atmos_to_ocean(Time_atmos, Atm, Atmos_ice_boundary, Ice) @@ -667,8 +663,7 @@ program coupler_main call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_state) call update_atmos_model_state( Atm ) - if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_state+', (nc-1)*num_atmos_calls+na,& - coupler_chksum_obj) + if (do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('update_atmos_model_state+', current_timestep) if (do_debug) call fms_memutils_print_memuse_stats( 'update state') call fms_mpp_clock_end(coupler_clocks%update_atmos_model_state) @@ -685,15 +680,15 @@ program coupler_main if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Atm%pelist) !----------------------------------------------------------------------- call fms_mpp_clock_end(coupler_clocks%update_land_model_slow) - if (do_chksum) call atmos_ice_land_chksum('update_land_slow+', nc, coupler_chksum_obj) - + if (do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('update_land_slow+', nc) + ! ! need flux call to put runoff and p_surf on ice grid ! call fms_mpp_clock_begin(coupler_clocks%flux_land_to_ice) call flux_land_to_ice( Time, Land, Ice, Land_ice_boundary ) call fms_mpp_clock_end(coupler_clocks%flux_land_to_ice) - if (do_chksum) call atmos_ice_land_chksum('fluxlnd2ice+', nc, coupler_chksum_obj) + if (do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('fluxlnd2ice+', nc) Atmos_ice_boundary%p = 0.0 ! call flux_atmos_to_ice_slow ? Time = Time_atmos @@ -734,7 +729,7 @@ program coupler_main call fms_mpp_clock_end(coupler_clocks%update_ice_model_slow_slow) endif - if (do_chksum) call slow_ice_chksum('update_ice_slow+', nc, coupler_chksum_obj) + if (do_chksum) call coupler_chksum_obj%slow_ice_chksum('update_ice_slow+', nc) endif ! End of Ice%pe block if(Atm%pe) then @@ -771,7 +766,7 @@ program coupler_main Time_ocean, Time_step_cpld ) endif - if (do_chksum) call ocean_chksum('update_ocean_model+', nc, coupler_chksum_obj) + if (do_chksum) call coupler_chksum_obj%ocean_chksum('update_ocean_model+', nc) ! Get stocks from "Ice_ocean_boundary" and add them to Ocean stocks. ! This call is just for record keeping of stocks transfer and ! does not modify either Ocean or Ice_ocean_boundary @@ -828,7 +823,7 @@ program coupler_main call fms_mpp_clock_end(coupler_clocks%main) call fms_mpp_clock_begin(coupler_clocks%termination) - if (do_chksum) call coupler_chksum('coupler_end-', nc, coupler_chksum_obj) + if (do_chksum) call coupler_chksum_obj%coupler_chksum('coupler_end-', nc) call coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_boundary, Atmos_ice_boundary,& Atmos_land_boundary, Ice_ocean_boundary, Ocean_ice_boundary, Ocn_bc_restart, Ice_bc_restart, & Time, Time_start, Time_end, Time_restart_current, coupler_chksum_obj) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 094e9c87..0b6b7c08 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -277,10 +277,7 @@ module full_coupler_mod integer :: flux_exchange_init end type coupler_clock_type - !> The purpose of objects of coupler_chksum_type is to simplify the list - !! of arguments required for chksum related subroutines in full_coupler_mod. - !! The members of this type point to the model components - type coupler_chksum_type + type coupler_components_type private type(atmos_data_type), pointer :: Atm !< pointer to Atm type(land_data_type), pointer :: Land !< pointer to Land @@ -293,8 +290,24 @@ module full_coupler_mod type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary !< pointer to Ice_ocean_boundary type(ocean_ice_boundary_type), pointer :: Ocean_ice_boundary !< pointer to Ocean_ice_boundary contains - procedure, public :: coupler_chksum_obj_init !< associates the pointers above to model components + procedure, public :: coupler_components_obj_init procedure, public :: get_component !< subroutine to retrieve the requested component of an object of this type + end type coupler_components_type + + !> The purpose of objects of coupler_chksum_type is to simplify the list + !! of arguments required for chksum related subroutines in full_coupler_mod. + !! The members of this type point to the model components + type coupler_chksum_type + private + type(coupler_components_type), pointer :: components + contains + procedure, public :: coupler_chksum_obj_init !< associates the pointers above to model components + procedure, public :: get_components_obj !< subroutine to retrieve the requested component of an object of this type + procedure, public :: coupler_atmos_ice_land_ocean_chksum !< subroutine to compute chksums for atmos - ocean + procedure, public :: atmos_ice_land_chksum !< subroutine to compute chksums for atmos_ice_land + procedure, public :: slow_ice_chksum !< subroutine to compute chskums for slow_ice + procedure, public :: ocean_chksum !< subroutine to compute chksums for ocean + procedure, public :: coupler_chksum !< subroutine to compute chksums for select fields end type coupler_chksum_type character(len=80) :: text @@ -313,7 +326,7 @@ module full_coupler_mod subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, Atmos_ice_boundary, & Ocean_ice_boundary, Ice_ocean_boundary, Land_ice_atmos_boundary, Land_ice_boundary, & Ice_ocean_driver_CS, Ice_bc_restart, Ocn_bc_restart, ensemble_pelist, slow_ice_ocean_pelist, conc_nthreads, & - coupler_clocks, coupler_chksum_obj, Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, & + coupler_clocks, coupler_components_obj, coupler_chksum_obj, Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, & num_cpld_calls, num_atmos_calls, Time, Time_start, Time_end, Time_restart, Time_restart_current) implicit none @@ -336,8 +349,9 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, integer, allocatable, dimension(:,:), intent(inout) :: ensemble_pelist integer, allocatable, dimension(:), intent(inout) :: slow_ice_ocean_pelist - type(coupler_clock_type), intent(inout) :: coupler_clocks - type(coupler_chksum_type), intent(inout) :: coupler_chksum_obj + type(coupler_clock_type), intent(inout) :: coupler_clocks + type(coupler_components_type), intent(inout) :: coupler_components_obj + type(coupler_chksum_type), intent(inout) :: coupler_chksum_obj type(FMSTime_type), intent(inout) :: Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean type(FMSTime_type), intent(inout) :: Time, Time_start, Time_end, Time_restart, Time_restart_current @@ -1113,16 +1127,18 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, !----------------------------------------------------------------------- + !> Initialize coupler_components_obj memebers to point to model components + call coupler_components_obj%coupler_components_obj_init(Atm, Land, Ice, Ocean, Land_ice_atmos_boundary, & + Atmos_land_boundary, Atmos_ice_boundary, Land_ice_boundary, Ice_ocean_boundary, Ocean_ice_boundary) + !> Initialize coupler_chksum_obj - call coupler_chksum_obj%coupler_chksum_obj_init(Atm, Land, Ice, Ocean, Land_ice_atmos_boundary, & - Atmos_land_boundary,Atmos_ice_boundary, Land_ice_boundary, & - Ice_ocean_boundary, Ocean_ice_boundary) + call coupler_chksum_obj%coupler_chksum_obj_init(coupler_components_obj) if ( do_endpoint_chksum ) then - call coupler_atmos_ice_land_ocean_chksum('coupler_init+', 0, coupler_chksum_obj) + call coupler_chksum_obj%coupler_atmos_ice_land_ocean_chksum('coupler_init+', 0) if (Ice%slow_ice_PE) then call fms_mpp_set_current_pelist(Ice%slow_pelist) - call slow_ice_chksum('coupler_init+', 0, coupler_chksum_obj) + call coupler_chksum_obj%slow_ice_chksum('coupler_init+', 0) end if end if @@ -1138,9 +1154,9 @@ end subroutine coupler_init !####################################################################### - !> This subroutine associates the pointer in an object of coupler_chksum_type to the component models - subroutine coupler_chksum_obj_init(this, Atm, Land, Ice, Ocean, Land_ice_atmos_boundary, Atmos_land_boundary, & - Atmos_ice_boundary, Land_ice_boundary, Ice_ocean_boundary, Ocean_ice_boundary) + !> This subroutine associates the pointer in an object of coupler_components_type to the model components + subroutine coupler_components_obj_init(this, Atm, Land, Ice, Ocean, Land_ice_atmos_boundary, Atmos_land_boundary, & + Atmos_ice_boundary, Land_ice_boundary, Ice_ocean_boundary, Ocean_ice_boundary) implicit none class(coupler_chksum_type), intent(inout) :: this !< self @@ -1166,20 +1182,20 @@ subroutine coupler_chksum_obj_init(this, Atm, Land, Ice, Ocean, Land_ice_atmos_b this%Ice_ocean_boundary => Ice_ocean_boundary this%Ocean_ice_boundary => Ocean_ice_boundary - end subroutine coupler_chksum_obj_init + end subroutine coupler_components_obj_init - !> Function get_component returns the requested component in the coupler_chksum_type object + !> Function get_component returns the requested component in the coupler_components_type object !! Users are required to provide the component to be retrieved as an input argument. For example, - !! coupler_chksum_obj%get_component(Atm) will modify Atm to be Atm = coupler_chksum_obj%Atm + !! coupler_components_obj%get_component(Atm) will return Atm = coupler_components_obj%Atm subroutine get_component(this, retrieve_component ) implicit none - class(coupler_chksum_type), intent(in) :: this !< the coupler_chksum_type object - class(*), intent(inout) :: retrieve_component !< requested component to be retrieve. - !! retrieve_component can be of type atmos_data_type, land_data_type, ice_data_type, - !! ocean_public_type, land_ice_atmos_boundary_type, atmos_land_boundary_type, - !! atmos_ice_boundary_type, land_ice_boundary_type, ice_ocean_boundary_type, - !! ocean_ice_boundary_type + class(coupler_components_type), intent(in) :: this !< the coupler_components_type object + class(*), intent(iut) :: retrieve_component !< requested component to be retrieve. + !! retrieve_component can be of type atmos_data_type, land_data_type, ice_data_type, + !! ocean_public_type, land_ice_atmos_boundary_type, atmos_land_boundary_type, + !! atmos_ice_boundary_type, land_ice_boundary_type, ice_ocean_boundary_type, + !! ocean_ice_boundary_type select type(retrieve_component) type is(atmos_data_type) ; retrieve_component = this%Atm @@ -1193,12 +1209,76 @@ subroutine get_component(this, retrieve_component ) type is(ice_ocean_boundary_type) ; retrieve_component = this%Ice_ocean_boundary type is(ocean_ice_boundary_type) ; retrieve_component = this%Ocean_ice_boundary class default - call fms_mpp_error(FATAL, "getting component of coupler_chksum_type object, cannot recognize & - & component to be retrieved.") + call fms_mpp_error(FATAL, "failure retrieving component in coupler_components_type object, & + cannot recognize the type of requested component") end select end subroutine get_component - + + !> This subroutine associates the pointer in an object of coupler_chksum_type to the component models + subroutine coupler_chksum_obj_init(this, components_obj) + + implicit none + type(coupler_chksum_type), intent(inout) :: this + type(coupler_components_type), intent(in) :: components_obj + + type(atmos_data_type) :: Atm !< Atm + type(land_data_type) :: Land !< Land + type(ice_data_type) :: Ice !< Ice + type(ocean_public_tpe) :: Ocean !< Ocean + type(land_ice_atmos_boundary_type) :: Land_ice_atmos_boundary !< Land_ice_atmos_boundary + type(atmos_land_boundary_type) :: Atmos_land_boundary !< Atmos_land_boundary + type(atmos_ice_boundary_type) :: Atmos_ice_boundary !< Atmos_ice_boundary + type(land_ice_boundary_type) :: Land_ice_boundary !< Land_ice_boundary + type(ice_ocean_boundary_type) :: Ice_ocean_boundary !< Ice_ocean_boundary + type(ocean_ice_boundary_type) :: Ocean_ice_boundary !< Ocean_ice_boundary + + integer :: not_associated_count=0 !< number of components that not are not associated + + !> get model components in components_obj + call components_obj.get_component(Atm) + call components_obj.get_component(Land) + call components_obj.get_component(Ice) + call components_obj.get_component(Ocean) + call components_obj.get_component(Land_ice_atmos_boundary) + call components_obj.get_component(Atmos_land_boundary) + call components_obj.get_component(Atmos_ice_boundary) + call components_obj.get_component(Land_ice_boundary) + call components_obj.get_component(Ice_ocean_boundary) + call components_obj.get_component(Ocean_ice_boundary) + + !> check to see if components in components_obj are associated + if(.not.associated(Atm)) not_associated_count += 1 + if(.not.associated(Land)) not_associated_count += 1 + if(.not.associated(Ice)) not_associated_count += 1 + if(.not.associated(ocean)) not_associated_count += 1 + if(.not.associated(Land_ice_atmos_boundary)) not_associated_count += 1 + if(.not.associated(Atmos_land_boundary)) not_associated_count += 1 + if(.not.associated(Atmos_ice_boundary)) not_associated_count += 1 + if(.not.associated(Land_ice_boundary)) not_associated_count += 1 + if(.not.associated(Ice_ocean_boundary)) not_associated_count += 1 + if(.not.associated(Ocean_ice_boundary)) not_associated_count += 1 + + if(not_associated_count > 0 ) & + call mpp_error(FATAL, 'model components required for CHECKSUM computations have not been set') + + this%components = components_obj + + end subroutine coupler_chksum_obj_init + + !> This subroutine retrieves coupler_chksum_obj%components_obj + subroutine get_components_obj(this, components_obj) + + implicit none + + type(coupler_chksum_type), intent(in) :: this !< coupler_chksum_type + type(coupler_components_type), intent(out) :: components_obj !< coupler_components_type to be returned + + components_obj = this%components_obj + + end subroutine get_components_obj + + !> This subroutine finalizes the run subroutine coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_boundary, Atmos_ice_boundary,& Atmos_land_boundary, Ice_ocean_boundary, Ocean_ice_boundary, Ocn_bc_restart, & Ice_bc_restart, Time, Time_start, Time_end, Time_restart_current, coupler_chksum_obj) @@ -1224,10 +1304,10 @@ subroutine coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_bounda integer :: num_ice_bc_restart, num_ocn_bc_restart if ( do_endpoint_chksum ) then - call coupler_atmos_ice_land_ocean_chksum('coupler_end', 0, coupler_chksum_obj) + call coupler_chksum_obj%coupler_atmos_ice_land_ocean_chksum('coupler_end', 0) if (Ice%slow_ice_PE) then call fms_mpp_set_current_pelist(Ice%slow_pelist) - call slow_ice_chksum('coupler_end', 0, coupler_chksum_obj) + call coupler_chksum_obj%%slow_ice_chksum('coupler_end', 0) end if endif call fms_mpp_set_current_pelist() @@ -1388,23 +1468,26 @@ end subroutine coupler_restart !-------------------------------------------------------------------------- !> \brief Print out checksums for several atm, land and ice variables - subroutine coupler_chksum(id, timestep, coupler_chksum_obj) + subroutine coupler_chksum(this, id, timestep) implicit none - character(len=*), intent(in) :: id !< id to label CHECKSUMS in stdout - integer , intent(in) :: timestep !< timestep - type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< obj pointing to component types + type(coupler_chksum_type), intent(in) :: this !< self + character(:), intent(in) :: id !< id to label CHECKSUMS in stdout + integer , intent(in) :: timestep !< timestep type :: tracer_ind_type integer :: atm, ice, lnd ! indices of the tracer in the respective models end type tracer_ind_type - integer :: n_atm_tr, n_lnd_tr, n_exch_tr - integer :: n_atm_tr_tot, n_lnd_tr_tot - integer :: i, tr, n, m, outunit + + integer :: n_atm_tr, n_lnd_tr, n_exch_tr + integer :: n_atm_tr_tot, n_lnd_tr_tot + integer :: i, tr, n, m, outunit type(tracer_ind_type), allocatable :: tr_table(:) character(32) :: tr_name + call coupler_chksum_obj%get_components_obj(c) + call fms_tracer_manager_get_number_tracers (MODEL_ATMOS, num_tracers=n_atm_tr_tot, num_prog=n_atm_tr) call fms_tracer_manager_get_number_tracers (MODEL_LAND, num_tracers=n_lnd_tr_tot, num_prog=n_lnd_tr) @@ -1430,51 +1513,50 @@ subroutine coupler_chksum(id, timestep, coupler_chksum_obj) outunit = fms_mpp_stdout() write(outunit,*) 'BEGIN CHECKSUM(Atm):: ', id, timestep - write(outunit,100) 'atm%t_bot', fms_mpp_chksum(coupler_chksum_obj%Atm%t_bot) - write(outunit,100) 'atm%z_bot', fms_mpp_chksum(coupler_chksum_obj%Atm%z_bot) - write(outunit,100) 'atm%p_bot', fms_mpp_chksum(coupler_chksum_obj%Atm%p_bot) - write(outunit,100) 'atm%u_bot', fms_mpp_chksum(coupler_chksum_obj%Atm%u_bot) - write(outunit,100) 'atm%v_bot', fms_mpp_chksum(coupler_chksum_obj%Atm%v_bot) - write(outunit,100) 'atm%p_surf', fms_mpp_chksum(coupler_chksum_obj%Atm%p_surf) - write(outunit,100) 'atm%gust', fms_mpp_chksum(coupler_chksum_obj%Atm%gust) + write(outunit,100) 'atm%t_bot', fms_mpp_chksum(this%components%Atm%t_bot) + write(outunit,100) 'atm%z_bot', fms_mpp_chksum(this%components%Atm%z_bot) + write(outunit,100) 'atm%p_bot', fms_mpp_chksum(this%components%Atm%p_bot) + write(outunit,100) 'atm%u_bot', fms_mpp_chksum(this%components%Atm%u_bot) + write(outunit,100) 'atm%v_bot', fms_mpp_chksum(this%components%Atm%v_bot) + write(outunit,100) 'atm%p_surf', fms_mpp_chksum(this%components%Atm%p_surf) + write(outunit,100) 'atm%gust', fms_mpp_chksum(this%components%Atm%gust) do tr = 1,n_exch_tr n = tr_table(tr)%atm if (n /= NO_TRACER) then call fms_tracer_manager_get_tracer_names( MODEL_ATMOS, tr_table(tr)%atm, tr_name ) - write(outunit,100) 'atm%'//trim(tr_name), fms_mpp_chksum(coupler_chksum_obj%Atm%tr_bot(:,:,n)) + write(outunit,100) 'atm%'//trim(tr_name), fms_mpp_chksum(this%components%Atm%tr_bot(:,:,n)) endif enddo - write(outunit,100) 'land%t_surf', fms_mpp_chksum(coupler_chksum_obj%Land%t_surf) - write(outunit,100) 'land%t_ca', fms_mpp_chksum(coupler_chksum_obj%Land%t_ca) - write(outunit,100) 'land%rough_mom', fms_mpp_chksum(coupler_chksum_obj%Land%rough_mom) - write(outunit,100) 'land%rough_heat', fms_mpp_chksum(coupler_chksum_obj%Land%rough_heat) - write(outunit,100) 'land%rough_scale', fms_mpp_chksum(coupler_chksum_obj%Land%rough_scale) + write(outunit,100) 'land%t_surf', fms_mpp_chksum(this%components%Land%t_surf) + write(outunit,100) 'land%t_ca', fms_mpp_chksum(this%components%Land%t_ca) + write(outunit,100) 'land%rough_mom', fms_mpp_chksum(this%components%Land%rough_mom) + write(outunit,100) 'land%rough_heat', fms_mpp_chksum(this%components%Land%rough_heat) + write(outunit,100) 'land%rough_scale', fms_mpp_chksum(this%components%Land%rough_scale) do tr = 1,n_exch_tr n = tr_table(tr)%lnd if (n /= NO_TRACER) then call fms_tracer_manager_get_tracer_names( MODEL_ATMOS, tr_table(tr)%atm, tr_name ) #ifndef _USE_LEGACY_LAND_ - write(outunit,100) 'land%'//trim(tr_name), fms_mpp_chksum(coupler_chksum_obj%Land%tr(:,:,n)) + write(outunit,100) 'land%'//trim(tr_name), fms_mpp_chksum(this%components%Land%tr(:,:,n)) #else - write(outunit,100) 'land%'//trim(tr_name), fms_mpp_chksum(coupler_chksum_obj%Land%tr(:,:,:,n)) + write(outunit,100) 'land%'//trim(tr_name), fms_mpp_chksum(this%components%Land%tr(:,:,:,n)) #endif endif enddo - write(outunit,100) 'ice%t_surf', fms_mpp_chksum(coupler_chksum_obj%Ice%t_surf) - write(outunit,100) 'ice%rough_mom', fms_mpp_chksum(coupler_chksum_obj%Ice%rough_mom) - write(outunit,100) 'ice%rough_heat', fms_mpp_chksum(coupler_chksum_obj%Ice%rough_heat) - write(outunit,100) 'ice%rough_moist', fms_mpp_chksum(coupler_chksum_obj%Ice%rough_moist) + write(outunit,100) 'ice%t_surf', fms_mpp_chksum(this%components%Ice%t_surf) + write(outunit,100) 'ice%rough_mom', fms_mpp_chksum(this%components%Ice%rough_mom) + write(outunit,100) 'ice%rough_heat', fms_mpp_chksum(this%components%Ice%rough_heat) + write(outunit,100) 'ice%rough_moist', fms_mpp_chksum(this%components%Ice%rough_moist) write(outunit,*) 'STOP CHECKSUM(Atm):: ', id, timestep !endif - !if (Ocean%is_ocean_pe) then - !call mpp_set_current_pelist(Ocean%pelist) + !if (Ocean%is_ocean_pe) call mpp_set_current_pelist(Ocean%pelist) write(outunit,*) 'BEGIN CHECKSUM(Ice):: ', id, timestep - call fms_coupler_type_write_chksums(coupler_chksum_obj%Ice%ocean_fields, outunit, 'ice%') + call fms_coupler_type_write_chksums(this%components%Ice%ocean_fields, outunit, 'ice%') write(outunit,*) 'STOP CHECKSUM(Ice):: ', id, timestep endif @@ -1487,6 +1569,28 @@ end subroutine coupler_chksum !####################################################################### +!> \brief This subroutine calls coupler_chksum as well as atmos_ice_land_chksum and ocean_chksum + subroutine coupler_atmos_ice_land_ocean_chksum(this, id, timestep) + + implicit none + + type(coupler_chksum_type), intent(in) :: this !< self + character(:), intent(in) :: id !< ID labelling the set of checksums + integer , intent(in) :: timestep !< timestep + + if (this%components%Atm%pe) then + call fms_mpp_set_current_pelist(this%components%Atm%pelist) + call atmos_ice_land_chksum(trim(id), timestep, coupler_chksum_obj) + endif + if (this%components%Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(this%components%Ocean%pelist) + call ocean_chksum(trim(id), timestep, coupler_chksum_obj) + endif + + call fms_mpp_set_current_pelist() + + end subroutine coupler_atmos_ice_land_ocean_chksum + !> \brief This subroutine calls subroutine that will print out checksums of the elements !! of the appropriate type. !! For coupled models typically these types are not defined on all processors. @@ -1504,27 +1608,27 @@ end subroutine coupler_chksum !! call mpp_set_current_pelist() !! ~~~~~~~~~~ !! after you exit. This is only necessary if you need to return to the global pelist. - subroutine atmos_ice_land_chksum(id, timestep, coupler_chksum_obj) + subroutine atmos_ice_land_chksum(this, id, timestep) - character(len=*), intent(in) :: id !< id to label CHECKSUMS in stdout - integer , intent(in) :: timestep !< timestep - type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< object pointing to component types + type(coupler_chksum_type), intent(in) :: this !< self + character(:), intent(in) :: id !< id to label CHECKSUMS in stdout + integer , intent(in) :: timestep !< timestep - call atmos_data_type_chksum( id, timestep, coupler_chksum_obj%Atm) - call lnd_ice_atm_bnd_type_chksum(id, timestep, coupler_chksum_obj%Land_ice_atmos_boundary) + call atmos_data_type_chksum( id, timestep, this%components%Atm) + call lnd_ice_atm_bnd_type_chksum(id, timestep, this%components%Land_ice_atmos_boundary) - if (coupler_chksum_obj%Ice%fast_ice_pe) then - call fms_mpp_set_current_pelist(coupler_chksum_obj%Ice%fast_pelist) - call ice_data_type_chksum( id, timestep, coupler_chksum_obj%Ice) - call atm_ice_bnd_type_chksum(id, timestep, coupler_chksum_obj%Atmos_ice_boundary) + if (this%components%Ice%fast_ice_pe) then + call fms_mpp_set_current_pelist(this%components%Ice%fast_pelist) + call ice_data_type_chksum( id, timestep, this%components%Ice) + call atm_ice_bnd_type_chksum(id, timestep, this%components%Atmos_ice_boundary) endif - if (coupler_chksum_obj%Land%pe) then - call fms_mpp_set_current_pelist(coupler_chksum_obj%Land%pelist) - call land_data_type_chksum( id, timestep, coupler_chksum_obj%Land) - call atm_lnd_bnd_type_chksum(id, timestep, coupler_chksum_obj%Atmos_land_boundary) + if (this%components%Land%pe) then + call fms_mpp_set_current_pelist(this%components%Land%pelist) + call land_data_type_chksum( id, timestep, this%components%Land) + call atm_lnd_bnd_type_chksum(id, timestep, this%components%Atmos_land_boundary) endif - call fms_mpp_set_current_pelist(coupler_chksum_obj%Atm%pelist) + call fms_mpp_set_current_pelist(this%components%Atm%pelist) end subroutine atmos_ice_land_chksum @@ -1545,14 +1649,14 @@ end subroutine atmos_ice_land_chksum !! call mpp_set_current_pelist() !! ~~~~~~~~~~ !! after you exit. This is only necessary if you need to return to the global pelist. - subroutine slow_ice_chksum(id, timestep, coupler_chksum_obj) + subroutine slow_ice_chksum(this, id, timestep) - character(len=*), intent(in) :: id ! \brief This subroutine calls coupler_chksum as well as atmos_ice_land_chksum and ocean_chksum - subroutine coupler_atmos_ice_land_ocean_chksum(id, timestep, coupler_chksum_obj) - - implicit none - - character(len=*), intent(in) :: id !< ID labelling the set of checksums - integer , intent(in) :: timestep !< timestep - type(coupler_chksum_type), intent(in) :: coupler_chksum_obj - - if (coupler_chksum_obj%Atm%pe) then - call fms_mpp_set_current_pelist(coupler_chksum_obj%Atm%pelist) - call atmos_ice_land_chksum(trim(id), timestep, coupler_chksum_obj) - endif - if (coupler_chksum_obj%Ocean%is_ocean_pe) then - call fms_mpp_set_current_pelist(coupler_chksum_obj%Ocean%pelist) - call ocean_chksum(trim(id), timestep, coupler_chksum_obj) - endif - - call fms_mpp_set_current_pelist() - - end subroutine coupler_atmos_ice_land_ocean_chksum - !> \brief This subroutine calls flux_init_stocks or does the final call to flux_check_stocks subroutine coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, & - coupler_clocks, init_stocks, finish_stocks) + coupler_clocks, init_stocks, finish_stocks) implicit none @@ -1857,7 +1939,7 @@ subroutine coupler_unpack_ocean_ice_boundary(nc, Time_flux_ocean_to_ice, Ice, Oc ! This may do data override or diagnostics on Ice_ocean_boundary. call flux_ocean_to_ice_finish( Time_flux_ocean_to_ice, Ice, Ocean_Ice_Boundary ) call unpack_ocean_ice_boundary( Ocean_ice_boundary, Ice ) - if (do_chksum) call slow_ice_chksum('update_ice_slow+', nc, coupler_chksum_obj) + if (do_chksum) call coupler_chksum_obj%slow_ice_chksum('update_ice_slow+', nc) call fms_mpp_clock_end(coupler_clocks%set_ice_surface_slow) @@ -1961,7 +2043,7 @@ subroutine coupler_sfc_boundary_layer(Atm, Land, Ice, Land_ice_atmos_boundary, & call fms_mpp_clock_begin(coupler_clocks%sfc_boundary_layer) call sfc_boundary_layer( real(dt_atmos), Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary ) - if(do_chksum) call atmos_ice_land_chksum('sfc+', current_time_step, coupler_chksum_obj) + if(do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('sfc+', current_time_step) call fms_mpp_clock_end(coupler_clocks%sfc_boundary_layer) From 8a1b6f1317d89cd24ddd60efa42490ce11efc280 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 14 Jun 2024 10:13:24 -0400 Subject: [PATCH 14/24] change subroutine names to get_chksums --- full/coupler_main.F90 | 51 +++++++------- full/full_coupler_mod.F90 | 143 +++++++++++++------------------------- 2 files changed, 75 insertions(+), 119 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index e2ad15f3..a5a1c50b 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -434,7 +434,7 @@ program coupler_main Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, num_cpld_calls, & num_atmos_calls, Time, Time_start, Time_end, Time_restart, Time_restart_current) - if (do_chksum) call coupler_chksum_obj%coupler_chksum('coupler_init+', 0) + if (do_chksum) call coupler_chksum_obj%get_coupler_chksums('coupler_init+', 0) call fms_mpp_set_current_pelist() call fms_mpp_clock_end(coupler_clocks%initialization) !end initialization @@ -450,8 +450,8 @@ program coupler_main do nc = 1, num_cpld_calls if (do_chksum) then - call coupler_chksum_obj%coupler_chksum('top_of_coupled_loop+', nc) - call coupler_chksum_obj%coupler_atmos_ice_land_ocean_chksum('MAIN_LOOP-', nc) + call coupler_chksum_obj%get_coupler_chksums('top_of_coupled_loop+', nc) + call coupler_chksum_obj%get_atmos_ice_land_ocean_chksums('MAIN_LOOP-', nc) end if ! Calls to flux_ocean_to_ice and flux_ice_to_ocean are all PE communication @@ -472,8 +472,8 @@ program coupler_main end if if (do_chksum) then - call coupler_chksum_obj%coupler_chksum('flux_ocn2ice+', nc) - call coupler_chksum_obj%coupler_atmos_ice_land_ocean_chksum('flux_ocn2ice+', nc) + call coupler_chksum_obj%get_coupler_chksums('flux_ocn2ice+', nc) + call coupler_chksum_obj%get_atmos_ice_land_ocean_chksums('flux_ocn2ice+', nc) end if ! needs to sit here rather than at the end of the coupler loop. @@ -499,7 +499,7 @@ program coupler_main if (.NOT.(do_ice.and.Ice%pe) .OR. (ice_npes.NE.atmos_npes)) call fms_mpp_set_current_pelist(Atm%pelist) - if(do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('set_ice_surface+', nc) + if(do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('set_ice_surface+', nc) call fms_mpp_clock_begin(coupler_clocks%atm) @@ -515,7 +515,7 @@ program coupler_main Time_atmos = Time_atmos + Time_step_atmos current_timestep = (nc-1)*num_atmos_calls+na - if (do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('top_of_atmos_loop-', current_timestep) + if (do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('top_of_atmos_loop-', current_timestep) if (do_atmos) call coupler_atmos_tracer_driver_gather_data(Atm, coupler_clocks) @@ -531,7 +531,7 @@ program coupler_main !$OMP& SHARED(Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, Atmos_ice_boundary) & !$OMP& SHARED(Ocean_ice_boundary) & !$OMP& SHARED(do_debug, do_chksum, do_atmos, do_land, do_ice, do_concurrent_radiation, omp_sec, imb_sec) & -!$OMP& SHARED(coupler_clocks, coupler_chksum_obj) +!$OMP& SHARED(coupler_clocks, current_timestep, coupler_chksum_obj) !$ if (omp_get_thread_num() == 0) then !$OMP PARALLEL & !$OMP& NUM_THREADS(1) & @@ -541,7 +541,7 @@ program coupler_main !$OMP& SHARED(Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, Atmos_ice_boundary) & !$OMP& SHARED(Ocean_ice_boundary) & !$OMP& SHARED(do_debug, do_chksum, do_atmos, do_land, do_ice, do_concurrent_radiation, omp_sec, imb_sec) & -!$OMP& SHARED(coupler_clocks, coupler_chksum_obj) +!$OMP& SHARED(coupler_clocks, current_timestep, coupler_chksum_obj) !$ call omp_set_num_threads(atmos_nthreads) !$ dsec=omp_get_wtime() @@ -553,7 +553,8 @@ program coupler_main call update_atmos_model_dynamics(Atm) call fms_mpp_clock_end(coupler_clocks%update_atmos_model_dynamics) endif - if (do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('update_atmos_model_dynamics', current_timestep) + if (do_chksum) & + call coupler_chksum_obj%get_atmos_ice_land_chksums('update_atmos_model_dynamics', current_timestep) if (do_debug) call fms_memutils_print_memuse_stats( 'update dyn') ! ---- SERIAL atmosphere radiation ---- @@ -563,7 +564,7 @@ program coupler_main call fms_mpp_clock_end(coupler_clocks%serial_radiation) endif if (do_chksum) & - call coupler_chksum_obj%atmos_ice_land_chksum('update_atmos_model_radiation(ser)', current_timestep) + call coupler_chksum_obj%get_atmos_ice_land_chksums('update_atmos_model_radiation(ser)', current_timestep) if (do_debug) call fms_memutils_print_memuse_stats( 'update serial rad') ! ---- atmosphere down ---- @@ -572,7 +573,7 @@ program coupler_main call update_atmos_model_down( Land_ice_atmos_boundary, Atm ) call fms_mpp_clock_end(coupler_clocks%update_atmos_model_down) endif - if (do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('update_atmos_down+', current_timestep) + if (do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('update_atmos_down+', current_timestep) if (do_debug) call fms_memutils_print_memuse_stats( 'update down') call fms_mpp_clock_begin(coupler_clocks%flux_down_from_atmos) @@ -581,7 +582,7 @@ program coupler_main Atmos_land_boundary, & Atmos_ice_boundary ) call fms_mpp_clock_end(coupler_clocks%flux_down_from_atmos) - if (do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('flux_down_from_atmos+', current_timestep) + if (do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('flux_down_from_atmos+', current_timestep) ! -------------------------------------------------------------- ! ---- land model ---- @@ -592,7 +593,7 @@ program coupler_main endif if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Atm%pelist) call fms_mpp_clock_end(coupler_clocks%update_land_model_fast) - if (do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('update_land_fast+', current_timestep) + if (do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('update_land_fast+', current_timestep) if (do_debug) call fms_memutils_print_memuse_stats( 'update land') ! ---- ice model ---- @@ -603,7 +604,7 @@ program coupler_main endif if (ice_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Atm%pelist) call fms_mpp_clock_end(coupler_clocks%update_ice_model_fast) - if (do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('update_ice_fast+', current_timestep) + if (do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('update_ice_fast+', current_timestep) if (do_debug) call fms_memutils_print_memuse_stats( 'update ice') ! -------------------------------------------------------------- @@ -612,13 +613,13 @@ program coupler_main call flux_up_to_atmos( Time_atmos, Land, Ice, Land_ice_atmos_boundary, & Atmos_land_boundary, Atmos_ice_boundary ) call fms_mpp_clock_end(coupler_clocks%flux_up_to_atmos) - if (do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('flux_up2atmos+', current_timestep) + if (do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('flux_up2atmos+', current_timestep) call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_up) if (do_atmos) & call update_atmos_model_up( Land_ice_atmos_boundary, Atm) call fms_mpp_clock_end(coupler_clocks%update_atmos_model_up) - if (do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('update_atmos_up+', current_timestep) + if (do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('update_atmos_up+', current_timestep) if (do_debug) call fms_memutils_print_memuse_stats( 'update up') call flux_atmos_to_ocean(Time_atmos, Atm, Atmos_ice_boundary, Ice) @@ -663,7 +664,7 @@ program coupler_main call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_state) call update_atmos_model_state( Atm ) - if (do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('update_atmos_model_state+', current_timestep) + if (do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('update_atmos_model_state+', current_timestep) if (do_debug) call fms_memutils_print_memuse_stats( 'update state') call fms_mpp_clock_end(coupler_clocks%update_atmos_model_state) @@ -680,7 +681,7 @@ program coupler_main if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Atm%pelist) !----------------------------------------------------------------------- call fms_mpp_clock_end(coupler_clocks%update_land_model_slow) - if (do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('update_land_slow+', nc) + if (do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('update_land_slow+', nc) ! ! need flux call to put runoff and p_surf on ice grid @@ -688,7 +689,7 @@ program coupler_main call fms_mpp_clock_begin(coupler_clocks%flux_land_to_ice) call flux_land_to_ice( Time, Land, Ice, Land_ice_boundary ) call fms_mpp_clock_end(coupler_clocks%flux_land_to_ice) - if (do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('fluxlnd2ice+', nc) + if (do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('fluxlnd2ice+', nc) Atmos_ice_boundary%p = 0.0 ! call flux_atmos_to_ice_slow ? Time = Time_atmos @@ -729,7 +730,7 @@ program coupler_main call fms_mpp_clock_end(coupler_clocks%update_ice_model_slow_slow) endif - if (do_chksum) call coupler_chksum_obj%slow_ice_chksum('update_ice_slow+', nc) + if (do_chksum) call coupler_chksum_obj%get_slow_ice_chksums('update_ice_slow+', nc) endif ! End of Ice%pe block if(Atm%pe) then @@ -758,7 +759,7 @@ program coupler_main call update_slow_ice_and_ocean(ice_ocean_driver_CS, Ice, Ocean_state, Ocean, & Ice_ocean_boundary, Time_ocean, Time_step_cpld ) else - if (do_chksum) call ocean_chksum('update_ocean_model-', nc, coupler_chksum_obj) + if (do_chksum) call coupler_chksum_obj%get_ocean_chksums('update_ocean_model-', nc) ! update_ocean_model since fluxes don't change here if (do_ocean) & @@ -766,7 +767,7 @@ program coupler_main Time_ocean, Time_step_cpld ) endif - if (do_chksum) call coupler_chksum_obj%ocean_chksum('update_ocean_model+', nc) + if (do_chksum) call coupler_chksum_obj%get_ocean_chksums('update_ocean_model+', nc) ! Get stocks from "Ice_ocean_boundary" and add them to Ocean stocks. ! This call is just for record keeping of stocks transfer and ! does not modify either Ocean or Ice_ocean_boundary @@ -801,7 +802,7 @@ program coupler_main endif !-------------- - if (do_chksum) call coupler_chksum('MAIN_LOOP+', nc, coupler_chksum_obj) + if (do_chksum) call coupler_chksum_obj%get_coupler_chksums('MAIN_LOOP+', nc) write( text,'(a,i6)' )'Main loop at coupling timestep=', nc call fms_memutils_print_memuse_stats(text) outunit= fms_mpp_stdout() @@ -823,7 +824,7 @@ program coupler_main call fms_mpp_clock_end(coupler_clocks%main) call fms_mpp_clock_begin(coupler_clocks%termination) - if (do_chksum) call coupler_chksum_obj%coupler_chksum('coupler_end-', nc) + if (do_chksum) call coupler_chksum_obj%get_coupler_chksums('coupler_end-', nc) call coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_boundary, Atmos_ice_boundary,& Atmos_land_boundary, Ice_ocean_boundary, Ocean_ice_boundary, Ocn_bc_restart, Ice_bc_restart, & Time, Time_start, Time_end, Time_restart_current, coupler_chksum_obj) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 0b6b7c08..840ccbb8 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -120,9 +120,6 @@ module full_coupler_mod public :: ocean_public_type_chksum, ice_ocn_bnd_type_chksum public :: coupler_init, coupler_end, coupler_restart - public :: coupler_chksum, atmos_ice_land_chksum, slow_ice_chksum, ocean_chksum - - public :: coupler_atmos_ice_land_ocean_chksum public :: coupler_flux_init_finish_stocks, coupler_flux_check_stocks public :: coupler_flux_ocean_to_ice, coupler_flux_ice_to_ocean @@ -133,7 +130,7 @@ module full_coupler_mod public :: coupler_generate_sfc_xgrid public :: coupler_atmos_tracer_driver_gather_data, coupler_sfc_boundary_layer - public :: coupler_clock_type, coupler_chksum_type + public :: coupler_clock_type, coupler_components_type, coupler_chksum_type #include @@ -303,11 +300,11 @@ module full_coupler_mod contains procedure, public :: coupler_chksum_obj_init !< associates the pointers above to model components procedure, public :: get_components_obj !< subroutine to retrieve the requested component of an object of this type - procedure, public :: coupler_atmos_ice_land_ocean_chksum !< subroutine to compute chksums for atmos - ocean - procedure, public :: atmos_ice_land_chksum !< subroutine to compute chksums for atmos_ice_land - procedure, public :: slow_ice_chksum !< subroutine to compute chskums for slow_ice - procedure, public :: ocean_chksum !< subroutine to compute chksums for ocean - procedure, public :: coupler_chksum !< subroutine to compute chksums for select fields + procedure, public :: get_atmos_ice_land_ocean_chksums !< subroutine to compute chksums for atmos - ocean + procedure, public :: get_atmos_ice_land_chksums !< subroutine to compute chksums for atmos_ice_land + procedure, public :: get_slow_ice_chksums !< subroutine to compute chskums for slow_ice + procedure, public :: get_ocean_chksums !< subroutine to compute chksums for ocean + procedure, public :: get_coupler_chksums !< subroutine to compute chksums for select fields end type coupler_chksum_type character(len=80) :: text @@ -1135,10 +1132,10 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, call coupler_chksum_obj%coupler_chksum_obj_init(coupler_components_obj) if ( do_endpoint_chksum ) then - call coupler_chksum_obj%coupler_atmos_ice_land_ocean_chksum('coupler_init+', 0) + call coupler_chksum_obj%get_atmos_ice_land_ocean_chksums('coupler_init+', 0) if (Ice%slow_ice_PE) then call fms_mpp_set_current_pelist(Ice%slow_pelist) - call coupler_chksum_obj%slow_ice_chksum('coupler_init+', 0) + call coupler_chksum_obj%get_slow_ice_chksums('coupler_init+', 0) end if end if @@ -1159,7 +1156,7 @@ subroutine coupler_components_obj_init(this, Atm, Land, Ice, Ocean, Land_ice_atm Atmos_ice_boundary, Land_ice_boundary, Ice_ocean_boundary, Ocean_ice_boundary) implicit none - class(coupler_chksum_type), intent(inout) :: this !< self + class(coupler_components_type), intent(inout) :: this !< self type(atmos_data_type), target, intent(in) :: Atm !< Atm type(land_data_type), target, intent(in) :: Land !< Land type(ice_data_type), target, intent(in) :: Ice !< Ice @@ -1191,7 +1188,7 @@ subroutine get_component(this, retrieve_component ) implicit none class(coupler_components_type), intent(in) :: this !< the coupler_components_type object - class(*), intent(iut) :: retrieve_component !< requested component to be retrieve. + class(*), intent(out) :: retrieve_component !< requested component to be retrieve. !! retrieve_component can be of type atmos_data_type, land_data_type, ice_data_type, !! ocean_public_type, land_ice_atmos_boundary_type, atmos_land_boundary_type, !! atmos_ice_boundary_type, land_ice_boundary_type, ice_ocean_boundary_type, @@ -1219,49 +1216,9 @@ end subroutine get_component subroutine coupler_chksum_obj_init(this, components_obj) implicit none - type(coupler_chksum_type), intent(inout) :: this + class(coupler_chksum_type), intent(inout) :: this type(coupler_components_type), intent(in) :: components_obj - type(atmos_data_type) :: Atm !< Atm - type(land_data_type) :: Land !< Land - type(ice_data_type) :: Ice !< Ice - type(ocean_public_tpe) :: Ocean !< Ocean - type(land_ice_atmos_boundary_type) :: Land_ice_atmos_boundary !< Land_ice_atmos_boundary - type(atmos_land_boundary_type) :: Atmos_land_boundary !< Atmos_land_boundary - type(atmos_ice_boundary_type) :: Atmos_ice_boundary !< Atmos_ice_boundary - type(land_ice_boundary_type) :: Land_ice_boundary !< Land_ice_boundary - type(ice_ocean_boundary_type) :: Ice_ocean_boundary !< Ice_ocean_boundary - type(ocean_ice_boundary_type) :: Ocean_ice_boundary !< Ocean_ice_boundary - - integer :: not_associated_count=0 !< number of components that not are not associated - - !> get model components in components_obj - call components_obj.get_component(Atm) - call components_obj.get_component(Land) - call components_obj.get_component(Ice) - call components_obj.get_component(Ocean) - call components_obj.get_component(Land_ice_atmos_boundary) - call components_obj.get_component(Atmos_land_boundary) - call components_obj.get_component(Atmos_ice_boundary) - call components_obj.get_component(Land_ice_boundary) - call components_obj.get_component(Ice_ocean_boundary) - call components_obj.get_component(Ocean_ice_boundary) - - !> check to see if components in components_obj are associated - if(.not.associated(Atm)) not_associated_count += 1 - if(.not.associated(Land)) not_associated_count += 1 - if(.not.associated(Ice)) not_associated_count += 1 - if(.not.associated(ocean)) not_associated_count += 1 - if(.not.associated(Land_ice_atmos_boundary)) not_associated_count += 1 - if(.not.associated(Atmos_land_boundary)) not_associated_count += 1 - if(.not.associated(Atmos_ice_boundary)) not_associated_count += 1 - if(.not.associated(Land_ice_boundary)) not_associated_count += 1 - if(.not.associated(Ice_ocean_boundary)) not_associated_count += 1 - if(.not.associated(Ocean_ice_boundary)) not_associated_count += 1 - - if(not_associated_count > 0 ) & - call mpp_error(FATAL, 'model components required for CHECKSUM computations have not been set') - this%components = components_obj end subroutine coupler_chksum_obj_init @@ -1271,10 +1228,10 @@ subroutine get_components_obj(this, components_obj) implicit none - type(coupler_chksum_type), intent(in) :: this !< coupler_chksum_type + class(coupler_chksum_type), intent(in) :: this !< coupler_chksum_type type(coupler_components_type), intent(out) :: components_obj !< coupler_components_type to be returned - components_obj = this%components_obj + components_obj = this%components end subroutine get_components_obj @@ -1304,10 +1261,10 @@ subroutine coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_bounda integer :: num_ice_bc_restart, num_ocn_bc_restart if ( do_endpoint_chksum ) then - call coupler_chksum_obj%coupler_atmos_ice_land_ocean_chksum('coupler_end', 0) + call coupler_chksum_obj%get_atmos_ice_land_ocean_chksums('coupler_end', 0) if (Ice%slow_ice_PE) then call fms_mpp_set_current_pelist(Ice%slow_pelist) - call coupler_chksum_obj%%slow_ice_chksum('coupler_end', 0) + call coupler_chksum_obj%get_slow_ice_chksums('coupler_end', 0) end if endif call fms_mpp_set_current_pelist() @@ -1468,13 +1425,13 @@ end subroutine coupler_restart !-------------------------------------------------------------------------- !> \brief Print out checksums for several atm, land and ice variables - subroutine coupler_chksum(this, id, timestep) + subroutine get_coupler_chksums(this, id, timestep) implicit none - - type(coupler_chksum_type), intent(in) :: this !< self - character(:), intent(in) :: id !< id to label CHECKSUMS in stdout - integer , intent(in) :: timestep !< timestep + + class(coupler_chksum_type), intent(in) :: this !< self + character(len=*), intent(in) :: id !< id to label CHECKSUMS in stdout + integer , intent(in) :: timestep !< timestep type :: tracer_ind_type integer :: atm, ice, lnd ! indices of the tracer in the respective models @@ -1486,8 +1443,6 @@ subroutine coupler_chksum(this, id, timestep) type(tracer_ind_type), allocatable :: tr_table(:) character(32) :: tr_name - call coupler_chksum_obj%get_components_obj(c) - call fms_tracer_manager_get_number_tracers (MODEL_ATMOS, num_tracers=n_atm_tr_tot, num_prog=n_atm_tr) call fms_tracer_manager_get_number_tracers (MODEL_LAND, num_tracers=n_lnd_tr_tot, num_prog=n_lnd_tr) @@ -1508,8 +1463,8 @@ subroutine coupler_chksum(this, id, timestep) 100 FORMAT("CHECKSUM::",A32," = ",Z20) 101 FORMAT("CHECKSUM::",A16,a,'%',a," = ",Z20) - if (coupler_chksum_obj%Atm%pe) then - call fms_mpp_set_current_pelist(coupler_chksum_obj%Atm%pelist) + if (this%components%Atm%pe) then + call fms_mpp_set_current_pelist(this%components%Atm%pelist) outunit = fms_mpp_stdout() write(outunit,*) 'BEGIN CHECKSUM(Atm):: ', id, timestep @@ -1525,8 +1480,8 @@ subroutine coupler_chksum(this, id, timestep) if (n /= NO_TRACER) then call fms_tracer_manager_get_tracer_names( MODEL_ATMOS, tr_table(tr)%atm, tr_name ) write(outunit,100) 'atm%'//trim(tr_name), fms_mpp_chksum(this%components%Atm%tr_bot(:,:,n)) - endif - enddo + endif + enddo write(outunit,100) 'land%t_surf', fms_mpp_chksum(this%components%Land%t_surf) write(outunit,100) 'land%t_ca', fms_mpp_chksum(this%components%Land%t_ca) @@ -1565,31 +1520,31 @@ subroutine coupler_chksum(this, id, timestep) call fms_mpp_set_current_pelist() - end subroutine coupler_chksum + end subroutine get_coupler_chksums !####################################################################### !> \brief This subroutine calls coupler_chksum as well as atmos_ice_land_chksum and ocean_chksum - subroutine coupler_atmos_ice_land_ocean_chksum(this, id, timestep) + subroutine get_atmos_ice_land_ocean_chksums(this, id, timestep) implicit none - type(coupler_chksum_type), intent(in) :: this !< self - character(:), intent(in) :: id !< ID labelling the set of checksums - integer , intent(in) :: timestep !< timestep + class(coupler_chksum_type), intent(in) :: this !< self + character(len=*), intent(in) :: id !< ID labelling the set of checksums + integer , intent(in) :: timestep !< timestep if (this%components%Atm%pe) then call fms_mpp_set_current_pelist(this%components%Atm%pelist) - call atmos_ice_land_chksum(trim(id), timestep, coupler_chksum_obj) + call this%get_atmos_ice_land_chksums(trim(id), timestep) endif if (this%components%Ocean%is_ocean_pe) then call fms_mpp_set_current_pelist(this%components%Ocean%pelist) - call ocean_chksum(trim(id), timestep, coupler_chksum_obj) + call this%get_ocean_chksums(trim(id), timestep) endif call fms_mpp_set_current_pelist() - end subroutine coupler_atmos_ice_land_ocean_chksum + end subroutine get_coupler_atmos_ice_land_ocean_chksums !> \brief This subroutine calls subroutine that will print out checksums of the elements !! of the appropriate type. @@ -1608,11 +1563,11 @@ end subroutine coupler_atmos_ice_land_ocean_chksum !! call mpp_set_current_pelist() !! ~~~~~~~~~~ !! after you exit. This is only necessary if you need to return to the global pelist. - subroutine atmos_ice_land_chksum(this, id, timestep) + subroutine get_atmos_ice_land_chksums(this, id, timestep) - type(coupler_chksum_type), intent(in) :: this !< self - character(:), intent(in) :: id !< id to label CHECKSUMS in stdout - integer , intent(in) :: timestep !< timestep + class(coupler_chksum_type), intent(in) :: this !< self + character(len=*), intent(in) :: id !< id to label CHECKSUMS in stdout + integer , intent(in) :: timestep !< timestep call atmos_data_type_chksum( id, timestep, this%components%Atm) call lnd_ice_atm_bnd_type_chksum(id, timestep, this%components%Land_ice_atmos_boundary) @@ -1630,7 +1585,7 @@ subroutine atmos_ice_land_chksum(this, id, timestep) call fms_mpp_set_current_pelist(this%components%Atm%pelist) - end subroutine atmos_ice_land_chksum + end subroutine get_atmos_ice_land_chksums !> \brief This subroutine calls subroutine that will print out checksums of the elements !! of the appropriate type. @@ -1649,16 +1604,16 @@ end subroutine atmos_ice_land_chksum !! call mpp_set_current_pelist() !! ~~~~~~~~~~ !! after you exit. This is only necessary if you need to return to the global pelist. - subroutine slow_ice_chksum(this, id, timestep) + subroutine get_slow_ice_chksums(this, id, timestep) - type(coupler_chksum_type), intent(in) :: this !< self - character(:), intent(in) :: id ! \brief This subroutine calls subroutine that will print out checksums of the elements @@ -1678,16 +1633,16 @@ end subroutine slow_ice_chksum !! call mpp_set_current_pelist() !! ~~~~~~~~~~ !! after you exit. This is only necessary if you need to return to the global pelist. - subroutine ocean_chksum(this, id, timestep) + subroutine get_ocean_chksums(this, id, timestep) - type(coupler_chksum_type), intent(in) :: this !< self - character(:), intent(in) :: id !< ID labelling the set of CHECKSUMS - integer , intent(in) :: timestep !< Timestep + class(coupler_chksum_type), intent(in) :: this !< self + character(len=*), intent(in) :: id !< ID labelling the set of CHECKSUMS + integer , intent(in) :: timestep !< Timestep call ocean_public_type_chksum(id, timestep, this%components%Ocean) call ice_ocn_bnd_type_chksum( id, timestep, this%components%Ice_ocean_boundary) - end subroutine ocean_chksum + end subroutine get_ocean_chksums !> \brief This subroutine sets the ID for clocks used in coupler_main subroutine coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble_pelist,& @@ -1939,7 +1894,7 @@ subroutine coupler_unpack_ocean_ice_boundary(nc, Time_flux_ocean_to_ice, Ice, Oc ! This may do data override or diagnostics on Ice_ocean_boundary. call flux_ocean_to_ice_finish( Time_flux_ocean_to_ice, Ice, Ocean_Ice_Boundary ) call unpack_ocean_ice_boundary( Ocean_ice_boundary, Ice ) - if (do_chksum) call coupler_chksum_obj%slow_ice_chksum('update_ice_slow+', nc) + if (do_chksum) call coupler_chksum_obj%get_slow_ice_chksums('update_ice_slow+', nc) call fms_mpp_clock_end(coupler_clocks%set_ice_surface_slow) @@ -2043,7 +1998,7 @@ subroutine coupler_sfc_boundary_layer(Atm, Land, Ice, Land_ice_atmos_boundary, & call fms_mpp_clock_begin(coupler_clocks%sfc_boundary_layer) call sfc_boundary_layer( real(dt_atmos), Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary ) - if(do_chksum) call coupler_chksum_obj%atmos_ice_land_chksum('sfc+', current_time_step) + if(do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('sfc+', current_time_step) call fms_mpp_clock_end(coupler_clocks%sfc_boundary_layer) From 229094c1b349a2d9b2568217c87d0f15c2de8190 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 14 Jun 2024 10:16:09 -0400 Subject: [PATCH 15/24] fix compile errors --- full/full_coupler_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 840ccbb8..63e9b8f1 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -1544,7 +1544,7 @@ subroutine get_atmos_ice_land_ocean_chksums(this, id, timestep) call fms_mpp_set_current_pelist() - end subroutine get_coupler_atmos_ice_land_ocean_chksums + end subroutine get_atmos_ice_land_ocean_chksums !> \brief This subroutine calls subroutine that will print out checksums of the elements !! of the appropriate type. From afa4063ae9101b5f7a73a2cccc373c00c31890a3 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 14 Jun 2024 10:30:35 -0400 Subject: [PATCH 16/24] add setters --- full/coupler_main.F90 | 2 +- full/full_coupler_mod.F90 | 81 ++++++++++++++++++++++++++++++--------- 2 files changed, 64 insertions(+), 19 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index a5a1c50b..804bdcee 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -682,7 +682,7 @@ program coupler_main !----------------------------------------------------------------------- call fms_mpp_clock_end(coupler_clocks%update_land_model_slow) if (do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('update_land_slow+', nc) - + ! ! need flux call to put runoff and p_surf on ice grid ! diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 63e9b8f1..d1270db8 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -276,7 +276,7 @@ module full_coupler_mod type coupler_components_type private - type(atmos_data_type), pointer :: Atm !< pointer to Atm + type(atmos_data_type), pointer :: Atm !< pointer to Atm type(land_data_type), pointer :: Land !< pointer to Land type(ice_data_type), pointer :: Ice !< pointer to Ice type(ocean_public_type), pointer :: Ocean !< pointer to Ocean @@ -289,17 +289,19 @@ module full_coupler_mod contains procedure, public :: coupler_components_obj_init procedure, public :: get_component !< subroutine to retrieve the requested component of an object of this type - end type coupler_components_type - + procedure, public :: set_component !< subroutine to set requested component of an object of this type + end type coupler_components_type + !> The purpose of objects of coupler_chksum_type is to simplify the list !! of arguments required for chksum related subroutines in full_coupler_mod. - !! The members of this type point to the model components + !! The members of this type point to the model components type coupler_chksum_type private type(coupler_components_type), pointer :: components contains procedure, public :: coupler_chksum_obj_init !< associates the pointers above to model components procedure, public :: get_components_obj !< subroutine to retrieve the requested component of an object of this type + procedure, public :: set_components_obj !< subroutine to set components object procedure, public :: get_atmos_ice_land_ocean_chksums !< subroutine to compute chksums for atmos - ocean procedure, public :: get_atmos_ice_land_chksums !< subroutine to compute chksums for atmos_ice_land procedure, public :: get_slow_ice_chksums !< subroutine to compute chskums for slow_ice @@ -1127,7 +1129,7 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, !> Initialize coupler_components_obj memebers to point to model components call coupler_components_obj%coupler_components_obj_init(Atm, Land, Ice, Ocean, Land_ice_atmos_boundary, & Atmos_land_boundary, Atmos_ice_boundary, Land_ice_boundary, Ice_ocean_boundary, Ocean_ice_boundary) - + !> Initialize coupler_chksum_obj call coupler_chksum_obj%coupler_chksum_obj_init(coupler_components_obj) @@ -1187,7 +1189,7 @@ end subroutine coupler_components_obj_init subroutine get_component(this, retrieve_component ) implicit none - class(coupler_components_type), intent(in) :: this !< the coupler_components_type object + class(coupler_components_type), intent(in) :: this !< the coupler_components_type object class(*), intent(out) :: retrieve_component !< requested component to be retrieve. !! retrieve_component can be of type atmos_data_type, land_data_type, ice_data_type, !! ocean_public_type, land_ice_atmos_boundary_type, atmos_land_boundary_type, @@ -1195,7 +1197,7 @@ subroutine get_component(this, retrieve_component ) !! ocean_ice_boundary_type select type(retrieve_component) - type is(atmos_data_type) ; retrieve_component = this%Atm + type is(atmos_data_type) ; retrieve_component = this%Atm type is(land_data_type) ; retrieve_component = this%Land type is(ice_data_type) ; retrieve_component = this%Ice type is(ocean_public_type) ; retrieve_component = this%Ocean @@ -1209,10 +1211,41 @@ subroutine get_component(this, retrieve_component ) call fms_mpp_error(FATAL, "failure retrieving component in coupler_components_type object, & cannot recognize the type of requested component") end select - + end subroutine get_component - - !> This subroutine associates the pointer in an object of coupler_chksum_type to the component models + + !> Function set_component sets the requested component in the coupler_components_type object + !! Users are required to provide the component to be set as an input argument. For example, + !! coupler_components_obj%get_component(Atm) will set coupler_components_obj%Atm = Atm + subroutine set_component(this, set_this_component ) + + implicit none + class(coupler_components_type), intent(inout) :: this !< the coupler_components_type object + class(*), intent(in) :: set_this_component !< requested component to be be set. + !! set_this_component can be of type atmos_data_type, land_data_type, ice_data_type, + !! ocean_public_type, land_ice_atmos_boundary_type, atmos_land_boundary_type, + !! atmos_ice_boundary_type, land_ice_boundary_type, ice_ocean_boundary_type, + !! ocean_ice_boundary_type + + select type(set_this_component) + type is(atmos_data_type) ; this%Atm = set_this_component + type is(land_data_type) ; this%Land = set_this_component + type is(ice_data_type) ; this%Ice = set_this_component + type is(ocean_public_type) ; this%Ocean = set_this_component + type is(land_ice_atmos_boundary_type) ; this%Land_ice_atmos_boundary = set_this_component + type is(atmos_land_boundary_type) ; this%Atmos_land_boundary = set_this_component + type is(atmos_ice_boundary_type) ; this%Atmos_ice_boundary = set_this_component + type is(land_ice_boundary_type) ; this%Land_ice_boundary = set_this_component + type is(ice_ocean_boundary_type) ; this%Ice_ocean_boundary = set_this_component + type is(ocean_ice_boundary_type) ; this%Ocean_ice_boundary = set_this_component + class default + call fms_mpp_error(FATAL, "failure setting component in coupler_components_type object, & + cannot recognize the type of requested component") + end select + + end subroutine set_component + + !> This subroutine associates the pointer in an object of coupler_chksum_type to the component models subroutine coupler_chksum_obj_init(this, components_obj) implicit none @@ -1220,21 +1253,33 @@ subroutine coupler_chksum_obj_init(this, components_obj) type(coupler_components_type), intent(in) :: components_obj this%components = components_obj - + end subroutine coupler_chksum_obj_init !> This subroutine retrieves coupler_chksum_obj%components_obj subroutine get_components_obj(this, components_obj) implicit none - + class(coupler_chksum_type), intent(in) :: this !< coupler_chksum_type type(coupler_components_type), intent(out) :: components_obj !< coupler_components_type to be returned components_obj = this%components - + end subroutine get_components_obj + !> This subroutine set coupler_chksum_obj%components_obj + subroutine set_components_obj(this, components_obj) + + implicit none + + class(coupler_chksum_type), intent(inout) :: this !< coupler_chksum_type + type(coupler_components_type), intent(in) :: components_obj !< coupler_components_type to be used + + this%components = components_obj + + end subroutine set_components_obj + !> This subroutine finalizes the run subroutine coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_boundary, Atmos_ice_boundary,& Atmos_land_boundary, Ice_ocean_boundary, Ocean_ice_boundary, Ocn_bc_restart, & @@ -1256,7 +1301,7 @@ subroutine coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_bounda type(FmsNetcdfDomainFile_t), dimension(:), pointer, intent(inout) :: Ice_bc_restart type(coupler_chksum_type), intent(in) :: coupler_chksum_obj - + type(FmsTime_type), intent(in) :: Time, Time_start, Time_end, Time_restart_current integer :: num_ice_bc_restart, num_ocn_bc_restart @@ -1428,7 +1473,7 @@ end subroutine coupler_restart subroutine get_coupler_chksums(this, id, timestep) implicit none - + class(coupler_chksum_type), intent(in) :: this !< self character(len=*), intent(in) :: id !< id to label CHECKSUMS in stdout integer , intent(in) :: timestep !< timestep @@ -1532,7 +1577,7 @@ subroutine get_atmos_ice_land_ocean_chksums(this, id, timestep) class(coupler_chksum_type), intent(in) :: this !< self character(len=*), intent(in) :: id !< ID labelling the set of checksums integer , intent(in) :: timestep !< timestep - + if (this%components%Atm%pe) then call fms_mpp_set_current_pelist(this%components%Atm%pelist) call this%get_atmos_ice_land_chksums(trim(id), timestep) @@ -1545,7 +1590,7 @@ subroutine get_atmos_ice_land_ocean_chksums(this, id, timestep) call fms_mpp_set_current_pelist() end subroutine get_atmos_ice_land_ocean_chksums - + !> \brief This subroutine calls subroutine that will print out checksums of the elements !! of the appropriate type. !! For coupled models typically these types are not defined on all processors. @@ -1920,7 +1965,7 @@ end subroutine coupler_exchange_slow_to_fast_ice !> \brief This subroutine calls exchange_fast_to_slow_ice. Clocks are set before and after the call. !! The current pelist is set if the optional argument set_ice_current_pelist is set to true. subroutine coupler_exchange_fast_to_slow_ice(Ice, coupler_clocks, set_ice_current_pelist) - + implicit none type(ice_data_type), intent(inout) :: Ice !< Ice type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks From 11964cb1a5f4272c88432c945c396649d42f3cc8 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 14 Jun 2024 10:41:40 -0400 Subject: [PATCH 17/24] change object int names to intialize --- full/full_coupler_mod.F90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index d1270db8..bcebce08 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -287,7 +287,7 @@ module full_coupler_mod type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary !< pointer to Ice_ocean_boundary type(ocean_ice_boundary_type), pointer :: Ocean_ice_boundary !< pointer to Ocean_ice_boundary contains - procedure, public :: coupler_components_obj_init + procedure, public :: initialize_coupler_components_obj procedure, public :: get_component !< subroutine to retrieve the requested component of an object of this type procedure, public :: set_component !< subroutine to set requested component of an object of this type end type coupler_components_type @@ -299,7 +299,7 @@ module full_coupler_mod private type(coupler_components_type), pointer :: components contains - procedure, public :: coupler_chksum_obj_init !< associates the pointers above to model components + procedure, public :: initialize_coupler_chksum_obj !< associates the pointers above to model components procedure, public :: get_components_obj !< subroutine to retrieve the requested component of an object of this type procedure, public :: set_components_obj !< subroutine to set components object procedure, public :: get_atmos_ice_land_ocean_chksums !< subroutine to compute chksums for atmos - ocean @@ -1127,11 +1127,11 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, !----------------------------------------------------------------------- !> Initialize coupler_components_obj memebers to point to model components - call coupler_components_obj%coupler_components_obj_init(Atm, Land, Ice, Ocean, Land_ice_atmos_boundary, & + call coupler_components_obj%initialize_coupler_components_obj(Atm, Land, Ice, Ocean, Land_ice_atmos_boundary,& Atmos_land_boundary, Atmos_ice_boundary, Land_ice_boundary, Ice_ocean_boundary, Ocean_ice_boundary) !> Initialize coupler_chksum_obj - call coupler_chksum_obj%coupler_chksum_obj_init(coupler_components_obj) + call coupler_chksum_obj%initialize_coupler_chksum_obj(coupler_components_obj) if ( do_endpoint_chksum ) then call coupler_chksum_obj%get_atmos_ice_land_ocean_chksums('coupler_init+', 0) @@ -1154,8 +1154,8 @@ end subroutine coupler_init !####################################################################### !> This subroutine associates the pointer in an object of coupler_components_type to the model components - subroutine coupler_components_obj_init(this, Atm, Land, Ice, Ocean, Land_ice_atmos_boundary, Atmos_land_boundary, & - Atmos_ice_boundary, Land_ice_boundary, Ice_ocean_boundary, Ocean_ice_boundary) + subroutine initialize_coupler_components_obj(this, Atm, Land, Ice, Ocean, Land_ice_atmos_boundary, & + Atmos_land_boundary, Atmos_ice_boundary, Land_ice_boundary, Ice_ocean_boundary, Ocean_ice_boundary) implicit none class(coupler_components_type), intent(inout) :: this !< self @@ -1181,7 +1181,7 @@ subroutine coupler_components_obj_init(this, Atm, Land, Ice, Ocean, Land_ice_atm this%Ice_ocean_boundary => Ice_ocean_boundary this%Ocean_ice_boundary => Ocean_ice_boundary - end subroutine coupler_components_obj_init + end subroutine initialize_coupler_components_obj !> Function get_component returns the requested component in the coupler_components_type object !! Users are required to provide the component to be retrieved as an input argument. For example, @@ -1246,7 +1246,7 @@ subroutine set_component(this, set_this_component ) end subroutine set_component !> This subroutine associates the pointer in an object of coupler_chksum_type to the component models - subroutine coupler_chksum_obj_init(this, components_obj) + subroutine initialize_coupler_chksum_obj(this, components_obj) implicit none class(coupler_chksum_type), intent(inout) :: this @@ -1254,7 +1254,7 @@ subroutine coupler_chksum_obj_init(this, components_obj) this%components = components_obj - end subroutine coupler_chksum_obj_init + end subroutine initialize_coupler_chksum_obj !> This subroutine retrieves coupler_chksum_obj%components_obj subroutine get_components_obj(this, components_obj) From 0f5c41fcd016dd80af6e490f0e955532f66c81fb Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 14 Jun 2024 11:04:32 -0400 Subject: [PATCH 18/24] test --- full/coupler_main.F90 | 12 ++++++++---- full/full_coupler_mod.F90 | 2 ++ 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 804bdcee..835b43fc 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -434,7 +434,9 @@ program coupler_main Time_step_cpld, Time_step_atmos, Time_atmos, Time_ocean, num_cpld_calls, & num_atmos_calls, Time, Time_start, Time_end, Time_restart, Time_restart_current) - if (do_chksum) call coupler_chksum_obj%get_coupler_chksums('coupler_init+', 0) + do_chksum = .True. + + !if (do_chksum) call coupler_chksum_obj%get_coupler_chksums('coupler_init+', 0) call fms_mpp_set_current_pelist() call fms_mpp_clock_end(coupler_clocks%initialization) !end initialization @@ -450,7 +452,7 @@ program coupler_main do nc = 1, num_cpld_calls if (do_chksum) then - call coupler_chksum_obj%get_coupler_chksums('top_of_coupled_loop+', nc) + !call coupler_chksum_obj%get_coupler_chksums('top_of_coupled_loop+', nc) call coupler_chksum_obj%get_atmos_ice_land_ocean_chksums('MAIN_LOOP-', nc) end if @@ -472,7 +474,7 @@ program coupler_main end if if (do_chksum) then - call coupler_chksum_obj%get_coupler_chksums('flux_ocn2ice+', nc) + !call coupler_chksum_obj%get_coupler_chksums('flux_ocn2ice+', nc) call coupler_chksum_obj%get_atmos_ice_land_ocean_chksums('flux_ocn2ice+', nc) end if @@ -802,7 +804,7 @@ program coupler_main endif !-------------- - if (do_chksum) call coupler_chksum_obj%get_coupler_chksums('MAIN_LOOP+', nc) + !if (do_chksum) call coupler_chksum_obj%get_coupler_chksums('MAIN_LOOP+', nc) write( text,'(a,i6)' )'Main loop at coupling timestep=', nc call fms_memutils_print_memuse_stats(text) outunit= fms_mpp_stdout() @@ -814,6 +816,8 @@ program coupler_main imb_sec(:)=0. call flush(outunit) + stop + enddo 102 FORMAT(A17,i5,A4,i5,A24,f10.4,A2,f10.4,A3,f10.4,A2,f10.4,A1) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index bcebce08..7a4b0b4f 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -1133,6 +1133,8 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, !> Initialize coupler_chksum_obj call coupler_chksum_obj%initialize_coupler_chksum_obj(coupler_components_obj) + do_chksum = .True. + if ( do_endpoint_chksum ) then call coupler_chksum_obj%get_atmos_ice_land_ocean_chksums('coupler_init+', 0) if (Ice%slow_ice_PE) then From 0d575812d0f2f70c6d3982940b387608708d6475 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 14 Jun 2024 11:43:42 -0400 Subject: [PATCH 19/24] remove pointer --- full/full_coupler_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 7a4b0b4f..ae20d9f2 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -297,7 +297,7 @@ module full_coupler_mod !! The members of this type point to the model components type coupler_chksum_type private - type(coupler_components_type), pointer :: components + type(coupler_components_type) :: components contains procedure, public :: initialize_coupler_chksum_obj !< associates the pointers above to model components procedure, public :: get_components_obj !< subroutine to retrieve the requested component of an object of this type From f8ac255d7af3ace270407d7e966554f1ffed5e01 Mon Sep 17 00:00:00 2001 From: MiKyung Lee <58964324+mlee03@users.noreply.github.com> Date: Fri, 14 Jun 2024 13:42:58 -0400 Subject: [PATCH 20/24] Update full_coupler_mod.F90 --- full/full_coupler_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index bcebce08..8a4758cd 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -297,7 +297,7 @@ module full_coupler_mod !! The members of this type point to the model components type coupler_chksum_type private - type(coupler_components_type), pointer :: components + type(coupler_components_type) :: components contains procedure, public :: initialize_coupler_chksum_obj !< associates the pointers above to model components procedure, public :: get_components_obj !< subroutine to retrieve the requested component of an object of this type From caad35db9d1f6671c28dc0701e4ddcef3e4e4828 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 14 Jun 2024 15:16:55 -0400 Subject: [PATCH 21/24] test --- full/full_coupler_mod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index ae20d9f2..248fa3af 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -297,7 +297,7 @@ module full_coupler_mod !! The members of this type point to the model components type coupler_chksum_type private - type(coupler_components_type) :: components + type(coupler_components_type), pointer :: components contains procedure, public :: initialize_coupler_chksum_obj !< associates the pointers above to model components procedure, public :: get_components_obj !< subroutine to retrieve the requested component of an object of this type @@ -1252,9 +1252,9 @@ subroutine initialize_coupler_chksum_obj(this, components_obj) implicit none class(coupler_chksum_type), intent(inout) :: this - type(coupler_components_type), intent(in) :: components_obj + type(coupler_components_type), target, intent(in) :: components_obj - this%components = components_obj + this%components => components_obj end subroutine initialize_coupler_chksum_obj From 5243119085ecc5b95118a89e5ed7d96de26607b4 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 14 Jun 2024 15:20:50 -0400 Subject: [PATCH 22/24] test --- full/full_coupler_mod.F90 | 51 +++------------------------------------ 1 file changed, 3 insertions(+), 48 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 8a4758cd..dbdd4ded 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -289,7 +289,6 @@ module full_coupler_mod contains procedure, public :: initialize_coupler_components_obj procedure, public :: get_component !< subroutine to retrieve the requested component of an object of this type - procedure, public :: set_component !< subroutine to set requested component of an object of this type end type coupler_components_type !> The purpose of objects of coupler_chksum_type is to simplify the list @@ -297,11 +296,10 @@ module full_coupler_mod !! The members of this type point to the model components type coupler_chksum_type private - type(coupler_components_type) :: components + type(coupler_components_type), pointer :: components contains procedure, public :: initialize_coupler_chksum_obj !< associates the pointers above to model components procedure, public :: get_components_obj !< subroutine to retrieve the requested component of an object of this type - procedure, public :: set_components_obj !< subroutine to set components object procedure, public :: get_atmos_ice_land_ocean_chksums !< subroutine to compute chksums for atmos - ocean procedure, public :: get_atmos_ice_land_chksums !< subroutine to compute chksums for atmos_ice_land procedure, public :: get_slow_ice_chksums !< subroutine to compute chskums for slow_ice @@ -1214,45 +1212,14 @@ subroutine get_component(this, retrieve_component ) end subroutine get_component - !> Function set_component sets the requested component in the coupler_components_type object - !! Users are required to provide the component to be set as an input argument. For example, - !! coupler_components_obj%get_component(Atm) will set coupler_components_obj%Atm = Atm - subroutine set_component(this, set_this_component ) - - implicit none - class(coupler_components_type), intent(inout) :: this !< the coupler_components_type object - class(*), intent(in) :: set_this_component !< requested component to be be set. - !! set_this_component can be of type atmos_data_type, land_data_type, ice_data_type, - !! ocean_public_type, land_ice_atmos_boundary_type, atmos_land_boundary_type, - !! atmos_ice_boundary_type, land_ice_boundary_type, ice_ocean_boundary_type, - !! ocean_ice_boundary_type - - select type(set_this_component) - type is(atmos_data_type) ; this%Atm = set_this_component - type is(land_data_type) ; this%Land = set_this_component - type is(ice_data_type) ; this%Ice = set_this_component - type is(ocean_public_type) ; this%Ocean = set_this_component - type is(land_ice_atmos_boundary_type) ; this%Land_ice_atmos_boundary = set_this_component - type is(atmos_land_boundary_type) ; this%Atmos_land_boundary = set_this_component - type is(atmos_ice_boundary_type) ; this%Atmos_ice_boundary = set_this_component - type is(land_ice_boundary_type) ; this%Land_ice_boundary = set_this_component - type is(ice_ocean_boundary_type) ; this%Ice_ocean_boundary = set_this_component - type is(ocean_ice_boundary_type) ; this%Ocean_ice_boundary = set_this_component - class default - call fms_mpp_error(FATAL, "failure setting component in coupler_components_type object, & - cannot recognize the type of requested component") - end select - - end subroutine set_component - !> This subroutine associates the pointer in an object of coupler_chksum_type to the component models subroutine initialize_coupler_chksum_obj(this, components_obj) implicit none class(coupler_chksum_type), intent(inout) :: this - type(coupler_components_type), intent(in) :: components_obj + type(coupler_components_type), intent(in), target :: components_obj - this%components = components_obj + this%components => components_obj end subroutine initialize_coupler_chksum_obj @@ -1268,18 +1235,6 @@ subroutine get_components_obj(this, components_obj) end subroutine get_components_obj - !> This subroutine set coupler_chksum_obj%components_obj - subroutine set_components_obj(this, components_obj) - - implicit none - - class(coupler_chksum_type), intent(inout) :: this !< coupler_chksum_type - type(coupler_components_type), intent(in) :: components_obj !< coupler_components_type to be used - - this%components = components_obj - - end subroutine set_components_obj - !> This subroutine finalizes the run subroutine coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_boundary, Atmos_ice_boundary,& Atmos_land_boundary, Ice_ocean_boundary, Ocean_ice_boundary, Ocn_bc_restart, & From 50008425f52f428edd26be0381fa316572575175 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Mon, 17 Jun 2024 07:17:47 -0400 Subject: [PATCH 23/24] test with pointers --- full/coupler_main.F90 | 2 +- full/full_coupler_mod.F90 | 45 --------------------------------------- 2 files changed, 1 insertion(+), 46 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 835b43fc..3449a23a 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -373,7 +373,7 @@ program coupler_main character(len=32) :: timestamp type(coupler_clock_type) :: coupler_clocks - type(coupler_components_type) :: coupler_components_obj + type(coupler_components_type), target :: coupler_components_obj type(coupler_chksum_type) :: coupler_chksum_obj integer :: outunit diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 248fa3af..b011ed69 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -289,7 +289,6 @@ module full_coupler_mod contains procedure, public :: initialize_coupler_components_obj procedure, public :: get_component !< subroutine to retrieve the requested component of an object of this type - procedure, public :: set_component !< subroutine to set requested component of an object of this type end type coupler_components_type !> The purpose of objects of coupler_chksum_type is to simplify the list @@ -301,7 +300,6 @@ module full_coupler_mod contains procedure, public :: initialize_coupler_chksum_obj !< associates the pointers above to model components procedure, public :: get_components_obj !< subroutine to retrieve the requested component of an object of this type - procedure, public :: set_components_obj !< subroutine to set components object procedure, public :: get_atmos_ice_land_ocean_chksums !< subroutine to compute chksums for atmos - ocean procedure, public :: get_atmos_ice_land_chksums !< subroutine to compute chksums for atmos_ice_land procedure, public :: get_slow_ice_chksums !< subroutine to compute chskums for slow_ice @@ -1216,37 +1214,6 @@ subroutine get_component(this, retrieve_component ) end subroutine get_component - !> Function set_component sets the requested component in the coupler_components_type object - !! Users are required to provide the component to be set as an input argument. For example, - !! coupler_components_obj%get_component(Atm) will set coupler_components_obj%Atm = Atm - subroutine set_component(this, set_this_component ) - - implicit none - class(coupler_components_type), intent(inout) :: this !< the coupler_components_type object - class(*), intent(in) :: set_this_component !< requested component to be be set. - !! set_this_component can be of type atmos_data_type, land_data_type, ice_data_type, - !! ocean_public_type, land_ice_atmos_boundary_type, atmos_land_boundary_type, - !! atmos_ice_boundary_type, land_ice_boundary_type, ice_ocean_boundary_type, - !! ocean_ice_boundary_type - - select type(set_this_component) - type is(atmos_data_type) ; this%Atm = set_this_component - type is(land_data_type) ; this%Land = set_this_component - type is(ice_data_type) ; this%Ice = set_this_component - type is(ocean_public_type) ; this%Ocean = set_this_component - type is(land_ice_atmos_boundary_type) ; this%Land_ice_atmos_boundary = set_this_component - type is(atmos_land_boundary_type) ; this%Atmos_land_boundary = set_this_component - type is(atmos_ice_boundary_type) ; this%Atmos_ice_boundary = set_this_component - type is(land_ice_boundary_type) ; this%Land_ice_boundary = set_this_component - type is(ice_ocean_boundary_type) ; this%Ice_ocean_boundary = set_this_component - type is(ocean_ice_boundary_type) ; this%Ocean_ice_boundary = set_this_component - class default - call fms_mpp_error(FATAL, "failure setting component in coupler_components_type object, & - cannot recognize the type of requested component") - end select - - end subroutine set_component - !> This subroutine associates the pointer in an object of coupler_chksum_type to the component models subroutine initialize_coupler_chksum_obj(this, components_obj) @@ -1270,18 +1237,6 @@ subroutine get_components_obj(this, components_obj) end subroutine get_components_obj - !> This subroutine set coupler_chksum_obj%components_obj - subroutine set_components_obj(this, components_obj) - - implicit none - - class(coupler_chksum_type), intent(inout) :: this !< coupler_chksum_type - type(coupler_components_type), intent(in) :: components_obj !< coupler_components_type to be used - - this%components = components_obj - - end subroutine set_components_obj - !> This subroutine finalizes the run subroutine coupler_end(Atm, Land, Ice, Ocean, Ocean_state, Land_ice_atmos_boundary, Atmos_ice_boundary,& Atmos_land_boundary, Ice_ocean_boundary, Ocean_ice_boundary, Ocn_bc_restart, & From b0b4c05fed45f21b7c0f0d9285127ed3e468021b Mon Sep 17 00:00:00 2001 From: mlee03 Date: Mon, 17 Jun 2024 07:25:29 -0400 Subject: [PATCH 24/24] undo test settings --- full/coupler_main.F90 | 2 -- full/full_coupler_mod.F90 | 2 -- 2 files changed, 4 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 212b16a4..3ff7deb5 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -814,8 +814,6 @@ program coupler_main imb_sec(:)=0. call flush(outunit) - stop - enddo 102 FORMAT(A17,i5,A4,i5,A24,f10.4,A2,f10.4,A3,f10.4,A2,f10.4,A1) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 3f4f308f..dbdd4ded 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -1131,8 +1131,6 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, !> Initialize coupler_chksum_obj call coupler_chksum_obj%initialize_coupler_chksum_obj(coupler_components_obj) - do_chksum = .True. - if ( do_endpoint_chksum ) then call coupler_chksum_obj%get_atmos_ice_land_ocean_chksums('coupler_init+', 0) if (Ice%slow_ice_PE) then