Skip to content

Commit

Permalink
refactor: add subroutines coupler_full_chksum and coupler_stocks (#114)
Browse files Browse the repository at this point in the history
  • Loading branch information
@mlee03
mlee03 authored May 31, 2024
1 parent e7351ae commit 80def09
Show file tree
Hide file tree
Showing 3 changed files with 133 additions and 83 deletions.
68 changes: 19 additions & 49 deletions full/coupler_main.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -439,27 +439,17 @@ program coupler_main
!-----------------------------------------------------------------------
!------ ocean/slow-ice integration loop ------

if (check_stocks >= 0) then
call fms_mpp_set_current_pelist()
call flux_init_stocks(Time, Atm, Land, Ice, Ocean_state)
endif
if (check_stocks >= 0) call coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, &
coupler_clocks, init_stocks=.True.)

do nc = 1, num_cpld_calls
if (do_chksum) call coupler_chksum('top_of_coupled_loop+', nc, Atm, Land, Ice)
call fms_mpp_set_current_pelist()

if (do_chksum) then
if (Atm%pe) then
call fms_mpp_set_current_pelist(Atm%pelist)
call atmos_ice_land_chksum('MAIN_LOOP-', nc, Atm, Land, Ice, &
Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary)
endif
if (Ocean%is_ocean_pe) then
call fms_mpp_set_current_pelist(Ocean%pelist)
call ocean_chksum('MAIN_LOOP-', nc, Ocean, Ice_ocean_boundary)
endif
call fms_mpp_set_current_pelist()
endif
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)
end if

! Calls to flux_ocean_to_ice and flux_ice_to_ocean are all PE communication
! points when running concurrently. The calls are placed next to each other in
Expand Down Expand Up @@ -487,28 +477,13 @@ program coupler_main

if (do_chksum) then
call coupler_chksum('flux_ocn2ice+', nc, Atm, Land, Ice)
if (Atm%pe) then
call fms_mpp_set_current_pelist(Atm%pelist)
call atmos_ice_land_chksum('fluxocn2ice+', nc, Atm, Land, Ice, &
Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary)
endif
if (Ocean%is_ocean_pe) then
call fms_mpp_set_current_pelist(Ocean%pelist)
call ocean_public_type_chksum('fluxocn2ice+', nc, Ocean)
endif
call fms_mpp_set_current_pelist()
endif

! To print the value of frazil heat flux at the right time the following block
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)
end if

! needs to sit here rather than at the end of the coupler loop.
if (check_stocks > 0) then
call fms_mpp_clock_begin(coupler_clocks%flux_check_stocks)
if (check_stocks*((nc-1)/check_stocks) == nc-1 .AND. nc > 1) then
call fms_mpp_set_current_pelist()
call flux_check_stocks(Time=Time, Atm=Atm, Lnd=Land, Ice=Ice, Ocn_state=Ocean_state)
endif
call fms_mpp_clock_end(coupler_clocks%flux_check_stocks)
endif
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) then
Expand Down Expand Up @@ -898,23 +873,18 @@ program coupler_main
enddo
102 FORMAT(A17,i5,A4,i5,A24,f10.4,A2,f10.4,A3,f10.4,A2,f10.4,A1)

call fms_mpp_set_current_pelist()
call fms_mpp_clock_begin(coupler_clocks%final_flux_check_stocks)
if (check_stocks >= 0) then
call fms_mpp_set_current_pelist()
call flux_check_stocks(Time=Time, Atm=Atm, Lnd=Land, Ice=Ice, Ocn_state=Ocean_state)
endif
call fms_mpp_clock_end(coupler_clocks%final_flux_check_stocks)

if( check_stocks >=0 ) call coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, &
coupler_clocks, finish_stocks=.True.)

call fms_mpp_set_current_pelist()
!-----------------------------------------------------------------------
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)
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)
Atmos_land_boundary, Ice_ocean_boundary, Ocean_ice_boundary, Ocn_bc_restart, Ice_bc_restart, &
Time, Time_start, Time_end, Time_restart_current)

call fms_mpp_clock_end(coupler_clocks%termination)

Expand Down
10 changes: 5 additions & 5 deletions full/flux_exchange.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -760,11 +760,11 @@ end subroutine flux_exchange_init

subroutine flux_check_stocks(Time, Atm, Lnd, Ice, Ocn_state)

type(FmsTime_type) :: Time
type(atmos_data_type), optional :: Atm
type(land_data_type), optional :: Lnd
type(ice_data_type), optional :: Ice
type(ocean_state_type), optional, pointer :: Ocn_state
type(FmsTime_type), intent(in) :: Time
type(atmos_data_type), intent(inout), optional :: Atm
type(land_data_type), intent(inout), optional :: Lnd
type(ice_data_type), intent(inout), optional :: Ice
type(ocean_state_type), intent(inout), optional, pointer :: Ocn_state

