#5 - coupler_flux_ocean_to_ice and coupler_flux_ice_to_ocean

full/coupler_main.F90

@@ -371,7 +371,7 @@ program coupler_main
   character(len=32) :: timestamp
 
   type(coupler_clock_type) :: coupler_clocks
-  
+
   integer :: outunit
   character(len=80) :: text
   integer, allocatable :: ensemble_pelist(:, :)
@@ -440,12 +440,12 @@ program coupler_main
 !------ ocean/slow-ice integration loop ------
 
   if (check_stocks >= 0) call coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, &
-      coupler_clocks, init_stocks=.True.)
+                                                              coupler_clocks, init_stocks=.True.)
 
   do nc = 1, num_cpld_calls
 
-    if (do_chksum) then      
-      call coupler_chksum('top_of_coupled_loop+', nc, Atm, Land, Ice)    
+    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)
@@ -456,32 +456,25 @@ program coupler_main
     ! concurrent mode to avoid multiple synchronizations within the main loop.
     ! With concurrent_ice, these only occur on the ocean PEs.
     if (Ice%slow_ice_PE .or. Ocean%is_ocean_pe) then
-      ! If the slow ice is on a subset of the ocean PEs, use the ocean PElist.
-      call fms_mpp_set_current_pelist(slow_ice_ocean_pelist)
-      call fms_mpp_clock_begin(coupler_clocks%flux_ocean_to_ice)
+
       !Redistribute quantities from Ocean to Ocean_ice_boundary
-      !Ice intent is In.
-      !Ice is used only for accessing Ice%area and knowing if we are on an Ice pe
-      call flux_ocean_to_ice( Time, Ocean, Ice, Ocean_ice_boundary )
+      call coupler_flux_ocean_to_ice(Ocean, Ice, Ocean_ice_boundary, coupler_clocks, slow_ice_ocean_pelist)
       Time_flux_ocean_to_ice = Time
-      call fms_mpp_clock_end(coupler_clocks%flux_ocean_to_ice)
 
       ! Update Ice_ocean_boundary; the first iteration is supplied by restarts
-      if (use_lag_fluxes) then
-        call fms_mpp_clock_begin(coupler_clocks%flux_ice_to_ocean)
-        call flux_ice_to_ocean( Time, Ice, Ocean, Ice_ocean_boundary )
+      if(use_lag_fluxes) then
+        call coupler_flux_ice_to_ocean(Ice, Ocean, Ice_ocean_boundary, coupler_clocks)
         Time_flux_ice_to_ocean = Time
-        call fms_mpp_clock_end(coupler_clocks%flux_ice_to_ocean)
-      endif
-    endif
+      end if
+    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)
     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)
 
@@ -788,19 +781,12 @@ program coupler_main
      endif
 
     ! Update Ice_ocean_boundary using the newly calculated fluxes.
-    if ((concurrent_ice .OR. .NOT.use_lag_fluxes) .and. .not.combined_ice_and_ocean) then
+    if ((concurrent_ice .or. .not.use_lag_fluxes) .and. .not.combined_ice_and_ocean) then
       !this could serialize unless slow_ice_with_ocean is true.
-      if ((.not.do_ice) .or. (.not.slow_ice_with_ocean)) &
-        call fms_mpp_set_current_pelist()
-
-      if (Ice%slow_ice_PE .or. Ocean%is_ocean_pe) then
-        ! If the slow ice is on a subset of the ocean PEs, use the ocean PElist.
-        call fms_mpp_set_current_pelist(slow_ice_ocean_pelist)
-        call fms_mpp_clock_begin(coupler_clocks%flux_ice_to_ocean)
-        call flux_ice_to_ocean( Time, Ice, Ocean, Ice_ocean_boundary )
-        Time_flux_ice_to_ocean = Time
-        call fms_mpp_clock_end(coupler_clocks%flux_ice_to_ocean)
-      endif
+      if ((.not.do_ice) .or. (.not.slow_ice_with_ocean)) call fms_mpp_set_current_pelist()
+      call coupler_flux_ice_to_ocean(Ice, Ocean, Ice_ocean_boundary, coupler_clocks, &
+        slow_ice_ocean_pelist=slow_ice_ocean_pelist, set_current_slow_ice_ocean_pelist=.True.)
+      Time_flux_ice_to_ocean = Time
     endif
 
     if (Ocean%is_ocean_pe) then
