Skip to content

Commit

Permalink
Merge pull request #14 from TillRasmussen/evp-1d
Browse files Browse the repository at this point in the history 
Changes requested by @eclare108213 in CICE-Consortium#568
  • Loading branch information
@TillRasmussen
TillRasmussen authored Mar 14, 2021
2 parents 17d48d8 + a711bdc commit d669c8d
Show file tree
Hide file tree
Showing 7 changed files with 318 additions and 162 deletions.
86 changes: 43 additions & 43 deletions cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 --

Expand Down
2 changes: 1 addition & 1 deletion cicecore/cicedynB/general/ice_init.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
133 changes: 132 additions & 1 deletion cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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, &
Expand Down Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions cicecore/cicedynB/infrastructure/comm/mpi/ice_gather_scatter.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
Loading

0 comments on commit d669c8d

Please sign in to comment.