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.

Sign up for GitHub

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

Jump to bottom

Fix evp 1d masking issues #17

Merged
merged 1 commit into from
Jul 17, 2021
Merged

Fix evp 1d masking issues #17

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
200 changes: 101 additions & 99 deletions cicecore/cicedynB/dynamics/ice_dyn_evp.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -34,7 +34,7 @@
module ice_dyn_evp

use ice_kinds_mod
use ice_communicate, only: my_task
use ice_communicate, only: my_task, master_task
use ice_constants, only: field_loc_center, field_loc_NEcorner, &
field_type_scalar, field_type_vector
use ice_constants, only: c0, p027, p055, p111, p166, &
Expand Down Expand Up @@ -331,7 +331,7 @@ subroutine evp (dt)

if (seabed_stress) then

!$OMP PARALLEL DO PRIVATE(iblk)
!$OMP PARALLEL DO PRIVATE(iblk)
do iblk = 1, nblocks

if ( seabed_stress_method == 'LKD' ) then
Expand All @@ -351,113 +351,115 @@ subroutine evp (dt)
hwater(:,:,iblk), Tbu(:,:,iblk))
endif

enddo
enddo
!$OMP END PARALLEL DO
endif
call ice_timer_start(timer_evp_2d)
if (evp_algorithm == "shared_mem_1d" ) then
if (first_time .and. my_task == 0) then
write(nu_diag,'(3a)') subname,' Entering evp_algorithm version ',evp_algorithm
first_time = .false.
endif
if (trim(grid_type) == 'tripole') then

