Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

9 - coupler_chksum_obj, coupler_atmos_tracer_driver_gather_data, coupler_sfc_boundary_layer #123

Merged
merged 26 commits into from
Jun 20, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
131 changes: 57 additions & 74 deletions full/coupler_main.F90
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
Loading