@@ -874,10 +860,9 @@ program coupler_main
 102 FORMAT(A17,i5,A4,i5,A24,f10.4,A2,f10.4,A3,f10.4,A2,f10.4,A1)
 
   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()
+                                                              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)
 

full/full_coupler_mod.F90

@@ -106,7 +106,7 @@ module full_coupler_mod
   public :: update_ocean_model, update_slow_ice_and_ocean
   public :: sfc_boundary_layer, generate_sfc_xgrid, send_ice_mask_sic
   public :: flux_down_from_atmos, flux_up_to_atmos
-  public :: flux_land_to_ice, flux_ice_to_ocean, flux_ocean_to_ice
+  public :: flux_land_to_ice
   public :: flux_ice_to_ocean_finish, flux_ocean_to_ice_finish
   public :: flux_ocean_from_ice_stocks, flux_ice_to_ocean_stocks
   public :: flux_atmos_to_ocean, flux_ex_arrays_dealloc
@@ -125,12 +125,14 @@ module full_coupler_mod
   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
 
   public :: coupler_clock_type
-  
+
 !-----------------------------------------------------------------------
-  
+
 #include <file_version.fh>
 
   !> namelist interface
@@ -231,7 +233,7 @@ module full_coupler_mod
 
   !> coupler_clock_type derived type consist of all clock ids that will be set and used
   !! in full coupler_main.
-  type coupler_clock_type 
+  type coupler_clock_type
     integer :: initialization
     integer :: main
     integer :: generate_sfc_xgrid
@@ -387,7 +389,7 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary,
     read (fms_mpp_input_nml_file, coupler_nml, iostat=io)
     ierr = check_nml_error (io, 'coupler_nml')
 
-!----- read date and calendar type from restart file -----
+    !----- read date and calendar type from restart file -----
     if (fms2_io_file_exists('INPUT/coupler.res')) then
        call fms2_io_ascii_read('INPUT/coupler.res', restart_file)
        read(restart_file(1), *) calendar_type
@@ -870,10 +872,8 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary,
         endif
 
         call fms_mpp_clock_begin(coupler_clocks%atmos_model_init)
-
         call atmos_model_init( Atm, Time_init, Time, Time_step_atmos, &
                                do_concurrent_radiation)
-
         call fms_mpp_clock_end(coupler_clocks%atmos_model_init)
 
         if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then
