Skip to content

Commit

Permalink
refactor: add calls for coupler_chksum_obj, coupler_atmos_tracer_driv…
Browse files Browse the repository at this point in the history 
…er_gather_data, coupler_sfc_boundary_layer (#123)
  • Loading branch information
@mlee03
mlee03 authored Jun 20, 2024
1 parent 2b59f6d commit f46b6bf
Show file tree
Hide file tree
Showing 2 changed files with 335 additions and 213 deletions.
131 changes: 57 additions & 74 deletions full/coupler_main.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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_components_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_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
Expand All @@ -362,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()
Expand All @@ -370,7 +372,9 @@ program coupler_main
type(FmsTime_type) :: Time_restart_current
character(len=32) :: timestamp

type(coupler_clock_type) :: coupler_clocks
type(coupler_clock_type) :: coupler_clocks
type(coupler_components_type), target :: coupler_components_obj
type(coupler_chksum_type) :: coupler_chksum_obj

integer :: outunit
character(len=80) :: text
Expand Down Expand Up @@ -426,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, 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, Atm, Land, Ice)
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
Expand All @@ -445,10 +450,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_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
Expand All @@ -469,18 +472,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_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.
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)
Expand All @@ -498,8 +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, Atm, Land, Ice, &
Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary)
if(do_chksum) call coupler_chksum_obj%get_atmos_ice_land_chksums('set_ice_surface+', nc)

call fms_mpp_clock_begin(coupler_clocks%atm)

Expand All @@ -511,25 +511,17 @@ 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 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)

if (do_flux) call coupler_sfc_boundary_layer(Atm, Land, Ice, Land_ice_atmos_boundary, &
Time_atmos, current_timestep, coupler_chksum_obj, coupler_clocks)

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

!$OMP PARALLEL &
!$OMP& NUM_THREADS(conc_nthreads) &
Expand All @@ -539,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)
!$OMP& SHARED(coupler_clocks, current_timestep, coupler_chksum_obj)
!$ if (omp_get_thread_num() == 0) then
!$OMP PARALLEL &
!$OMP& NUM_THREADS(1) &
Expand All @@ -549,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)
!$OMP& SHARED(coupler_clocks, current_timestep, coupler_chksum_obj)
!$ call omp_set_num_threads(atmos_nthreads)
!$ dsec=omp_get_wtime()

Expand All @@ -558,11 +550,11 @@ 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)
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_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 ----
Expand All @@ -571,8 +563,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, &
Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary)
if (do_chksum) &
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 ----
Expand All @@ -581,8 +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 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 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)
Expand All @@ -591,8 +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 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 coupler_chksum_obj%get_atmos_ice_land_chksums('flux_down_from_atmos+', current_timestep)

! --------------------------------------------------------------
! ---- land model ----
Expand All @@ -603,8 +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 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 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 ----
Expand All @@ -615,8 +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 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 coupler_chksum_obj%get_atmos_ice_land_chksums('update_ice_fast+', current_timestep)
if (do_debug) call fms_memutils_print_memuse_stats( 'update ice')

! --------------------------------------------------------------
Expand All @@ -625,15 +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 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 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 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 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)
Expand Down Expand Up @@ -678,8 +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 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 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)

Expand All @@ -696,17 +681,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, Atm, Land, Ice, &
Land_ice_atmos_boundary, Atmos_ice_boundary, Atmos_land_boundary)
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
!
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 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
Expand Down Expand Up @@ -747,7 +730,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 coupler_chksum_obj%get_slow_ice_chksums('update_ice_slow+', nc)
endif ! End of Ice%pe block

if(Atm%pe) then
Expand Down Expand Up @@ -776,15 +759,15 @@ 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 coupler_chksum_obj%get_ocean_chksums('update_ocean_model-', nc)
! update_ocean_model since fluxes don't change here

if (do_ocean) &
call update_ocean_model( Ice_ocean_boundary, Ocean_state, Ocean, &
Time_ocean, Time_step_cpld )
endif

if (do_chksum) call ocean_chksum('update_ocean_model+', nc, Ocean, Ice_ocean_boundary)
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
Expand Down Expand Up @@ -819,7 +802,7 @@ program coupler_main
endif

!--------------
if (do_chksum) call coupler_chksum('MAIN_LOOP+', nc, Atm, Land, Ice)
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()
Expand All @@ -841,10 +824,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_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)
Time, Time_start, Time_end, Time_restart_current, coupler_chksum_obj)

call fms_mpp_clock_end(coupler_clocks%termination)

Expand Down
Loading

0 comments on commit f46b6bf

Please sign in to comment.