diff --git a/full/coupler_main.F90 b/full/coupler_main.F90 index 4ae80dbd..3ff7deb5 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_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 @@ -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() @@ -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 @@ -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 @@ -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 @@ -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) @@ -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) @@ -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) & @@ -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) & @@ -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() @@ -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 ---- @@ -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 ---- @@ -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) @@ -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 ---- @@ -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 ---- @@ -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') ! -------------------------------------------------------------- @@ -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) @@ -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) @@ -696,8 +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 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 @@ -705,8 +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 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 @@ -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 @@ -776,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, 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) & @@ -784,7 +767,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 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 @@ -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() @@ -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) diff --git a/full/full_coupler_mod.F90 b/full/full_coupler_mod.F90 index b5837e72..dbdd4ded 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 @@ -121,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 @@ -132,8 +128,9 @@ 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 + public :: coupler_clock_type, coupler_components_type, coupler_chksum_type #include @@ -277,6 +274,39 @@ module full_coupler_mod integer :: flux_exchange_init end type coupler_clock_type + type coupler_components_type + private + 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 :: initialize_coupler_components_obj + 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 :: 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 :: 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 character(len=48), parameter :: mod_name = 'coupler_main_mod' @@ -293,7 +323,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_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 @@ -316,7 +346,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) :: coupler_clocks + 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 @@ -1091,12 +1123,19 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary, CALL fms_diag_grid_end() !----------------------------------------------------------------------- + + !> Initialize coupler_components_obj memebers to point to model components + 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%initialize_coupler_chksum_obj(coupler_components_obj) + 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_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 slow_ice_chksum('coupler_init+', 0, Ice, Ocean_ice_boundary) + call coupler_chksum_obj%get_slow_ice_chksums('coupler_init+', 0) end if end if @@ -1112,9 +1151,94 @@ end subroutine coupler_init !####################################################################### + !> This subroutine associates the pointer in an object of coupler_components_type to the model components + 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 + 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 + 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 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, + !! coupler_components_obj%get_component(Atm) will return Atm = coupler_components_obj%Atm + subroutine get_component(this, retrieve_component ) + + implicit none + 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, + !! 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, "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 initialize_coupler_chksum_obj(this, components_obj) + + implicit none + class(coupler_chksum_type), intent(inout) :: this + type(coupler_components_type), intent(in), target :: components_obj + + this%components => components_obj + + end subroutine initialize_coupler_chksum_obj + + !> 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 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) + Ice_bc_restart, Time, Time_start, Time_end, Time_restart_current, coupler_chksum_obj) implicit none @@ -1131,15 +1255,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_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 slow_ice_chksum('coupler_end', 0, Ice, Ocean_ice_boundary) + call coupler_chksum_obj%get_slow_ice_chksums('coupler_end', 0) end if endif call fms_mpp_set_current_pelist() @@ -1300,30 +1425,26 @@ end subroutine coupler_restart !-------------------------------------------------------------------------- !> \brief Print out checksums for several atm, land and ice variables - subroutine coupler_chksum(id, timestep, Atm, Land, Ice) + subroutine get_coupler_chksums(this, id, timestep) 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 + 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 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 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. @@ -1342,56 +1463,55 @@ 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 (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 - 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(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(Atm%tr_bot(:,:,n)) - endif - enddo + 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(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(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(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(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(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(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(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 @@ -1400,13 +1520,34 @@ subroutine coupler_chksum(id, timestep, Atm, Land, Ice) 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 get_atmos_ice_land_ocean_chksums(this, id, timestep) + + implicit none + + 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) + endif + if (this%components%Ocean%is_ocean_pe) then + call fms_mpp_set_current_pelist(this%components%Ocean%pelist) + call this%get_ocean_chksums(trim(id), timestep) + endif + + 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. !! It is assumed that the appropriate pelist has been set before entering this routine. !! This can be achieved in the following way. @@ -1422,40 +1563,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 get_atmos_ice_land_chksums(this, id, 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) + + 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 (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 (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(Atm%pelist) + 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. -!! !! 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. @@ -1471,22 +1604,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 get_slow_ice_chksums(this, id, timestep) - 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 + class(coupler_chksum_type), intent(in) :: this !< self + 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. @@ -1502,17 +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(id, timestep, Ocean, Ice_ocean_boundary) + subroutine get_ocean_chksums(this, id, timestep) - 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 sets the ID for clocks used in coupler_main subroutine coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble_pelist,& @@ -1617,41 +1747,9 @@ 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) + coupler_clocks, init_stocks, finish_stocks) implicit none @@ -1740,15 +1838,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 @@ -1778,7 +1876,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 @@ -1787,6 +1886,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) @@ -1794,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 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) call fms_mpp_clock_end(coupler_clocks%set_ice_surface_slow) @@ -1866,4 +1966,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, & + Time_atmos, current_time_step, 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(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 coupler_chksum_obj%get_atmos_ice_land_chksums('sfc+', current_time_step) + + call fms_mpp_clock_end(coupler_clocks%sfc_boundary_layer) + + end subroutine coupler_sfc_boundary_layer + + end module full_coupler_mod