From b0f4c626972b60c77de966378726a977128e4082 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Mon, 10 Jun 2024 14:18:04 -0400 Subject: [PATCH 01/38] 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/38] 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/38] 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/38] 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/38] 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/38] 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/38] 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 066bd3388d31ab965737bb5e26abf0070e138261 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 12 Jun 2024 07:46:11 -0400 Subject: [PATCH 08/38] coupler_update_atmos_model_dynamics --- full/coupler_main.F90 | 14 ++++---------- full/full_coupler_mod.F90 | 33 +++++++++++++++++++++++++++------ 2 files changed, 31 insertions(+), 16 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index b3094226..fd032d8f 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -535,7 +535,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,21 +545,15 @@ 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() if (do_concurrent_radiation) call fms_mpp_clock_begin(coupler_clocks%concurrent_atmos) ! ---- atmosphere dynamics ---- - if (do_atmos) then - call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_dynamics) - 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, & - Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - if (do_debug) call fms_memutils_print_memuse_stats( 'update dyn') + if (do_atmos) call coupler_update_atmos_model_dynamics(Atm, current_timestep, & + coupler_chksum_obj, coupler_clocks) ! ---- SERIAL atmosphere radiation ---- if (.not.do_concurrent_radiation) then diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index a74c9623..a24054aa 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -1934,28 +1934,49 @@ 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_time_step, coupler_chksum_obj, coupler_clocks) + Time_atmos, current_timestep, coupler_chksum_obj, 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(FmsTime_type), intent(in) :: Time_atmos !< Atmos time - integer, intent(in) :: current_time_step !< (nc-1)*num_atmos_cal + na + type(FmsTime_type), intent(in) :: Time_atmos !< Atmos time + integer, intent(in) :: current_timestep !< (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 ) - 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, & + if (do_chksum) call atmos_ice_land_chksum('sfc+', current_timestep, 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 - + + !> This subroutine calls update_atmos_model_dynamics. Clocks are set for runtime statistics. Chksums + !! and memory usage are computed if do_chksum and do_debug are .True. + subroutine coupler_update_atmos_model_dynamics(Atm, current_timestep, coupler_chksum_obj, coupler_clocks) + + implicit none + type(atmos_data_type), intent(inout) :: Atm !< Atm + integer, intent(in) :: current_timestep !< Current timestep + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< coupler_chksum_obj pointing to component types + type(coupler_clock_type), intent(in) :: coupler_clocks !< coupler_clocks + + call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_dynamics) + call update_atmos_model_dynamics(Atm) + call fms_mpp_clock_end(coupler_clocks%update_atmos_model_dynamics) + + if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_dynamics', current_timestep, & + Atm, coupler_chksum_obj%Land, coupler_chksum_obj%Ice, coupler_chksum_obj%Land_ice_atmos_boundary, & + coupler_chksum_obj%Atmos_ice_boundary, coupler_chksum_obj%Atmos_land_boundary) + + if (do_debug) call fms_memutils_print_memuse_stats( 'update dyn') + + end subroutine coupler_update_atmos_model_dynamics end module full_coupler_mod From 29c59ea1f906701279a82655c84b62c75b1b589c Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 12 Jun 2024 08:12:42 -0400 Subject: [PATCH 09/38] coupler_update_atmos_model_dynamics coupler_update_atmos_model_radiation coupler_update_atmos_model_down coupler_flux_down_from_atmos --- full/coupler_main.F90 | 48 +++++++--------------- full/full_coupler_mod.F90 | 84 ++++++++++++++++++++++++++++++++++++--- 2 files changed, 94 insertions(+), 38 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index fd032d8f..99100ff0 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -436,11 +436,10 @@ program coupler_main call fms_mpp_set_current_pelist() call fms_mpp_clock_end(coupler_clocks%initialization) !end initialization - - call fms_mpp_clock_begin(coupler_clocks%main) !begin main loop + call fms_mpp_clock_begin(coupler_clocks%main) !begin main loop !----------------------------------------------------------------------- -!------ ocean/slow-ice integration loop ------ +!> ocean/slow-ice integration loop if (check_stocks >= 0) call coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, & coupler_clocks, init_stocks=.True.) @@ -510,7 +509,7 @@ program coupler_main call send_ice_mask_sic(Time) !----------------------------------------------------------------------- - ! ------ atmos/fast-land/fast-ice integration loop ------- + !> atmos/fast-land/fast-ice integration loop call fms_mpp_clock_begin(coupler_clocks%atmos_loop) do na = 1, num_atmos_calls @@ -551,38 +550,21 @@ program coupler_main if (do_concurrent_radiation) call fms_mpp_clock_begin(coupler_clocks%concurrent_atmos) - ! ---- atmosphere dynamics ---- + !> atmosphere dynamics if (do_atmos) call coupler_update_atmos_model_dynamics(Atm, current_timestep, & coupler_chksum_obj, coupler_clocks) - ! ---- SERIAL atmosphere radiation ---- - if (.not.do_concurrent_radiation) then - call fms_mpp_clock_begin(coupler_clocks%serial_radiation) - 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, & - Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - if (do_debug) call fms_memutils_print_memuse_stats( 'update serial rad') - - ! ---- atmosphere down ---- - if (do_atmos) then - call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_down) - 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_debug) call fms_memutils_print_memuse_stats( 'update down') - - call fms_mpp_clock_begin(coupler_clocks%flux_down_from_atmos) - call flux_down_from_atmos( Time_atmos, Atm, Land, Ice, & - Land_ice_atmos_boundary, & - 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) + !> SERIAL atmosphere radiation + if (.not.do_concurrent_radiation) call coupler_update_atmos_model_radiation(Atm, Land_ice_atmos_boundary, & + current_timestep, coupler_chksum_obj, coupler_clocks) + + !> atmosphere down + if (do_atmos) call coupler_update_atmos_model_down(Atm, Land_ice_atmos_boundary, & + current_timestep, coupler_chksum_obj, coupler_clocks) + + !> checksums are computed if do_chksum=.True. + call coupler_flux_down_from_atmos(Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, & + Atmos_ice_boundary, Time_atmos, current_timestep, coupler_clocks) ! -------------------------------------------------------------- ! ---- land model ---- diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index a24054aa..c58f4375 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -96,7 +96,6 @@ module full_coupler_mod public :: land_ice_boundary_type, ice_ocean_boundary_type, ocean_ice_boundary_type, ice_ocean_driver_type public :: fmsconstants_init - public :: update_atmos_model_dynamics, update_atmos_model_down, update_atmos_model_up public :: update_atmos_model_radiation, update_atmos_model_state public :: update_land_model_fast, update_land_model_slow public :: update_ice_model_fast, set_ice_surface_fields @@ -104,7 +103,7 @@ module full_coupler_mod public :: update_ice_model_slow public :: update_ocean_model, update_slow_ice_and_ocean public :: send_ice_mask_sic - public :: flux_down_from_atmos, flux_up_to_atmos + public :: 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 @@ -132,7 +131,9 @@ module full_coupler_mod public :: coupler_generate_sfc_xgrid public :: coupler_atmos_tracer_driver_gather_data, coupler_sfc_boundary_layer - + public :: coupler_update_atmos_model_dynamics, coupler_update_atmos_model_down + public :: coupler_update_atmos_model_up, coupler_flux_down_from_atmos, + public :: coupler_clock_type, coupler_chksum_type #include @@ -1963,9 +1964,9 @@ subroutine coupler_update_atmos_model_dynamics(Atm, current_timestep, coupler_ch implicit none type(atmos_data_type), intent(inout) :: Atm !< Atm - integer, intent(in) :: current_timestep !< Current timestep + integer, intent(in) :: current_timestep !< Current timestep type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< coupler_chksum_obj pointing to component types - type(coupler_clock_type), intent(in) :: coupler_clocks !< coupler_clocks + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_dynamics) call update_atmos_model_dynamics(Atm) @@ -1978,5 +1979,78 @@ subroutine coupler_update_atmos_model_dynamics(Atm, current_timestep, coupler_ch if (do_debug) call fms_memutils_print_memuse_stats( 'update dyn') end subroutine coupler_update_atmos_model_dynamics + + !> This subroutine calls update_atmos_model_radiation. Clocks are set for runtime statistics. Chksums + !! and memory usage are computed if do_chksum and do_debug are .True. + subroutine coupler_update_atmos_model_radiation(Atm, Land_ice_atmos_boundary, current_timestep, & + coupler_chksum_obj, coupler_clocks) + + implicit none + + type(atmos_data_type), intent(inout) :: Atm + type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary + integer, intent(in) :: current_timestep !< Current timestep + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< coupler_chksum_obj pointing to component types + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + + call fms_mpp_clock_begin(coupler_clocks%serial_radiation) + call update_atmos_model_radiation( Land_ice_atmos_boundary, Atm ) + call fms_mpp_clock_end(coupler_clocks%serial_radiation) + + if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_radiation(ser)', current_timestep, & + Atm, coupler_chksum_obj%Land, coupler_chksum_obj%Ice, Land_ice_atmos_boundary, & + coupler_chksum_obj%Atmos_ice_boundary, coupler_chksum_obj%Atmos_land_boundary) + + if (do_debug) call fms_memutils_print_memuse_stats( 'update serial rad') + + end subroutine coupler_update_atmos_model_radiation + + !> This subroutine calls update_atmos_model_down. Clocks are set for runtime statistics. Chksums + !! and memory usage are computed if do_chksum and do_debug are .True. + subroutine coupler_update_atmos_model_down(Atm, Land_ice_atmos_boundary, current_timestep, & + coupler_chksum_obj, coupler_clocks) + + implicit none + type(atmos_data_type), intent(inout) :: Atm !< Atm + type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary ! This subroutine calls flux_down_from_atmos. Clocks are set for runtime statistics. Chksums + !! are computed if do_chksum = .True. + subroutine coupler_flux_down_from_atmos(Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, Atmos_ice_boundary,& + Time_atmos, current_timestep, coupler_clocks) + + implicit none + type(atmos_data_type), intent(inout) :: Atm !< Atm + type(land_data_type), intent(inout) :: Land !< Land + type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary !< Land_ice_atmos_boundary + type(atmos_land_boundary_type), intent(inout) :: Atmos_ice_boundary !< Atmos_ice_boundary + type(FmsTime_type), intent(in) :: Time_atmos ! Date: Wed, 12 Jun 2024 09:09:38 -0400 Subject: [PATCH 10/38] mistakes with concurrent radiation --- full/coupler_main.F90 | 16 +++--------- full/full_coupler_mod.F90 | 55 +++++++++++++++++++++++---------------- 2 files changed, 37 insertions(+), 34 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 99100ff0..3a2fe841 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -534,7 +534,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, coupler_chksum_obj, current_timestep) !$ if (omp_get_thread_num() == 0) then !$OMP PARALLEL & !$OMP& NUM_THREADS(1) & @@ -544,7 +544,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, coupler_chksum_obj, current_timestep) !$ call omp_set_num_threads(atmos_nthreads) !$ dsec=omp_get_wtime() @@ -556,7 +556,7 @@ program coupler_main !> SERIAL atmosphere radiation if (.not.do_concurrent_radiation) call coupler_update_atmos_model_radiation(Atm, Land_ice_atmos_boundary, & - current_timestep, coupler_chksum_obj, coupler_clocks) + coupler_clocks, current_timestep, coupler_chksum_obj) !> atmosphere down if (do_atmos) call coupler_update_atmos_model_down(Atm, Land_ice_atmos_boundary, & @@ -629,16 +629,8 @@ program coupler_main !$OMP& SHARED(coupler_clocks) !$ call omp_set_num_threads(radiation_nthreads) !$ dsec=omp_get_wtime() - - call fms_mpp_clock_begin(coupler_clocks%concurrent_radiation) - call update_atmos_model_radiation( Land_ice_atmos_boundary, Atm ) - call fms_mpp_clock_end(coupler_clocks%concurrent_radiation) + call coupler_update_atmos_model_radiation(Atm, Land_ice_atmos_boundary, coupler_clocks) !$ omp_sec(2) = omp_sec(2) + (omp_get_wtime() - dsec) -!---CANNOT PUT AN MPP_CHKSUM HERE AS IT REQUIRES THE ABILITY TO HAVE TWO DIFFERENT OPENMP THREADS -!---INSIDE OF MPI AT THE SAME TIME WHICH IS NOT CURRENTLY ALLOWED -! if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_radiation(conc)', (nc-1)*num_atmos_calls+na, & -! Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - if (do_debug) call fms_memutils_print_memuse_stats( 'update concurrent rad') !$OMP END PARALLEL endif !$ endif diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index c58f4375..793b5817 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -96,7 +96,7 @@ module full_coupler_mod public :: land_ice_boundary_type, ice_ocean_boundary_type, ocean_ice_boundary_type, ice_ocean_driver_type public :: fmsconstants_init - public :: update_atmos_model_radiation, update_atmos_model_state + public :: update_atmos_model_state, update_atmos_model_up public :: update_land_model_fast, update_land_model_slow public :: update_ice_model_fast, set_ice_surface_fields public :: ice_model_fast_cleanup, unpack_land_ice_boundary @@ -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_update_atmos_model_dynamics, coupler_update_atmos_model_down - public :: coupler_update_atmos_model_up, coupler_flux_down_from_atmos, + public :: coupler_update_atmos_model_radiation, coupler_flux_down_from_atmos public :: coupler_clock_type, coupler_chksum_type @@ -247,14 +247,13 @@ module full_coupler_mod integer :: atmos_tracer_driver_gather_data integer :: sfc_boundary_layer integer :: update_atmos_model_dynamics - integer :: serial_radiation integer :: update_atmos_model_down integer :: flux_down_from_atmos integer :: update_land_model_fast integer :: update_ice_model_fast integer :: flux_up_to_atmos integer :: update_atmos_model_up - integer :: concurrent_radiation + integer :: radiation integer :: concurrent_atmos integer :: update_atmos_model_state integer :: update_land_model_slow @@ -1627,7 +1626,7 @@ subroutine coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble coupler_clocks%sfc_boundary_layer = fms_mpp_clock_id( ' A-L: sfc_boundary_layer' ) coupler_clocks%update_atmos_model_dynamics = fms_mpp_clock_id( ' A-L: update_atmos_model_dynamics') if (.not. do_concurrent_radiation) & - coupler_clocks%serial_radiation = fms_mpp_clock_id( ' A-L: serial radiation' ) + coupler_clocks%radiation = fms_mpp_clock_id( ' A-L: serial radiation' ) coupler_clocks%update_atmos_model_down = fms_mpp_clock_id( ' A-L: update_atmos_model_down' ) coupler_clocks%flux_down_from_atmos = fms_mpp_clock_id( ' A-L: flux_down_from_atmos' ) coupler_clocks%update_land_model_fast = fms_mpp_clock_id( ' A-L: update_land_model_fast' ) @@ -1635,7 +1634,7 @@ subroutine coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble coupler_clocks%flux_up_to_atmos = fms_mpp_clock_id( ' A-L: flux_up_to_atmos' ) coupler_clocks%update_atmos_model_up = fms_mpp_clock_id( ' A-L: update_atmos_model_up' ) if (do_concurrent_radiation) then - coupler_clocks%concurrent_radiation = fms_mpp_clock_id( ' A-L: concurrent radiation' ) + coupler_clocks%radiation = fms_mpp_clock_id( ' A-L: concurrent radiation' ) coupler_clocks%concurrent_atmos = fms_mpp_clock_id( ' A-L: concurrent atmos' ) endif coupler_clocks%update_atmos_model_state = fms_mpp_clock_id( ' A-L: update_atmos_model_state') @@ -1980,28 +1979,38 @@ subroutine coupler_update_atmos_model_dynamics(Atm, current_timestep, coupler_ch end subroutine coupler_update_atmos_model_dynamics - !> This subroutine calls update_atmos_model_radiation. Clocks are set for runtime statistics. Chksums - !! and memory usage are computed if do_chksum and do_debug are .True. - subroutine coupler_update_atmos_model_radiation(Atm, Land_ice_atmos_boundary, current_timestep, & - coupler_chksum_obj, coupler_clocks) + !> This subroutine calls update_atmos_model_radiation. Clocks are set for runtime statistics. + !! Chksums are computed if do_chksum is .True. and do_concurrent_radiation is .False.. Memory + !! usage is computed if do_debug is .True. + subroutine coupler_update_atmos_model_radiation(Atm, Land_ice_atmos_boundary, coupler_clocks, & + current_timestep, coupler_chksum_obj) implicit none type(atmos_data_type), intent(inout) :: Atm type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary - integer, intent(in) :: current_timestep !< Current timestep - type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< coupler_chksum_obj pointing to component types - type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + integer, optional, intent(in) :: current_timestep !< Current timestep + type(coupler_chksum_type), optional, intent(in) :: coupler_chksum_obj !< points to component types - call fms_mpp_clock_begin(coupler_clocks%serial_radiation) + character(128) :: memuse_stats_id = 'update serial rad' + + call fms_mpp_clock_begin(coupler_clocks%radiation) call update_atmos_model_radiation( Land_ice_atmos_boundary, Atm ) - call fms_mpp_clock_end(coupler_clocks%serial_radiation) - - if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_radiation(ser)', current_timestep, & - Atm, coupler_chksum_obj%Land, coupler_chksum_obj%Ice, Land_ice_atmos_boundary, & - coupler_chksum_obj%Atmos_ice_boundary, coupler_chksum_obj%Atmos_land_boundary) - - if (do_debug) call fms_memutils_print_memuse_stats( 'update serial rad') + call fms_mpp_clock_end(coupler_clocks%radiation) + + if(do_chksum) then + !> cannot put mpp_chksum for concurrent_radiation as it requires the ability to have two different OpenMP threads + !! inside of MPI at the same time which is not currently allowed + if(.not.do_concurrent_radiation) call atmos_ice_land_chksum('update_atmos_model_radiation(ser)',current_timestep,& + Atm, coupler_chksum_obj%Land, coupler_chksum_obj%Ice, Land_ice_atmos_boundary, & + coupler_chksum_obj%Atmos_ice_boundary, coupler_chksum_obj%Atmos_land_boundary) + end if + + if (do_debug) then + if(do_concurrent_radiation) memuse_stats_id = 'update concurrent rad' + call fms_memutils_print_memuse_stats(trim(memuse_stats_id)) + end if end subroutine coupler_update_atmos_model_radiation @@ -2037,8 +2046,10 @@ subroutine coupler_flux_down_from_atmos(Atm, Land, Ice, Land_ice_atmos_boundary, 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 type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary !< Land_ice_atmos_boundary - type(atmos_land_boundary_type), intent(inout) :: Atmos_ice_boundary !< Atmos_ice_boundary + type(atmos_land_boundary_type), intent(inout) :: Atmos_land_boundary !< Atmos_land_boundary + type(atmos_ice_boundary_type), intent(inout) :: Atmos_ice_boundary !< Atmos_ice_boundary type(FmsTime_type), intent(in) :: Time_atmos ! Date: Wed, 12 Jun 2024 09:49:54 -0400 Subject: [PATCH 11/38] update_land_model_fast update_ice_model_fast coupler_flux_up_to_atmos coupler_update_atmos_model_up coupler_flux_atmos_to_ocean --- full/coupler_main.F90 | 58 +++++------------ full/full_coupler_mod.F90 | 127 ++++++++++++++++++++++++++++++++++++-- 2 files changed, 138 insertions(+), 47 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 3a2fe841..0af41fc3 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -509,6 +509,7 @@ program coupler_main call send_ice_mask_sic(Time) !----------------------------------------------------------------------- + !> atmos/fast-land/fast-ice integration loop call fms_mpp_clock_begin(coupler_clocks%atmos_loop) @@ -566,51 +567,26 @@ program coupler_main call coupler_flux_down_from_atmos(Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, & Atmos_ice_boundary, Time_atmos, current_timestep, coupler_clocks) - ! -------------------------------------------------------------- - ! ---- land model ---- - call fms_mpp_clock_begin(coupler_clocks%update_land_model_fast) - if (do_land .AND. land%pe) then - if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Land%pelist) - call update_land_model_fast( Atmos_land_boundary, Land ) - 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_debug) call fms_memutils_print_memuse_stats( 'update land') + !-------------------------------------------------------------- - ! ---- ice model ---- - call fms_mpp_clock_begin(coupler_clocks%update_ice_model_fast) - if (do_ice .AND. Ice%fast_ice_pe) then - if (ice_npes .NE. atmos_npes)call fms_mpp_set_current_pelist(Ice%fast_pelist) - call update_ice_model_fast( Atmos_ice_boundary, Ice ) - 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_debug) call fms_memutils_print_memuse_stats( 'update ice') - - ! -------------------------------------------------------------- - ! ---- atmosphere up ---- - call fms_mpp_clock_begin(coupler_clocks%flux_up_to_atmos) - 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) + !> land model + if (do_land .AND. land%pe) call update_land_model_fast(Land, Atmos_land_boundary, current_timestep,& + coupler_chksum_obj, coupler_clocks) - 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_debug) call fms_memutils_print_memuse_stats( 'update up') + !> ice model + if (do_ice .AND. Ice%fast_ice_pe) call update_ice_model_fast(Ice, Atmos_ice_boundary, current_timestep,& + coupler_chksum_obj, coupler_clocks) + + !-------------------------------------------------------------- - call flux_atmos_to_ocean(Time_atmos, Atm, Atmos_ice_boundary, Ice) + !> atmosphere up + call coupler_flux_up_to_atmos(Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, Atmos_ice_boundary,& + Time_atmos, current_timestep, coupler_chksum_obj, coupler_clocks) + + if (do_atmos) call coupler_update_atmos_model_up(Atm, Land_ice_atmos_boundary, current_timestep, & + coupler_chksum_obj, coupler_clocks) - call flux_ex_arrays_dealloc + call coupler_flux_atmos_to_ocean(Atm, Atmos_ice_boundary, Ice, Time_atmos) !-------------- if (do_concurrent_radiation) call fms_mpp_clock_end(coupler_clocks%concurrent_atmos) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 793b5817..6a5ad8a4 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -96,18 +96,16 @@ module full_coupler_mod public :: land_ice_boundary_type, ice_ocean_boundary_type, ocean_ice_boundary_type, ice_ocean_driver_type public :: fmsconstants_init - public :: update_atmos_model_state, update_atmos_model_up - public :: update_land_model_fast, update_land_model_slow - public :: update_ice_model_fast, set_ice_surface_fields + public :: update_atmos_model_state + public :: update_land_model_slow + public :: set_ice_surface_fields public :: ice_model_fast_cleanup, unpack_land_ice_boundary public :: update_ice_model_slow public :: update_ocean_model, update_slow_ice_and_ocean public :: send_ice_mask_sic - public :: 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_model_restart, land_model_restart, ice_model_restart, ocean_model_restart @@ -133,7 +131,10 @@ module full_coupler_mod public :: coupler_atmos_tracer_driver_gather_data, coupler_sfc_boundary_layer public :: coupler_update_atmos_model_dynamics, coupler_update_atmos_model_down public :: coupler_update_atmos_model_radiation, coupler_flux_down_from_atmos - + public :: coupler_update_land_model_fast, coupler_update_ice_model_fast + public :: coupler_flux_up_to_atmos, coupler_update_atmos_model_up + public :: coupler_flux_atmos_to_ocean + public :: coupler_clock_type, coupler_chksum_type #include @@ -2063,5 +2064,119 @@ subroutine coupler_flux_down_from_atmos(Atm, Land, Ice, Land_ice_atmos_boundary, Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) end subroutine coupler_flux_down_from_atmos + + !> This subroutine calls update_land_model_fast. Clocks are set for runtime statistics. Chksums + !! and memory usage are computed if do_chksum and do_debug are .True. + subroutine coupler_update_land_model_fast(Land, Atmos_land_boundary, current_timestep, coupler_chksum_obj, coupler_clocks) + + implicit none + type(land_data_type), intent(inout) :: Land !< Land + type(atmos_land_boundary), intent(inout) :: Atmos_land_boundary !< Atmos_land_boundary + integer, intent(in) :: current_timestep !< current timestep + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< points to component types + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + + call fms_mpp_clock_begin(coupler_clocks%update_land_model_fast) !< current pelist=Atm%pelist + if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Land%pelist) + + call update_land_model_fast( Atmos_land_boundary, Land ) + + 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+', current_timestep, coupler_chksum_obj%Atm, Land, & + coupler_chksum_obj%Ice, coupler_chksum_obj%Land_ice_atmos_boundary, coupler_chksum_obj%Atmos_ice_boundary, & + coupler_chksum_obj%Atmos_land_boundary) + if (do_debug) call fms_memutils_print_memuse_stats( 'update land') + + end subroutine coupler_update_land_model_fast + + !> This subroutine calls update_ice_model_fast. Clocks are set for runtime statistics. Chksums + !! and memory usage are computed if do_chksum and do_debug are .True. + subroutine coupler_update_ice_model_fast(Ice, Atmos_ice_boundary, current_timestep, coupler_chksum_obj, coupler_clocks) + + implicit none + type(ice_data_type), intent(inout) :: Ice !< Ice + type(Atmos_ice_boundary), intent(inout) :: Atmos_ice_boundary !< Atmos_ice_boundary + integer, intent(in) :: current_timestep !< current_timestep + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< points to component types + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + + call fms_mpp_clock_begin(coupler_clocks%update_ice_model_fast) !< current pelist = Atm%pelist + if (ice_npes .NE. atmos_npes)call fms_mpp_set_current_pelist(Ice%fast_pelist) + + call update_ice_model_fast( Atmos_ice_boundary, Ice ) + + 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+', current_timestep, coupler_chksum_obj%Atm,& + coupler_chksum_obj%Land, Ice, coupler_chksum_obj%Land_ice_atmos_boundary, & + coupler_chksum_obj%Atmos_ice_boundary, coupler_chksum_obj%Atmos_land_boundary) + if (do_debug) call fms_memutils_print_memuse_stats( 'update ice') + + end subroutine + + !> This subroutine calls flux_up_to_atmos. Clocks are set for runtime statistics. Chksums + !! are computed if do_chksum is .True. + subroutine coupler_flux_up_to_atmos(Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, Atmos_ice_boundary,& + Time_atmos, current_timestep, coupler_chksum_obj, coupler_clocks) + + implicit none + 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_land_boundary_type), intent(inout) :: Atmos_land_boundary !< Atmos_land_boundary + type(atmos_ice_boundary_type), intent(inout) :: Atmos_ice_boundary !< Atmos_ice_boundary + type(FmsTime_type), intent(in) :: Time_atmos !< Time_atmos, time in seconds + integer, intent(in) :: current_timestep !< current timestep + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< points to component types + type(coupler_clock_type), intent(in) :: coupler_clocks !< coupler_clocks + + call fms_mpp_clock_begin(coupler_clocks%flux_up_to_atmos) + 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+', current_timestep, coupler_chksum_obj%Atm, & + Land, Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + + end subroutine coupler_flux_up_to_atmos + + !> This subroutine calls update_atmos_model_up. Clocks are set for runtime statistics. Chksums + !! and memory usage are computed if do_chksum and do_debug are .True. + subroutine coupler_update_atmos_model_up(Atm, Land_ice_atmos_boundary, current_timestep, & + coupler_chksum_obj, coupler_clocks) + + implicit none + type(atmos_data_type), intent(inout) :: Atm !< Atm + type(land_ice_atmos_boundary), intent(inout) :: Land_ice_atmos_boundary !< Land_ice_atmos_boundary + integer, intent(in) :: current_timestep !< current_timestep + type(coupler_chksum_type),intent(in) :: coupler_chksum_obj !< points to component types + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks + + call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_up) + 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+', current_timestep, Atm, coupler_chksum_obj%Land, & + coupler_chksum_obj%Ice, Land_ice_atmos_boundary, & + coupler_chksum_obj%Atmos_ice_boundary, coupler_chksum_obj%Atmos_land_boundary) + if (do_debug) call fms_memutils_print_memuse_stats( 'update up') + + end subroutine coupler_update_atmos_model_up + + !> This subroutine calls flux_atmos_to_ocean and calls flux_ex_arrays_dealloc + subroutine coupler_flux_atmos_to_ocean(Atm, Atmos_ice_boundary, Ice, Time_atmos) + + implicit none + type(atmos_data_type), intent(inout) :: Atm !< Atm + type(atmos_ice_boundary_type), intent(inout) :: Atmos_ice_boundary !< Atmos_ice_boundary + type(ice_data_type), intent(inout) :: Ice !< Ice + type(FmsTime_type), intent(in) :: Time_atmos !< Time in seconds + + call flux_atmos_to_ocean(Time_atmos, Atm, Atmos_ice_boundary, Ice) + call flux_ex_arrays_dealloc + + end subroutine coupler_flux_atmos_to_ocean end module full_coupler_mod From a59748f640ac77386339d0ae1b7d7de94b9dba8a Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 12 Jun 2024 10:18:37 -0400 Subject: [PATCH 12/38] compile error --- full/coupler_main.F90 | 8 ++++---- full/full_coupler_mod.F90 | 24 ++++++++++++++---------- 2 files changed, 18 insertions(+), 14 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 0af41fc3..0e758f8c 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -570,12 +570,12 @@ program coupler_main !-------------------------------------------------------------- !> land model - if (do_land .AND. land%pe) call update_land_model_fast(Land, Atmos_land_boundary, current_timestep,& - coupler_chksum_obj, coupler_clocks) + if (do_land .AND. land%pe) call coupler_update_land_model_fast(Land, Atmos_land_boundary, Atm%pelist, & + current_timestep, coupler_chksum_obj, coupler_clocks) !> ice model - if (do_ice .AND. Ice%fast_ice_pe) call update_ice_model_fast(Ice, Atmos_ice_boundary, current_timestep,& - coupler_chksum_obj, coupler_clocks) + if (do_ice .AND. Ice%fast_ice_pe) call coupler_update_ice_model_fast(Ice, Atmos_ice_boundary, Atm%pelist, & + current_timestep, coupler_chksum_obj, coupler_clocks) !-------------------------------------------------------------- diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 6a5ad8a4..dd3dcd6a 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -2067,11 +2067,13 @@ end subroutine coupler_flux_down_from_atmos !> This subroutine calls update_land_model_fast. Clocks are set for runtime statistics. Chksums !! and memory usage are computed if do_chksum and do_debug are .True. - subroutine coupler_update_land_model_fast(Land, Atmos_land_boundary, current_timestep, coupler_chksum_obj, coupler_clocks) + subroutine coupler_update_land_model_fast(Land, Atmos_land_boundary, atm_pelist, current_timestep, & + coupler_chksum_obj, coupler_clocks) implicit none - type(land_data_type), intent(inout) :: Land !< Land - type(atmos_land_boundary), intent(inout) :: Atmos_land_boundary !< Atmos_land_boundary + type(land_data_type), intent(inout) :: Land !< Land + type(atmos_land_boundary_type), intent(inout) :: Atmos_land_boundary !< Atmos_land_boundary + integer, dimension(:), intent(in) :: atm_pelist !< Atm%pelist to reset the pelist to Atm%pelist integer, intent(in) :: current_timestep !< current timestep type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< points to component types type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks @@ -2081,7 +2083,7 @@ subroutine coupler_update_land_model_fast(Land, Atmos_land_boundary, current_tim call update_land_model_fast( Atmos_land_boundary, Land ) - if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Atm%pelist) + 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+', current_timestep, coupler_chksum_obj%Atm, Land, & @@ -2093,11 +2095,13 @@ end subroutine coupler_update_land_model_fast !> This subroutine calls update_ice_model_fast. Clocks are set for runtime statistics. Chksums !! and memory usage are computed if do_chksum and do_debug are .True. - subroutine coupler_update_ice_model_fast(Ice, Atmos_ice_boundary, current_timestep, coupler_chksum_obj, coupler_clocks) + subroutine coupler_update_ice_model_fast(Ice, Atmos_ice_boundary, atm_pelist, current_timestep, & + coupler_chksum_obj, coupler_clocks) implicit none - type(ice_data_type), intent(inout) :: Ice !< Ice - type(Atmos_ice_boundary), intent(inout) :: Atmos_ice_boundary !< Atmos_ice_boundary + type(ice_data_type), intent(inout) :: Ice !< Ice + type(Atmos_ice_boundary_type), intent(inout) :: Atmos_ice_boundary !< Atmos_ice_boundary + integer, dimension(:), intent(in) :: atm_pelist !< Atm%pelist to reset the pelist to Atm%pelist integer, intent(in) :: current_timestep !< current_timestep type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< points to component types type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks @@ -2107,7 +2111,7 @@ subroutine coupler_update_ice_model_fast(Ice, Atmos_ice_boundary, current_timest call update_ice_model_fast( Atmos_ice_boundary, Ice ) - if (ice_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Atm%pelist) + 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+', current_timestep, coupler_chksum_obj%Atm,& @@ -2148,8 +2152,8 @@ subroutine coupler_update_atmos_model_up(Atm, Land_ice_atmos_boundary, current_t coupler_chksum_obj, coupler_clocks) implicit none - type(atmos_data_type), intent(inout) :: Atm !< Atm - type(land_ice_atmos_boundary), intent(inout) :: Land_ice_atmos_boundary !< Land_ice_atmos_boundary + type(atmos_data_type), intent(inout) :: Atm !< Atm + type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary !< Land_ice_atmos_boundary integer, intent(in) :: current_timestep !< current_timestep type(coupler_chksum_type),intent(in) :: coupler_chksum_obj !< points to component types type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks From a213bf22f3e8fbe74b415b61a5284ca84863ec46 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 12 Jun 2024 10:23:27 -0400 Subject: [PATCH 13/38] 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 14/38] 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 15/38] 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 bced76614e03d0af9efe6caee3aa719e6143578e Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 12 Jun 2024 10:54:28 -0400 Subject: [PATCH 16/38] add update_atmos_model_state --- full/coupler_main.F90 | 13 ++++--------- full/full_coupler_mod.F90 | 22 ++++++++++++++++++++-- 2 files changed, 24 insertions(+), 11 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 0e758f8c..f958585b 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -513,7 +513,7 @@ program coupler_main !> atmos/fast-land/fast-ice integration loop call fms_mpp_clock_begin(coupler_clocks%atmos_loop) - do na = 1, num_atmos_calls + fast_integration_loop : do na = 1, num_atmos_calls Time_atmos = Time_atmos + Time_step_atmos current_timestep = (nc-1)*num_atmos_calls+na @@ -616,14 +616,9 @@ program coupler_main !$ if (do_concurrent_radiation) imb_sec(2) = imb_sec(2) + omp_get_wtime() !$ call omp_set_num_threads(atmos_nthreads+(conc_nthreads-1)*radiation_nthreads) - 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_debug) call fms_memutils_print_memuse_stats( 'update state') - call fms_mpp_clock_end(coupler_clocks%update_atmos_model_state) - - enddo ! end of na (fast loop) + call coupler_update_atmos_model_state(Atm, current_timestep, coupler_chksum_obj, coupler_clocks ) + + enddo fast_integration_loop ! end of na (fast loop) call fms_mpp_clock_end(coupler_clocks%atmos_loop) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index dd3dcd6a..1cad8c9c 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -96,7 +96,6 @@ module full_coupler_mod public :: land_ice_boundary_type, ice_ocean_boundary_type, ocean_ice_boundary_type, ice_ocean_driver_type public :: fmsconstants_init - public :: update_atmos_model_state public :: update_land_model_slow public :: set_ice_surface_fields public :: ice_model_fast_cleanup, unpack_land_ice_boundary @@ -133,7 +132,7 @@ module full_coupler_mod public :: coupler_update_atmos_model_radiation, coupler_flux_down_from_atmos public :: coupler_update_land_model_fast, coupler_update_ice_model_fast public :: coupler_flux_up_to_atmos, coupler_update_atmos_model_up - public :: coupler_flux_atmos_to_ocean + public :: coupler_flux_atmos_to_ocean, coupler_update_atmos_model_state public :: coupler_clock_type, coupler_chksum_type @@ -2182,5 +2181,24 @@ subroutine coupler_flux_atmos_to_ocean(Atm, Atmos_ice_boundary, Ice, Time_atmos) call flux_ex_arrays_dealloc end subroutine coupler_flux_atmos_to_ocean + + subroutine coupler_update_atmos_model_state(Atm, current_timestep, coupler_chksum_obj, coupler_clocks) + + implicit none + type(atmos_data_type), intent(inout) :: Atm + integer, intent(in) :: current_timestep + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj + type(coupler_clock_type), intent(inout) :: coupler_clocks + + call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_state) + call update_atmos_model_state( Atm ) + call fms_mpp_clock_end(coupler_clocks%update_atmos_model_state) + + if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_state+', current_timestep, Atm, & + coupler_chksum_obj%Land, coupler_chksum_obj%Ice, coupler_chksum_obj%Land_ice_atmos_boundary, & + coupler_chksum_obj%Atmos_ice_boundary, coupler_chksum_obj%Atmos_land_boundary) + if (do_debug) call fms_memutils_print_memuse_stats( 'update state') + + end subroutine coupler_update_atmos_model_state end module full_coupler_mod From b80efda0c5a07120db4f38495e9c240cde3e0aeb Mon Sep 17 00:00:00 2001 From: mlee03 Date: Wed, 12 Jun 2024 12:29:35 -0400 Subject: [PATCH 17/38] lint --- full/coupler_main.F90 | 8 +++---- full/full_coupler_mod.F90 | 44 +++++++++++++++++++-------------------- 2 files changed, 26 insertions(+), 26 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 3a2fe841..074e70cc 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 @@ -439,7 +439,7 @@ program coupler_main call fms_mpp_clock_begin(coupler_clocks%main) !begin main loop !----------------------------------------------------------------------- -!> ocean/slow-ice integration loop +!> ocean/slow-ice integration loop if (check_stocks >= 0) call coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, & coupler_clocks, init_stocks=.True.) @@ -509,7 +509,7 @@ program coupler_main call send_ice_mask_sic(Time) !----------------------------------------------------------------------- - !> atmos/fast-land/fast-ice integration loop + !> atmos/fast-land/fast-ice integration loop call fms_mpp_clock_begin(coupler_clocks%atmos_loop) do na = 1, num_atmos_calls @@ -525,7 +525,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 793b5817..86fdd527 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -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' @@ -1148,7 +1148,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 @@ -1158,11 +1158,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) @@ -1349,7 +1349,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) @@ -1922,8 +1922,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) @@ -1945,16 +1945,16 @@ subroutine coupler_sfc_boundary_layer(Atm, Land, Ice, Land_ice_atmos_boundary, & integer, intent(in) :: current_timestep !< (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 ) if (do_chksum) call atmos_ice_land_chksum('sfc+', current_timestep, 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 !> This subroutine calls update_atmos_model_dynamics. Clocks are set for runtime statistics. Chksums @@ -1963,10 +1963,10 @@ subroutine coupler_update_atmos_model_dynamics(Atm, current_timestep, coupler_ch implicit none type(atmos_data_type), intent(inout) :: Atm !< Atm - integer, intent(in) :: current_timestep !< Current timestep + integer, intent(in) :: current_timestep !< Current timestep type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< coupler_chksum_obj pointing to component types type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks - + call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_dynamics) call update_atmos_model_dynamics(Atm) call fms_mpp_clock_end(coupler_clocks%update_atmos_model_dynamics) @@ -1976,7 +1976,7 @@ subroutine coupler_update_atmos_model_dynamics(Atm, current_timestep, coupler_ch coupler_chksum_obj%Atmos_ice_boundary, coupler_chksum_obj%Atmos_land_boundary) if (do_debug) call fms_memutils_print_memuse_stats( 'update dyn') - + end subroutine coupler_update_atmos_model_dynamics !> This subroutine calls update_atmos_model_radiation. Clocks are set for runtime statistics. @@ -1990,11 +1990,11 @@ subroutine coupler_update_atmos_model_radiation(Atm, Land_ice_atmos_boundary, co type(atmos_data_type), intent(inout) :: Atm type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks - integer, optional, intent(in) :: current_timestep !< Current timestep + integer, optional, intent(in) :: current_timestep !< Current timestep type(coupler_chksum_type), optional, intent(in) :: coupler_chksum_obj !< points to component types character(128) :: memuse_stats_id = 'update serial rad' - + call fms_mpp_clock_begin(coupler_clocks%radiation) call update_atmos_model_radiation( Land_ice_atmos_boundary, Atm ) call fms_mpp_clock_end(coupler_clocks%radiation) @@ -2006,7 +2006,7 @@ subroutine coupler_update_atmos_model_radiation(Atm, Land_ice_atmos_boundary, co Atm, coupler_chksum_obj%Land, coupler_chksum_obj%Ice, Land_ice_atmos_boundary, & coupler_chksum_obj%Atmos_ice_boundary, coupler_chksum_obj%Atmos_land_boundary) end if - + if (do_debug) then if(do_concurrent_radiation) memuse_stats_id = 'update concurrent rad' call fms_memutils_print_memuse_stats(trim(memuse_stats_id)) @@ -2022,7 +2022,7 @@ subroutine coupler_update_atmos_model_down(Atm, Land_ice_atmos_boundary, current implicit none type(atmos_data_type), intent(inout) :: Atm !< Atm type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary ! Date: Wed, 12 Jun 2024 12:30:22 -0400 Subject: [PATCH 18/38] lint --- full/coupler_main.F90 | 16 ++++----- full/full_coupler_mod.F90 | 72 +++++++++++++++++++-------------------- 2 files changed, 44 insertions(+), 44 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index f958585b..c9d361b4 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 @@ -439,7 +439,7 @@ program coupler_main call fms_mpp_clock_begin(coupler_clocks%main) !begin main loop !----------------------------------------------------------------------- -!> ocean/slow-ice integration loop +!> ocean/slow-ice integration loop if (check_stocks >= 0) call coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, & coupler_clocks, init_stocks=.True.) @@ -510,7 +510,7 @@ program coupler_main !----------------------------------------------------------------------- - !> atmos/fast-land/fast-ice integration loop + !> atmos/fast-land/fast-ice integration loop call fms_mpp_clock_begin(coupler_clocks%atmos_loop) fast_integration_loop : do na = 1, num_atmos_calls @@ -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) & @@ -569,7 +569,7 @@ program coupler_main !-------------------------------------------------------------- - !> land model + !> land model if (do_land .AND. land%pe) call coupler_update_land_model_fast(Land, Atmos_land_boundary, Atm%pelist, & current_timestep, coupler_chksum_obj, coupler_clocks) @@ -579,10 +579,10 @@ program coupler_main !-------------------------------------------------------------- - !> atmosphere up + !> atmosphere up call coupler_flux_up_to_atmos(Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, Atmos_ice_boundary,& Time_atmos, current_timestep, coupler_chksum_obj, coupler_clocks) - + if (do_atmos) call coupler_update_atmos_model_up(Atm, Land_ice_atmos_boundary, current_timestep, & coupler_chksum_obj, coupler_clocks) @@ -617,7 +617,7 @@ program coupler_main !$ call omp_set_num_threads(atmos_nthreads+(conc_nthreads-1)*radiation_nthreads) call coupler_update_atmos_model_state(Atm, current_timestep, coupler_chksum_obj, coupler_clocks ) - + enddo fast_integration_loop ! end of na (fast loop) call fms_mpp_clock_end(coupler_clocks%atmos_loop) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index 1cad8c9c..da7f6eaf 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -133,7 +133,7 @@ module full_coupler_mod public :: coupler_update_land_model_fast, coupler_update_ice_model_fast public :: coupler_flux_up_to_atmos, coupler_update_atmos_model_up public :: coupler_flux_atmos_to_ocean, coupler_update_atmos_model_state - + 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' @@ -1148,7 +1148,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 @@ -1158,11 +1158,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) @@ -1349,7 +1349,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) @@ -1922,8 +1922,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) @@ -1945,16 +1945,16 @@ subroutine coupler_sfc_boundary_layer(Atm, Land, Ice, Land_ice_atmos_boundary, & integer, intent(in) :: current_timestep !< (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 ) if (do_chksum) call atmos_ice_land_chksum('sfc+', current_timestep, 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 !> This subroutine calls update_atmos_model_dynamics. Clocks are set for runtime statistics. Chksums @@ -1963,10 +1963,10 @@ subroutine coupler_update_atmos_model_dynamics(Atm, current_timestep, coupler_ch implicit none type(atmos_data_type), intent(inout) :: Atm !< Atm - integer, intent(in) :: current_timestep !< Current timestep + integer, intent(in) :: current_timestep !< Current timestep type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< coupler_chksum_obj pointing to component types type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks - + call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_dynamics) call update_atmos_model_dynamics(Atm) call fms_mpp_clock_end(coupler_clocks%update_atmos_model_dynamics) @@ -1976,7 +1976,7 @@ subroutine coupler_update_atmos_model_dynamics(Atm, current_timestep, coupler_ch coupler_chksum_obj%Atmos_ice_boundary, coupler_chksum_obj%Atmos_land_boundary) if (do_debug) call fms_memutils_print_memuse_stats( 'update dyn') - + end subroutine coupler_update_atmos_model_dynamics !> This subroutine calls update_atmos_model_radiation. Clocks are set for runtime statistics. @@ -1990,11 +1990,11 @@ subroutine coupler_update_atmos_model_radiation(Atm, Land_ice_atmos_boundary, co type(atmos_data_type), intent(inout) :: Atm type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks - integer, optional, intent(in) :: current_timestep !< Current timestep + integer, optional, intent(in) :: current_timestep !< Current timestep type(coupler_chksum_type), optional, intent(in) :: coupler_chksum_obj !< points to component types character(128) :: memuse_stats_id = 'update serial rad' - + call fms_mpp_clock_begin(coupler_clocks%radiation) call update_atmos_model_radiation( Land_ice_atmos_boundary, Atm ) call fms_mpp_clock_end(coupler_clocks%radiation) @@ -2006,7 +2006,7 @@ subroutine coupler_update_atmos_model_radiation(Atm, Land_ice_atmos_boundary, co Atm, coupler_chksum_obj%Land, coupler_chksum_obj%Ice, Land_ice_atmos_boundary, & coupler_chksum_obj%Atmos_ice_boundary, coupler_chksum_obj%Atmos_land_boundary) end if - + if (do_debug) then if(do_concurrent_radiation) memuse_stats_id = 'update concurrent rad' call fms_memutils_print_memuse_stats(trim(memuse_stats_id)) @@ -2022,7 +2022,7 @@ subroutine coupler_update_atmos_model_down(Atm, Land_ice_atmos_boundary, current implicit none type(atmos_data_type), intent(inout) :: Atm !< Atm type(land_ice_atmos_boundary_type), intent(inout) :: Land_ice_atmos_boundary ! This subroutine calls update_land_model_fast. Clocks are set for runtime statistics. Chksums @@ -2079,17 +2079,17 @@ subroutine coupler_update_land_model_fast(Land, Atmos_land_boundary, atm_pelist, call fms_mpp_clock_begin(coupler_clocks%update_land_model_fast) !< current pelist=Atm%pelist if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Land%pelist) - + call update_land_model_fast( Atmos_land_boundary, Land ) 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+', current_timestep, coupler_chksum_obj%Atm, Land, & coupler_chksum_obj%Ice, coupler_chksum_obj%Land_ice_atmos_boundary, coupler_chksum_obj%Atmos_ice_boundary, & coupler_chksum_obj%Atmos_land_boundary) if (do_debug) call fms_memutils_print_memuse_stats( 'update land') - + end subroutine coupler_update_land_model_fast !> This subroutine calls update_ice_model_fast. Clocks are set for runtime statistics. Chksums @@ -2109,7 +2109,7 @@ subroutine coupler_update_ice_model_fast(Ice, Atmos_ice_boundary, atm_pelist, cu if (ice_npes .NE. atmos_npes)call fms_mpp_set_current_pelist(Ice%fast_pelist) call update_ice_model_fast( Atmos_ice_boundary, Ice ) - + 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) @@ -2124,7 +2124,7 @@ subroutine coupler_update_ice_model_fast(Ice, Atmos_ice_boundary, atm_pelist, cu !! are computed if do_chksum is .True. subroutine coupler_flux_up_to_atmos(Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, Atmos_ice_boundary,& Time_atmos, current_timestep, coupler_chksum_obj, coupler_clocks) - + implicit none type(land_data_type), intent(inout) :: Land !< Land type(ice_data_type), intent(inout) :: Ice !< Ice @@ -2141,8 +2141,8 @@ subroutine coupler_flux_up_to_atmos(Land, Ice, Land_ice_atmos_boundary, Atmos_la call fms_mpp_clock_end(coupler_clocks%flux_up_to_atmos) if (do_chksum) call atmos_ice_land_chksum('flux_up2atmos+', current_timestep, coupler_chksum_obj%Atm, & - Land, Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) - + Land, Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary) + end subroutine coupler_flux_up_to_atmos !> This subroutine calls update_atmos_model_up. Clocks are set for runtime statistics. Chksums @@ -2156,7 +2156,7 @@ subroutine coupler_update_atmos_model_up(Atm, Land_ice_atmos_boundary, current_t integer, intent(in) :: current_timestep !< current_timestep type(coupler_chksum_type),intent(in) :: coupler_chksum_obj !< points to component types type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks - + call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_up) call update_atmos_model_up(Land_ice_atmos_boundary, Atm) call fms_mpp_clock_end(coupler_clocks%update_atmos_model_up) @@ -2164,8 +2164,8 @@ subroutine coupler_update_atmos_model_up(Atm, Land_ice_atmos_boundary, current_t if (do_chksum) call atmos_ice_land_chksum('update_atmos_up+', current_timestep, Atm, coupler_chksum_obj%Land, & coupler_chksum_obj%Ice, Land_ice_atmos_boundary, & coupler_chksum_obj%Atmos_ice_boundary, coupler_chksum_obj%Atmos_land_boundary) - if (do_debug) call fms_memutils_print_memuse_stats( 'update up') - + if (do_debug) call fms_memutils_print_memuse_stats( 'update up') + end subroutine coupler_update_atmos_model_up !> This subroutine calls flux_atmos_to_ocean and calls flux_ex_arrays_dealloc @@ -2179,7 +2179,7 @@ subroutine coupler_flux_atmos_to_ocean(Atm, Atmos_ice_boundary, Ice, Time_atmos) call flux_atmos_to_ocean(Time_atmos, Atm, Atmos_ice_boundary, Ice) call flux_ex_arrays_dealloc - + end subroutine coupler_flux_atmos_to_ocean subroutine coupler_update_atmos_model_state(Atm, current_timestep, coupler_chksum_obj, coupler_clocks) @@ -2193,12 +2193,12 @@ subroutine coupler_update_atmos_model_state(Atm, current_timestep, coupler_chksu call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_state) call update_atmos_model_state( Atm ) call fms_mpp_clock_end(coupler_clocks%update_atmos_model_state) - + if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_state+', current_timestep, Atm, & coupler_chksum_obj%Land, coupler_chksum_obj%Ice, coupler_chksum_obj%Land_ice_atmos_boundary, & coupler_chksum_obj%Atmos_ice_boundary, coupler_chksum_obj%Atmos_land_boundary) if (do_debug) call fms_memutils_print_memuse_stats( 'update state') - + end subroutine coupler_update_atmos_model_state - + end module full_coupler_mod From 0fa24c964f12efee20f68bca0de18bb2f6fe9d8a Mon Sep 17 00:00:00 2001 From: mlee03 Date: Thu, 13 Jun 2024 12:58:28 -0400 Subject: [PATCH 19/38] 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 20/38] 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 21/38] 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 22/38] 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 23/38] 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 24/38] 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 25/38] 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 26/38] 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 27/38] 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 28/38] 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 beb4590490088c7d135f56c64840382b973479a0 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 14 Jun 2024 14:29:40 -0400 Subject: [PATCH 29/38] fix compile errors --- full/coupler_main.F90 | 2 +- full/full_coupler_mod.F90 | 16 ++++++---------- 2 files changed, 7 insertions(+), 11 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index edb2c24d..a0352322 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -560,7 +560,7 @@ program coupler_main !> checksums are computed if do_chksum=.True. call coupler_flux_down_from_atmos(Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, & - Atmos_ice_boundary, Time_atmos, current_timestep, coupler_clocks) + Atmos_ice_boundary, Time_atmos, current_timestep, coupler_clocks, coupler_chksum_obj) ! -------------------------------------------------------------- ! ---- land model ---- diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index f9fd8b82..629d3805 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -1281,7 +1281,6 @@ subroutine set_components_obj(this, components_obj) end subroutine set_components_obj !> This subroutine finalizes the run ->>>>>>> origin/tracer_driver_sfc_boundary 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) @@ -2044,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 coupler_chksum_obj%get_atmos_ice_land_chksums('sfc+', current_time_step) + if(do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('sfc+', current_timestep) call fms_mpp_clock_end(coupler_clocks%sfc_boundary_layer) @@ -2064,10 +2063,7 @@ subroutine coupler_update_atmos_model_dynamics(Atm, current_timestep, coupler_ch call update_atmos_model_dynamics(Atm) call fms_mpp_clock_end(coupler_clocks%update_atmos_model_dynamics) - if (do_chksum) call atmos_ice_land_chksum('update_atmos_model_dynamics', current_timestep, & - Atm, coupler_chksum_obj%Land, coupler_chksum_obj%Ice, coupler_chksum_obj%Land_ice_atmos_boundary, & - coupler_chksum_obj%Atmos_ice_boundary, coupler_chksum_obj%Atmos_land_boundary) - + 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') end subroutine coupler_update_atmos_model_dynamics @@ -2095,8 +2091,8 @@ subroutine coupler_update_atmos_model_radiation(Atm, Land_ice_atmos_boundary, co if(do_chksum) then !> cannot put mpp_chksum for concurrent_radiation as it requires the ability to have two different OpenMP threads !! inside of MPI at the same time which is not currently allowed - if(.not.do_concurrent_radiation) call atmos_ice_land_chksum('update_atmos_model_radiation(ser)',& - current_timestep, coupler_chksum_obj) + if(.not.do_concurrent_radiation) & + call coupler_chksum_obj%get_atmos_ice_land_chksums('update_atmos_model_radiation(ser)',current_timestep) end if if (do_debug) then @@ -2122,7 +2118,7 @@ subroutine coupler_update_atmos_model_down(Atm, Land_ice_atmos_boundary, current call update_atmos_model_down( Land_ice_atmos_boundary, Atm ) call fms_mpp_clock_end(coupler_clocks%update_atmos_model_down) - if (do_chksum) call atmos_ice_land_chksum('update_atmos_down+', current_timestep, Atm, coupler_chksum_obj) + 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') end subroutine coupler_update_atmos_model_down @@ -2149,7 +2145,7 @@ subroutine coupler_flux_down_from_atmos(Atm, Land, Ice, Land_ice_atmos_boundary, 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+', current_timestep, coupler_chksum_obj) + if (do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('flux_down_from_atmos+', current_timestep) end subroutine coupler_flux_down_from_atmos From caad35db9d1f6671c28dc0701e4ddcef3e4e4828 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Fri, 14 Jun 2024 15:16:55 -0400 Subject: [PATCH 30/38] 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 31/38] 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 32/38] 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 33/38] 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 From a903382cdfd7d176216559172dd5c518434cfa14 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Mon, 17 Jun 2024 08:16:41 -0400 Subject: [PATCH 34/38] git merge is not smart --- full/coupler_main.F90 | 53 ------------------------------------------- 1 file changed, 53 deletions(-) diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index da495e91..e1497723 100644 --- a/full/coupler_main.F90 +++ b/full/coupler_main.F90 @@ -506,10 +506,6 @@ program coupler_main call send_ice_mask_sic(Time) !----------------------------------------------------------------------- -<<<<<<< HEAD - -======= ->>>>>>> origin/atmos_model-flux_down !> atmos/fast-land/fast-ice integration loop call fms_mpp_clock_begin(coupler_clocks%atmos_loop) @@ -566,7 +562,6 @@ program coupler_main call coupler_flux_down_from_atmos(Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, & Atmos_ice_boundary, Time_atmos, current_timestep, coupler_clocks) -<<<<<<< HEAD !-------------------------------------------------------------- !> land model @@ -578,46 +573,6 @@ program coupler_main current_timestep, coupler_chksum_obj, coupler_clocks) !-------------------------------------------------------------- -======= - ! -------------------------------------------------------------- - ! ---- land model ---- - call fms_mpp_clock_begin(coupler_clocks%update_land_model_fast) - if (do_land .AND. land%pe) then - if (land_npes .NE. atmos_npes) call fms_mpp_set_current_pelist(Land%pelist) - call update_land_model_fast( Atmos_land_boundary, Land ) - 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%get_atmos_ice_land_chksums('update_land_fast+', current_timestep) - if (do_debug) call fms_memutils_print_memuse_stats( 'update land') - - ! ---- ice model ---- - call fms_mpp_clock_begin(coupler_clocks%update_ice_model_fast) - if (do_ice .AND. Ice%fast_ice_pe) then - if (ice_npes .NE. atmos_npes)call fms_mpp_set_current_pelist(Ice%fast_pelist) - call update_ice_model_fast( Atmos_ice_boundary, Ice ) - 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%get_atmos_ice_land_chksums('update_ice_fast+', current_timestep) - if (do_debug) call fms_memutils_print_memuse_stats( 'update ice') - - ! -------------------------------------------------------------- - ! ---- atmosphere up ---- - call fms_mpp_clock_begin(coupler_clocks%flux_up_to_atmos) - 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%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%get_atmos_ice_land_chksums('update_atmos_up+', current_timestep) - if (do_debug) call fms_memutils_print_memuse_stats( 'update up') ->>>>>>> origin/atmos_model-flux_down - !> atmosphere up call coupler_flux_up_to_atmos(Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, Atmos_ice_boundary,& Time_atmos, current_timestep, coupler_chksum_obj, coupler_clocks) @@ -655,15 +610,7 @@ program coupler_main !$ if (do_concurrent_radiation) imb_sec(2) = imb_sec(2) + omp_get_wtime() !$ call omp_set_num_threads(atmos_nthreads+(conc_nthreads-1)*radiation_nthreads) -<<<<<<< HEAD call coupler_update_atmos_model_state(Atm, current_timestep, coupler_chksum_obj, coupler_clocks ) -======= - call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_state) - call update_atmos_model_state( Atm ) - 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) ->>>>>>> origin/atmos_model-flux_down enddo fast_integration_loop ! end of na (fast loop) From 48d369573b6411d425172a012925928f3c56c221 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Mon, 17 Jun 2024 12:27:51 -0400 Subject: [PATCH 35/38] change self to this --- full/full_coupler_mod.F90 | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index d23e5189..75f0e3ac 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -1156,7 +1156,7 @@ subroutine initialize_coupler_components_obj(this, Atm, Land, Ice, Ocean, Land_i 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 @@ -1168,16 +1168,16 @@ subroutine initialize_coupler_components_obj(this, Atm, Land, Ice, Ocean, Land_i 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 this%Atm => Atm this%Land => Land From ab0f87dde01efdc258013667758a26785c0b0ce9 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Thu, 20 Jun 2024 08:38:07 -0400 Subject: [PATCH 36/38] comments --- full/full_coupler_mod.F90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index d23e5189..87bfda1c 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -2226,13 +2226,15 @@ subroutine coupler_flux_atmos_to_ocean(Atm, Atmos_ice_boundary, Ice, Time_atmos) end subroutine coupler_flux_atmos_to_ocean + !> This subroutine calls update_atmos_model_state. Chksums are mem usage are computed + !! if do_chksum and do_debug are .True. respectively subroutine coupler_update_atmos_model_state(Atm, current_timestep, coupler_chksum_obj, coupler_clocks) implicit none - type(atmos_data_type), intent(inout) :: Atm - integer, intent(in) :: current_timestep - type(coupler_chksum_type), intent(in) :: coupler_chksum_obj - type(coupler_clock_type), intent(inout) :: coupler_clocks + type(atmos_data_type), intent(inout) :: Atm !< Atm + integer, intent(in) :: current_timestep !< current_timestep + type(coupler_chksum_type), intent(in) :: coupler_chksum_obj !< used to compute chksums + type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks call fms_mpp_clock_begin(coupler_clocks%update_atmos_model_state) call update_atmos_model_state( Atm ) From e678eee343d3efe330f4b9b5a8c8b915aeb8122e Mon Sep 17 00:00:00 2001 From: mlee03 Date: Thu, 20 Jun 2024 10:44:00 -0400 Subject: [PATCH 37/38] fix current_time_step to current_timestep --- 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 b81116e9..e792329a 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -1983,7 +1983,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_time_step, coupler_chksum_obj, coupler_clocks) + Time_atmos, current_timestep, coupler_chksum_obj, coupler_clocks) implicit none type(atmos_data_type), intent(inout) :: Atm !< Atm @@ -1991,7 +1991,7 @@ subroutine coupler_sfc_boundary_layer(Atm, Land, Ice, Land_ice_atmos_boundary, & 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(FmsTime_type), intent(in) :: Time_atmos !< Atmos time - integer, intent(in) :: current_time_step !< (nc-1)*num_atmos_cal + na + integer, intent(in) :: current_timestep !< (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 From 1372bf8d531bc280b152c7b18c03aee0159e9730 Mon Sep 17 00:00:00 2001 From: mlee03 Date: Thu, 20 Jun 2024 11:50:39 -0400 Subject: [PATCH 38/38] end subroutine coupler_update_ice_model_fast --- 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 e792329a..0c9146e7 100644 --- a/full/full_coupler_mod.F90 +++ b/full/full_coupler_mod.F90 @@ -2154,7 +2154,7 @@ subroutine coupler_update_ice_model_fast(Ice, Atmos_ice_boundary, atm_pelist, cu 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') - end subroutine + end subroutine coupler_update_ice_model_fast !> This subroutine calls flux_up_to_atmos. Clocks are set for runtime statistics. Chksums !! are computed if do_chksum is .True.