@@ -1097,7 +1097,7 @@ subroutine coupler_init(Atm, Ocean, Land, Ice, Ocean_state, Atmos_land_boundary,
         call slow_ice_chksum('coupler_init+', 0, Ice, Ocean_ice_boundary)
       end if
     end if
-    
+
     call fms_memutils_print_memuse_stats('coupler_init')
 
     if (fms_mpp_pe().EQ.fms_mpp_root_pe()) then
@@ -1517,7 +1517,6 @@ subroutine coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble
 
     implicit none
 
-
     type(coupler_clock_type), intent(inout) :: coupler_clocks !< coupler_clocks
     type(atmos_data_type),   intent(in) :: Atm   !< Atm, required to retrieve pe information
     type(land_data_type),    intent(in) :: Land  !< Land, required to retrieve pe information
@@ -1550,11 +1549,11 @@ subroutine coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble
     endif
     call fms_mpp_set_current_pelist(ensemble_pelist(ensemble_id,:))
     coupler_clocks%flux_exchange_init = fms_mpp_clock_id( '  Init: flux_exchange_init' )
-    
+
     call fms_mpp_set_current_pelist()
     coupler_clocks%main = fms_mpp_clock_id( 'Main loop' )
     coupler_clocks%termination = fms_mpp_clock_id( 'Termination' )
-    
+
     If(Atm%pe) then
       call fms_mpp_set_current_pelist(Atm%pelist)
       coupler_clocks%generate_sfc_xgrid = fms_mpp_clock_id( 'generate_sfc_xgrid' )
@@ -1592,35 +1591,35 @@ subroutine coupler_set_clock_ids(coupler_clocks, Atm, Land, Ice, Ocean, ensemble
       if (Ice%fast_ice_pe) call fms_mpp_set_current_pelist(Ice%fast_pelist)
       coupler_clocks%set_ice_surface_fast       = fms_mpp_clock_id( ' Ice: set_ice_surface fast' )
       coupler_clocks%update_ice_model_slow_fast = fms_mpp_clock_id( ' Ice: update_ice_model_slow fast' )
-      
+
       if (Ice%slow_ice_pe) call fms_mpp_set_current_pelist(Ice%slow_pelist)
       coupler_clocks%set_ice_surface_slow       = fms_mpp_clock_id( ' Ice: set_ice_surface slow' )
       coupler_clocks%update_ice_model_slow_slow = fms_mpp_clock_id( ' Ice: update_ice_model_slow slow' )
       coupler_clocks%flux_ice_to_ocean_stocks   = fms_mpp_clock_id( ' Ice: flux_ice_to_ocean_stocks' )
-      
+
       call fms_mpp_set_current_pelist(Ice%pelist)
       coupler_clocks%set_ice_surface_exchange       = fms_mpp_clock_id( ' Ice: set_ice_surface exchange' )
       coupler_clocks%update_ice_model_slow_exchange = fms_mpp_clock_id( ' Ice: update_ice_model_slow exchange' )
-      
+
     endif
     if (Ocean%is_ocean_pe) then
       call fms_mpp_set_current_pelist(Ocean%pelist)
       coupler_clocks%ocean = fms_mpp_clock_id( 'OCN' )
     endif
-    
+
     call fms_mpp_set_current_pelist()
     coupler_clocks%flux_check_stocks       = fms_mpp_clock_id( 'flux_check_stocks' )
     coupler_clocks%intermediate_restart    = fms_mpp_clock_id( 'intermediate restart' )
     coupler_clocks%final_flux_check_stocks = fms_mpp_clock_id( 'final flux_check_stocks' )
-      
+
 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
@@ -1644,15 +1643,15 @@ subroutine coupler_atmos_ice_land_ocean_chksum(id, timestep, Atm, Land, Ice, Lan
     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
-    
+
     type(FmsTime_type),    intent(in) :: Time    !< current Time
     type(atmos_data_type), intent(inout) :: Atm  !< Atm
     type(land_data_type),  intent(inout) :: Land !< Land
@@ -1670,7 +1669,7 @@ subroutine coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, &
     init=.False.   ; if(present(init_stocks)) init=init_stocks
     finish=.False. ; if(present(finish_stocks)) finish=finish_stocks
 
-    if(init) then 
+    if(init) then
       call fms_mpp_set_current_pelist()
       call flux_init_stocks(Time, Atm, Land, Ice, Ocean_state)
     else if(finish) then
@@ -1684,29 +1683,94 @@ subroutine coupler_flux_init_finish_stocks(Time, Atm, Land, Ice, Ocean_state, &
     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
+  !> \brief This subroutine calls flux_check_stocks.  Clocks and pelists are set before and after
+  !! call to 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(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      
+    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
-
+
+  !> \brief This subroutine calls flux_ocean_to_ice.
+  !! Clocks and pelists are set before and after call flux_ocean_to_ice
+  subroutine coupler_flux_ocean_to_ice(Ocean, Ice, Ocean_ice_boundary, coupler_clocks, slow_ice_ocean_pelist)
+
+    implicit none
+
+    type(ocean_public_type), intent(inout) :: Ocean  !< Ocean
+    type(ice_data_type),     intent(in)    :: 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
+    integer, dimension(:),    intent(in)    :: slow_ice_ocean_pelist   !< slow_ice_ocean_pelist
+
+    !Redistribute quantities from Ocean to Ocean_ice_boundary
+
+    ! If the slow ice is on a subset of the ocean PEs, use the ocean PElist.
+    call fms_mpp_set_current_pelist(slow_ice_ocean_pelist)
+    call fms_mpp_clock_begin(coupler_clocks%flux_ocean_to_ice)
+
+    !Ice intent is In, used only for accessing Ice%area and knowing if we are on an Ice pe
+    call flux_ocean_to_ice(Ocean, Ice, Ocean_ice_boundary)
+
+    call fms_mpp_clock_end(coupler_clocks%flux_ocean_to_ice)
+
+  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,&
+                                       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
+    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
+
+    logical :: set_current_slow_ice_ocean_pelist_in !< .F. by default; set to equal set_current_slow_ice_ocean_pelist
+
+    !> mpp_set_current_pelist(slow_ice_ocean_pelist) is not required if coupler_flux_ice_to_ocean is being called after
+    !! coupler_flux_ocean_to_ice:  mpp_set_current_pelist(slow_ice_ocean_pelist) is called
+    !! in coupler_flux_ocean_to_ice
+    set_current_slow_ice_ocean_pelist_in=.False.
+    if(present(set_current_slow_ice_ocean_pelist)) &
+        set_current_slow_ice_ocean_pelist_in = set_current_slow_ice_ocean_pelist
+
+    ! Update Ice_ocean_boundary; the first iteration is supplied by restarts
+
+    if(set_current_slow_ice_ocean_pelist_in) then
+      if(.not.present(slow_ice_ocean_pelist)) call fms_mpp_error(FATAL, 'coupler_flux_ice_to_ocean tried&
+                       &to set_current_pelist(slow_ice_ocean_pelist) but slow_ice_ocean_pelist is unknown')
+      call fms_mpp_set_current_pelist(slow_ice_ocean_pelist)
+    end if
+
+    call fms_mpp_clock_begin(coupler_clocks%flux_ice_to_ocean)
+    call flux_ice_to_ocean(Ice, Ocean, Ice_ocean_boundary)
+    call fms_mpp_clock_end(coupler_clocks%flux_ice_to_ocean)
+
+  end subroutine coupler_flux_ice_to_ocean
+
 end module full_coupler_mod

full/ice_ocean_flux_exchange.F90

@@ -224,9 +224,8 @@ end subroutine ice_ocean_flux_exchange_init
   !!       runoff = mass of calving since last time step (Kg/m2)
   !!       p_surf = surface pressure (Pa)
   !! </pre>
-  subroutine flux_ice_to_ocean ( Time, Ice, Ocean, Ice_Ocean_Boundary )
+  subroutine flux_ice_to_ocean ( Ice, Ocean, Ice_Ocean_Boundary )
 
-    type(FmsTime_type),                 intent(in)  :: Time !< Current time
     type(ice_data_type),             intent(in)  :: Ice  !< A derived data type to specify ice boundary data
     type(ocean_public_type),         intent(in)  :: Ocean !< A derived data type to specify ocean boundary data
     type(ice_ocean_boundary_type), intent(inout) :: Ice_Ocean_Boundary !< A derived data type to specify properties and fluxes
@@ -376,9 +375,8 @@ end subroutine flux_ice_to_ocean_finish
   !!
   !! \throw FATAL, "Ocean_Ice_Boundary%xtype must be DIRECT or REDIST."
   !!    The value of variable xtype of ice_ocean_boundary_type data must be DIRECT or REDIST.
-  subroutine flux_ocean_to_ice ( Time, Ocean, Ice, Ocean_Ice_Boundary )
+  subroutine flux_ocean_to_ice ( Ocean, Ice, Ocean_Ice_Boundary )
 
-    type(FmsTime_type),                 intent(in)  :: Time  !< Current time
     type(ocean_public_type),         intent(in)  :: Ocean !< A derived data type to specify ocean boundary data
     type(ice_data_type),             intent(in)  :: Ice   !< A derived data type to specify ice boundary data
     type(ocean_ice_boundary_type), intent(inout) :: Ocean_Ice_Boundary !< A derived data type to specify properties and fluxes