call abort_ice(trim(subname)//' &
& Kernel not tested on tripole grid. Set evp_algorithm=standard_2d')



endif
call ice_dyn_evp_1d_copyin( &
nx_block,ny_block,nblocks,nx_global+2*nghost,ny_global+2*nghost, &
icetmask, iceumask, &
cdn_ocn,aiu,uocn,vocn,forcex,forcey,Tbu, &
umassdti,fm,uarear,tarear,strintx,strinty,uvel_init,vvel_init,&
strength,uvel,vvel,dxt,dyt, &
stressp_1 ,stressp_2, stressp_3, stressp_4, &
stressm_1 ,stressm_2, stressm_3, stressm_4, &
stress12_1,stress12_2,stress12_3,stress12_4 )
call ice_timer_start(timer_evp_1d)
call ice_dyn_evp_1d_kernel()
call ice_timer_stop(timer_evp_1d)
call ice_dyn_evp_1d_copyout( &
nx_block,ny_block,nblocks,nx_global+2*nghost,ny_global+2*nghost,&
!strocn uvel,vvel, strocnx,strocny, strintx,strinty, &
uvel,vvel, strintx,strinty, &
stressp_1, stressp_2, stressp_3, stressp_4, &
stressm_1, stressm_2, stressm_3, stressm_4, &
stress12_1,stress12_2,stress12_3,stress12_4, &
divu,rdg_conv,rdg_shear,shear,taubx,tauby )

else ! evp_algorithm == standard_2d (Standard CICE)
call ice_timer_start(timer_evp_2d)

do ksub = 1,ndte ! subcycling
if (evp_algorithm == "shared_mem_1d" ) then

!-----------------------------------------------------------------
! stress tensor equation, total surface stress
!-----------------------------------------------------------------
if (first_time .and. my_task == master_task) then
write(nu_diag,'(3a)') subname,' Entering evp_algorithm version ',evp_algorithm
first_time = .false.
endif
if (trim(grid_type) == 'tripole') then
call abort_ice(trim(subname)//' &
& Kernel not tested on tripole grid. Set evp_algorithm=standard_2d')
endif

!$TCXOMP PARALLEL DO PRIVATE(iblk,strtmp)
do iblk = 1, nblocks
call ice_dyn_evp_1d_copyin( &
nx_block,ny_block,nblocks,nx_global+2*nghost,ny_global+2*nghost, &
icetmask, iceumask, &
cdn_ocn,aiu,uocn,vocn,forcex,forcey,Tbu, &
umassdti,fm,uarear,tarear,strintx,strinty,uvel_init,vvel_init,&
strength,uvel,vvel,dxt,dyt, &
stressp_1 ,stressp_2, stressp_3, stressp_4, &
stressm_1 ,stressm_2, stressm_3, stressm_4, &
stress12_1,stress12_2,stress12_3,stress12_4 )
call ice_timer_start(timer_evp_1d)
call ice_dyn_evp_1d_kernel()
call ice_timer_stop(timer_evp_1d)
call ice_dyn_evp_1d_copyout( &
nx_block,ny_block,nblocks,nx_global+2*nghost,ny_global+2*nghost,&
!strocn uvel,vvel, strocnx,strocny, strintx,strinty, &
uvel,vvel, strintx,strinty, &
stressp_1, stressp_2, stressp_3, stressp_4, &
stressm_1, stressm_2, stressm_3, stressm_4, &
stress12_1,stress12_2,stress12_3,stress12_4, &
divu,rdg_conv,rdg_shear,shear,taubx,tauby )

! if (trim(yield_curve) == 'ellipse') then
call stress (nx_block, ny_block, &
ksub, icellt(iblk), &
indxti (:,iblk), indxtj (:,iblk), &
uvel (:,:,iblk), vvel (:,:,iblk), &
dxt (:,:,iblk), dyt (:,:,iblk), &
dxhy (:,:,iblk), dyhx (:,:,iblk), &
cxp (:,:,iblk), cyp (:,:,iblk), &
cxm (:,:,iblk), cym (:,:,iblk), &
tarear (:,:,iblk), tinyarea (:,:,iblk), &
strength (:,:,iblk), &
stressp_1 (:,:,iblk), stressp_2 (:,:,iblk), &
stressp_3 (:,:,iblk), stressp_4 (:,:,iblk), &
stressm_1 (:,:,iblk), stressm_2 (:,:,iblk), &
stressm_3 (:,:,iblk), stressm_4 (:,:,iblk), &
stress12_1(:,:,iblk), stress12_2(:,:,iblk), &
stress12_3(:,:,iblk), stress12_4(:,:,iblk), &
shear (:,:,iblk), divu (:,:,iblk), &
rdg_conv (:,:,iblk), rdg_shear (:,:,iblk), &
strtmp (:,:,:) )
! endif ! yield_curve

!-----------------------------------------------------------------
! momentum equation
!-----------------------------------------------------------------

call stepu (nx_block, ny_block, &
icellu (iblk), Cdn_ocn (:,:,iblk), &
indxui (:,iblk), indxuj (:,iblk), &
ksub, &
aiu (:,:,iblk), strtmp (:,:,:), &
uocn (:,:,iblk), vocn (:,:,iblk), &
waterx (:,:,iblk), watery (:,:,iblk), &
forcex (:,:,iblk), forcey (:,:,iblk), &
umassdti (:,:,iblk), fm (:,:,iblk), &
uarear (:,:,iblk), &
strintx (:,:,iblk), strinty (:,:,iblk), &
taubx (:,:,iblk), tauby (:,:,iblk), &
uvel_init(:,:,iblk), vvel_init(:,:,iblk),&
uvel (:,:,iblk), vvel (:,:,iblk), &
Tbu (:,:,iblk))
enddo
!$TCXOMP END PARALLEL DO
else ! evp_algorithm == standard_2d (Standard CICE)

call stack_velocity_field(uvel, vvel, fld2)
call ice_timer_start(timer_bound)
if (maskhalo_dyn) then
call ice_HaloUpdate (fld2, halo_info_mask, &
field_loc_NEcorner, field_type_vector)
else
call ice_HaloUpdate (fld2, halo_info, &
field_loc_NEcorner, field_type_vector)
endif
call ice_timer_stop(timer_bound)
call unstack_velocity_field(fld2, uvel, vvel)
do ksub = 1,ndte ! subcycling

!-----------------------------------------------------------------
! stress tensor equation, total surface stress
!-----------------------------------------------------------------

!$TCXOMP PARALLEL DO PRIVATE(iblk,strtmp)
do iblk = 1, nblocks

! if (trim(yield_curve) == 'ellipse') then
call stress (nx_block, ny_block, &
ksub, icellt(iblk), &
indxti (:,iblk), indxtj (:,iblk), &
uvel (:,:,iblk), vvel (:,:,iblk), &
dxt (:,:,iblk), dyt (:,:,iblk), &
dxhy (:,:,iblk), dyhx (:,:,iblk), &
cxp (:,:,iblk), cyp (:,:,iblk), &
cxm (:,:,iblk), cym (:,:,iblk), &
tarear (:,:,iblk), tinyarea (:,:,iblk), &
strength (:,:,iblk), &
stressp_1 (:,:,iblk), stressp_2 (:,:,iblk), &
stressp_3 (:,:,iblk), stressp_4 (:,:,iblk), &
stressm_1 (:,:,iblk), stressm_2 (:,:,iblk), &
stressm_3 (:,:,iblk), stressm_4 (:,:,iblk), &
stress12_1(:,:,iblk), stress12_2(:,:,iblk), &
stress12_3(:,:,iblk), stress12_4(:,:,iblk), &
shear (:,:,iblk), divu (:,:,iblk), &
rdg_conv (:,:,iblk), rdg_shear (:,:,iblk), &
strtmp (:,:,:) )
! endif ! yield_curve

!-----------------------------------------------------------------
! momentum equation
!-----------------------------------------------------------------

call stepu (nx_block, ny_block, &
icellu (iblk), Cdn_ocn (:,:,iblk), &
indxui (:,iblk), indxuj (:,iblk), &
ksub, &
aiu (:,:,iblk), strtmp (:,:,:), &
uocn (:,:,iblk), vocn (:,:,iblk), &
waterx (:,:,iblk), watery (:,:,iblk), &
forcex (:,:,iblk), forcey (:,:,iblk), &
umassdti (:,:,iblk), fm (:,:,iblk), &
uarear (:,:,iblk), &
strintx (:,:,iblk), strinty (:,:,iblk), &
taubx (:,:,iblk), tauby (:,:,iblk), &
uvel_init(:,:,iblk), vvel_init(:,:,iblk),&
uvel (:,:,iblk), vvel (:,:,iblk), &
Tbu (:,:,iblk))

enddo
!$TCXOMP END PARALLEL DO

call stack_velocity_field(uvel, vvel, fld2)
call ice_timer_start(timer_bound)
if (maskhalo_dyn) then
call ice_HaloUpdate (fld2, halo_info_mask, &
field_loc_NEcorner, field_type_vector)
else
call ice_HaloUpdate (fld2, halo_info, &
field_loc_NEcorner, field_type_vector)
endif
call ice_timer_stop(timer_bound)
call unstack_velocity_field(fld2, uvel, vvel)

enddo ! subcycling
enddo ! subcycling
endif ! evp_algorithm

call ice_timer_stop(timer_evp_2d)

deallocate(fld2)
Expand Down
Loading