real :: ref_value
integer :: i
Expand Down
138 changes: 109 additions & 29 deletions full/full_coupler_mod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -108,7 +108,6 @@ module full_coupler_mod
public :: flux_down_from_atmos, flux_up_to_atmos
public :: flux_land_to_ice, flux_ice_to_ocean, flux_ocean_to_ice
public :: flux_ice_to_ocean_finish, flux_ocean_to_ice_finish
public :: flux_check_stocks, flux_init_stocks
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
Expand All @@ -125,6 +124,9 @@ module full_coupler_mod
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_clock_type

!-----------------------------------------------------------------------
Expand Down Expand Up @@ -227,7 +229,6 @@ module full_coupler_mod
use_hyper_thread, concurrent_ice, slow_ice_with_ocean, &
do_endpoint_chksum, combined_ice_and_ocean


!> coupler_clock_type derived type consist of all clock ids that will be set and used
!! in full coupler_main.
type coupler_clock_type
Expand Down Expand Up @@ -1089,22 +1090,14 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary,

!-----------------------------------------------------------------------
if ( do_endpoint_chksum ) then
if (Atm%pe) then
call fms_mpp_set_current_pelist(Atm%pelist)
call atmos_ice_land_chksum('coupler_init+', 0, Atm, Land, Ice, &
Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary)
endif
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)
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)
endif
if (Ocean%is_ocean_pe) then
call fms_mpp_set_current_pelist(Ocean%pelist)
call ocean_chksum('coupler_init+', 0, Ocean, Ice_ocean_boundary)
endif
endif

call fms_mpp_set_current_pelist()
end if
end if

call fms_memutils_print_memuse_stats('coupler_init')

if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then
Expand Down Expand Up @@ -1139,19 +1132,12 @@ 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
if (Atm%pe) then
call fms_mpp_set_current_pelist(Atm%pelist)
call atmos_ice_land_chksum('coupler_end', 0, Atm, Land, Ice, &
Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary)
endif
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)
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)
endif
if (Ocean%is_ocean_pe) then
call fms_mpp_set_current_pelist(Ocean%pelist)
call ocean_chksum('coupler_end', 0, Ocean, Ice_ocean_boundary)
endif
end if
endif
call fms_mpp_set_current_pelist()

Expand Down Expand Up @@ -1515,10 +1501,10 @@ end subroutine slow_ice_chksum
!! 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)

character(len=*), intent(in) :: id
integer , intent(in) :: timestep
type (ocean_public_type), intent(in) :: Ocean
type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary
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 !<Ice_ocean_boundary

call ocean_public_type_chksum(id, timestep, Ocean)
call ice_ocn_bnd_type_chksum( id, timestep, Ice_ocean_boundary)
Expand Down Expand Up @@ -1629,4 +1615,98 @@ subroutine coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble

end subroutine coupler_set_clock_ids

!> \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)

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)
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)
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)

implicit none

type(FmsTime_type), intent(in) :: Time !< current Time
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(ocean_state_type), pointer, intent(inout) :: Ocean_state !< Ocean_state
type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks
logical, optional, intent(in) :: init_stocks, finish_stocks !< control flags to either call flux_init_stocks or
!! the final flux_check_stocks

logical :: init, finish !< control flags set to False. by default and takes on the value of init_stocks and
!! finish_stocks if these optional arguments are provided.
!! If true, either flux_init_stocks or
!! final flux_check_stocks will be called.

init=.False. ; if(present(init_stocks)) init=init_stocks
finish=.False. ; if(present(finish_stocks)) finish=finish_stocks

if(init) then
call fms_mpp_set_current_pelist()
call flux_init_stocks(Time, Atm, Land, Ice, Ocean_state)
else if(finish) then
call fms_mpp_set_current_pelist()
call fms_mpp_clock_begin(coupler_clocks%final_flux_check_stocks)
if (check_stocks >= 0) then
call fms_mpp_set_current_pelist()
call flux_check_stocks(Time=Time, Atm=Atm, Lnd=Land, Ice=Ice, Ocn_state=Ocean_state)
endif
call fms_mpp_clock_end(coupler_clocks%final_flux_check_stocks)
else
call fms_mpp_error(FATAL, 'coupler_flux_init_finish_stocks: either init or finish needs to be .True.')
end if

end subroutine coupler_flux_init_finish_stocks

!> \brief This subroutine calls flux_check_stocks
subroutine coupler_flux_check_stocks(nc, Time, Atm, Land, Ice, Ocean_state, coupler_clocks)

implicit none

integer, intent(in) :: nc !< current outerloop timestep
type(FmsTime_type), intent(in) :: Time !< Time
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(ocean_state_type), pointer, intent(inout) :: Ocean_state !< Ocean_state
type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks

call fms_mpp_clock_begin(coupler_clocks%flux_check_stocks)
if (check_stocks*((nc-1)/check_stocks) == nc-1 .AND. nc > 1) then
call fms_mpp_set_current_pelist()
call flux_check_stocks(Time=Time, Atm=Atm, Lnd=Land, Ice=Ice, Ocn_state=Ocean_state)
endif
call fms_mpp_clock_end(coupler_clocks%flux_check_stocks)

end subroutine coupler_flux_check_stocks

end module full_coupler_mod

0 comments on commit 80def09

Please sign in to comment.