Changes requested by @eclare108213 in https://github.com/CICE-Consortium/CICE/pull/568

cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90

@@ -1185,49 +1185,49 @@ subroutine evp_copyin_v2(nx,ny,nblk,nx_glob,ny_glob,
     !---------------------------------------
     !-- Gather data into one single block --
 
-    call gather_global_ext(G_icetmask,   I_icetmask,   master_task, distrb_info, 0      )
-    call gather_global_ext(G_iceumask,   I_iceumask,   master_task, distrb_info, .false.)
-!v1 call gather_global_ext(G_dxhy,       I_dxhy,       master_task, distrb_info         )
-!v1 call gather_global_ext(G_dyhx,       I_dyhx,       master_task, distrb_info         )
-!v1 call gather_global_ext(G_cyp,        I_cyp,        master_task, distrb_info         )
-!v1 call gather_global_ext(G_cxp,        I_cxp,        master_task, distrb_info         )
-!v1 call gather_global_ext(G_cym,        I_cym,        master_task, distrb_info         )
-!v1 call gather_global_ext(G_cxm,        I_cxm,        master_task, distrb_info         )
-!v1 call gather_global_ext(G_tinyarea,   I_tinyarea,   master_task, distrb_info         )
-!v1 call gather_global_ext(G_waterx,     I_waterx,     master_task, distrb_info         )
-!v1 call gather_global_ext(G_watery,     I_watery,     master_task, distrb_info         )
-    call gather_global_ext(G_cdn_ocn,    I_cdn_ocn,    master_task, distrb_info         )
-    call gather_global_ext(G_aiu,        I_aiu,        master_task, distrb_info         )
-    call gather_global_ext(G_uocn,       I_uocn,       master_task, distrb_info         )
-    call gather_global_ext(G_vocn,       I_vocn,       master_task, distrb_info         )
-    call gather_global_ext(G_forcex,     I_forcex,     master_task, distrb_info         )
-    call gather_global_ext(G_forcey,     I_forcey,     master_task, distrb_info         )
-    call gather_global_ext(G_Tbu,        I_Tbu,        master_task, distrb_info         )
-    call gather_global_ext(G_umassdti,   I_umassdti,   master_task, distrb_info         )
-    call gather_global_ext(G_fm,         I_fm,         master_task, distrb_info         )
-    call gather_global_ext(G_uarear,     I_uarear,     master_task, distrb_info         )
-    call gather_global_ext(G_tarear,     I_tarear,     master_task, distrb_info         )
-    call gather_global_ext(G_strintx,    I_strintx,    master_task, distrb_info         )
-    call gather_global_ext(G_strinty,    I_strinty,    master_task, distrb_info         )
-    call gather_global_ext(G_uvel_init,  I_uvel_init,  master_task, distrb_info         )
-    call gather_global_ext(G_vvel_init,  I_vvel_init,  master_task, distrb_info         )
-    call gather_global_ext(G_strength,   I_strength,   master_task, distrb_info         )
-    call gather_global_ext(G_uvel,       I_uvel,       master_task, distrb_info, c0     )
-    call gather_global_ext(G_vvel,       I_vvel,       master_task, distrb_info, c0     )
-    call gather_global_ext(G_dxt,        I_dxt,        master_task, distrb_info         )
-    call gather_global_ext(G_dyt,        I_dyt,        master_task, distrb_info         )
-    call gather_global_ext(G_stressp_1,  I_stressp_1,  master_task, distrb_info         )
-    call gather_global_ext(G_stressp_2,  I_stressp_2,  master_task, distrb_info         )
-    call gather_global_ext(G_stressp_3,  I_stressp_3,  master_task, distrb_info         )
-    call gather_global_ext(G_stressp_4,  I_stressp_4,  master_task, distrb_info         )
-    call gather_global_ext(G_stressm_1,  I_stressm_1,  master_task, distrb_info         )
-    call gather_global_ext(G_stressm_2,  I_stressm_2,  master_task, distrb_info         )
-    call gather_global_ext(G_stressm_3,  I_stressm_3,  master_task, distrb_info         )
-    call gather_global_ext(G_stressm_4,  I_stressm_4,  master_task, distrb_info         )
-    call gather_global_ext(G_stress12_1, I_stress12_1, master_task, distrb_info         )
-    call gather_global_ext(G_stress12_2, I_stress12_2, master_task, distrb_info         )
-    call gather_global_ext(G_stress12_3, I_stress12_3, master_task, distrb_info         )
-    call gather_global_ext(G_stress12_4, I_stress12_4, master_task, distrb_info         )
+    call gather_global_ext(G_icetmask,   I_icetmask,   master_task, distrb_info    )
+    call gather_global_ext(G_iceumask,   I_iceumask,   master_task, distrb_info    )
+!v1 call gather_global_ext(G_dxhy,       I_dxhy,       master_task, distrb_info    )
+!v1 call gather_global_ext(G_dyhx,       I_dyhx,       master_task, distrb_info    )
+!v1 call gather_global_ext(G_cyp,        I_cyp,        master_task, distrb_info    )
+!v1 call gather_global_ext(G_cxp,        I_cxp,        master_task, distrb_info    )
+!v1 call gather_global_ext(G_cym,        I_cym,        master_task, distrb_info    )
+!v1 call gather_global_ext(G_cxm,        I_cxm,        master_task, distrb_info    )
+!v1 call gather_global_ext(G_tinyarea,   I_tinyarea,   master_task, distrb_info    )
+!v1 call gather_global_ext(G_waterx,     I_waterx,     master_task, distrb_info    )
+!v1 call gather_global_ext(G_watery,     I_watery,     master_task, distrb_info    )
+    call gather_global_ext(G_cdn_ocn,    I_cdn_ocn,    master_task, distrb_info    )
+    call gather_global_ext(G_aiu,        I_aiu,        master_task, distrb_info    )
+    call gather_global_ext(G_uocn,       I_uocn,       master_task, distrb_info    )
+    call gather_global_ext(G_vocn,       I_vocn,       master_task, distrb_info    )
+    call gather_global_ext(G_forcex,     I_forcex,     master_task, distrb_info    )
+    call gather_global_ext(G_forcey,     I_forcey,     master_task, distrb_info    )
+    call gather_global_ext(G_Tbu,        I_Tbu,        master_task, distrb_info    )
+    call gather_global_ext(G_umassdti,   I_umassdti,   master_task, distrb_info    )
+    call gather_global_ext(G_fm,         I_fm,         master_task, distrb_info    )
+    call gather_global_ext(G_uarear,     I_uarear,     master_task, distrb_info    )
+    call gather_global_ext(G_tarear,     I_tarear,     master_task, distrb_info    )
+    call gather_global_ext(G_strintx,    I_strintx,    master_task, distrb_info    )
+    call gather_global_ext(G_strinty,    I_strinty,    master_task, distrb_info    )
+    call gather_global_ext(G_uvel_init,  I_uvel_init,  master_task, distrb_info    )
+    call gather_global_ext(G_vvel_init,  I_vvel_init,  master_task, distrb_info    )
+    call gather_global_ext(G_strength,   I_strength,   master_task, distrb_info    )
+    call gather_global_ext(G_uvel,       I_uvel,       master_task, distrb_info, c0)
+    call gather_global_ext(G_vvel,       I_vvel,       master_task, distrb_info, c0)
+    call gather_global_ext(G_dxt,        I_dxt,        master_task, distrb_info    )
+    call gather_global_ext(G_dyt,        I_dyt,        master_task, distrb_info    )
+    call gather_global_ext(G_stressp_1,  I_stressp_1,  master_task, distrb_info    )
+    call gather_global_ext(G_stressp_2,  I_stressp_2,  master_task, distrb_info    )
+    call gather_global_ext(G_stressp_3,  I_stressp_3,  master_task, distrb_info    )
+    call gather_global_ext(G_stressp_4,  I_stressp_4,  master_task, distrb_info    )
+    call gather_global_ext(G_stressm_1,  I_stressm_1,  master_task, distrb_info    )
+    call gather_global_ext(G_stressm_2,  I_stressm_2,  master_task, distrb_info    )
+    call gather_global_ext(G_stressm_3,  I_stressm_3,  master_task, distrb_info    )
+    call gather_global_ext(G_stressm_4,  I_stressm_4,  master_task, distrb_info    )
+    call gather_global_ext(G_stress12_1, I_stress12_1, master_task, distrb_info    )
+    call gather_global_ext(G_stress12_2, I_stress12_2, master_task, distrb_info    )
+    call gather_global_ext(G_stress12_3, I_stress12_3, master_task, distrb_info    )
+    call gather_global_ext(G_stress12_4, I_stress12_4, master_task, distrb_info    )
 
     !-- All calculations has to be done on the master-task --
 

cicecore/cicedynB/general/ice_init.F90

@@ -315,7 +315,7 @@ subroutine input_data
       ndtd = 1           ! dynamic time steps per thermodynamic time step
       ndte = 120         ! subcycles per dynamics timestep:  ndte=dt_dyn/dte
       kevp_kernel = 0    ! EVP kernel (0 = 2D, >0: 1D. Only ver. 2 is implemented yet)
-      pgl_global_ext = .false. ! if true, init primary grid lebgths (global ext.)
+      pgl_global_ext = .false. ! if true, init primary grid lengths (global ext.)
       brlx   = 300.0_dbl_kind ! revised_evp values. Otherwise overwritten in ice_dyn_shared
       arlx   = 300.0_dbl_kind ! revised_evp values. Otherwise overwritten in ice_dyn_shared
       revised_evp = .false.  ! if true, use revised procedure for evp dynamics

cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90

@@ -72,7 +72,8 @@ module ice_boundary
              ice_HaloUpdate, &
              ice_HaloUpdate_stress, &
              ice_HaloExtrapolate, &
-             ice_HaloDestroy
+             ice_HaloDestroy, &
+             primary_grid_lengths_global_ext
 
    interface ice_HaloUpdate  ! generic interface
       module procedure ice_HaloUpdate2DR8, &
@@ -6733,6 +6734,136 @@ subroutine ice_HaloDestroy(halo)
    endif
 end subroutine ice_HaloDestroy
 
+!***********************************************************************
+
+ subroutine primary_grid_lengths_global_ext( &
+   ARRAY_O, ARRAY_I, ew_boundary_type, ns_boundary_type)
+
+!  This subroutine adds ghost cells to global primary grid lengths array
+!  ARRAY_I and outputs result to array ARRAY_O
+
+!  Note duplicate implementation of this subroutine in:
+!  cicecore/cicedynB/infrastructure/comm/serial/ice_boundary.F90
+
+   use ice_constants, only: c0
+   use ice_domain_size, only: nx_global, ny_global
+
+   real (kind=dbl_kind), dimension(:,:), intent(in) :: &
+      ARRAY_I
+
+   character (*), intent(in) :: &
+      ew_boundary_type, ns_boundary_type
+
+   real (kind=dbl_kind), dimension(:,:), intent(out) :: &
+      ARRAY_O
+
+!-----------------------------------------------------------------------
+!
+!  local variables
+!
+!-----------------------------------------------------------------------
+
+   integer (kind=int_kind) :: &
+      ii, io, ji, jo
+
+   character(len=*), parameter :: &
+      subname = '(primary_grid_lengths_global_ext)'
+
+!-----------------------------------------------------------------------
+!
+!  add ghost cells to global primary grid lengths array
+!
+!-----------------------------------------------------------------------
+
+   if (trim(ns_boundary_type) == 'tripole' .or. &
+       trim(ns_boundary_type) == 'tripoleT') then
+      call abort_ice(subname//' ERROR: '//ns_boundary_type &
+         //' boundary type not implemented for configuration')
+   endif
+
+   do jo = 1,ny_global+2*nghost
+      ji = -nghost + jo
+
+      !*** Southern ghost cells
+
+      if (ji < 1) then
+         select case (trim(ns_boundary_type))
+         case ('cyclic')
+            ji = ji + ny_global
+         case ('open')
+            ji = nghost - jo + 1
+         case ('closed')
+            ji = 0
+         case default
+            call abort_ice( &
+               subname//' ERROR: unknown north-south boundary type')
+         end select
+      endif
+
+      !*** Northern ghost cells
+
+      if (ji > ny_global) then
+         select case (trim(ns_boundary_type))
+         case ('cyclic')
+            ji = ji - ny_global
+         case ('open')
+            ji = 2 * ny_global - ji + 1
+         case ('closed')
+            ji = 0
+         case default
+            call abort_ice( &
+               subname//' ERROR: unknown north-south boundary type')
+         end select
+      endif
+
+      do io = 1,nx_global+2*nghost
+         ii = -nghost + io
+
+         !*** Western ghost cells
+
+         if (ii < 1) then
+            select case (trim(ew_boundary_type))
+            case ('cyclic')
+               ii = ii + nx_global
+            case ('open')
+               ii = nghost - io + 1
+            case ('closed')
+               ii = 0
+            case default
+               call abort_ice( &
+                  subname//' ERROR: unknown east-west boundary type')
+            end select
+         endif
+
+         !*** Eastern ghost cells
+
+         if (ii > nx_global) then
+            select case (trim(ew_boundary_type))
+            case ('cyclic')
+               ii = ii - nx_global
+            case ('open')
+               ii = 2 * nx_global - ii + 1
+            case ('closed')
+               ii = 0
+            case default
+               call abort_ice( &
+                  subname//' ERROR: unknown east-west boundary type')
+            end select
+         endif
+
+         if (ii == 0 .or. ji == 0) then
+            ARRAY_O(io, jo) = c0
+         else
+            ARRAY_O(io, jo) = ARRAY_I(ii, ji)
+         endif
+
+      enddo
+   enddo
+
+!-----------------------------------------------------------------------
+
+ end subroutine primary_grid_lengths_global_ext
+
 !***********************************************************************
 
 end module ice_boundary

cicecore/cicedynB/infrastructure/comm/mpi/ice_gather_scatter.F90

@@ -1028,7 +1028,7 @@ subroutine gather_global_ext_int(ARRAY_G, ARRAY, dst_task, src_dist, spc_val)
    if (present(spc_val)) then
       special_value = spc_val
    else
-      special_value = 0   !MHRI NOTE: 0,1,-999,???
+      special_value = 0
    endif
 
    nx = nx_global + 2*nghost
@@ -1351,7 +1351,7 @@ subroutine gather_global_ext_log(ARRAY_G, ARRAY, dst_task, src_dist, spc_val)
    if (present(spc_val)) then
       special_value = spc_val
    else
-      special_value = .false.   !MHRI NOTE: .true./.false.  ???
+      special_value = .false.
    endif
 
    nx = nx_global + 2*nghost