From 297aa57cfe51167ccbb00b159cef5823b7f98675 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Tue, 10 Nov 2020 10:37:11 -0500 Subject: [PATCH] Update CICE to consortium master (#23) updates include: * deprecate upwind advection (CICE-Consortium#508) * add implicit VP solver (CICE-Consortium#491) update icepack update gitmodules, update icepack switch icepack branches * update to icepack master but set abort flag in ITD routine to false update icepack --- cicecore/cicedyn/dynamics/ice_dyn_eap.F90 | 1953 ++++----- cicecore/cicedyn/general/ice_forcing.F90 | 14 +- cicecore/cicedyn/general/ice_step_mod.F90 | 4 +- .../comm/mpi/ice_global_reductions.F90 | 70 + .../comm/serial/ice_global_reductions.F90 | 70 + cicecore/cicedynB/dynamics/ice_dyn_evp.F90 | 872 ++++ cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90 | 2135 ++++++++++ cicecore/cicedynB/dynamics/ice_dyn_shared.F90 | 280 +- cicecore/cicedynB/dynamics/ice_dyn_vp.F90 | 3689 +++++++++++++++++ cicecore/cicedynB/general/ice_init.F90 | 150 +- cicecore/cicedynB/infrastructure/ice_grid.F90 | 1 + .../drivers/direct/hadgem3/CICE_InitMod.F90 | 10 +- cicecore/drivers/mct/cesm1/CICE_InitMod.F90 | 10 +- cicecore/drivers/mct/cesm1/CICE_RunMod.F90 | 5 + cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 | 38 +- cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 | 9 +- cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 | 5 + .../drivers/standalone/cice/CICE_InitMod.F90 | 10 +- .../drivers/standalone/cice/CICE_RunMod.F90 | 3 +- .../drivers/unittest/opticep/CICE_RunMod.F90 | 5 + configuration/scripts/ice_in | 15 + .../scripts/machines/Macros.conda_macos | 18 +- .../scripts/machines/Macros.gpsc3_intel | 33 +- .../scripts/machines/Macros.ppp3_intel | 33 +- .../scripts/options/set_nml.dynanderson | 2 - .../scripts/options/set_nml.dynpicard | 1 - configuration/scripts/options/set_nml.run3dt | 3 +- configuration/scripts/tests/base_suite.ts | 33 +- doc/source/cice_index.rst | 2 +- doc/source/developer_guide/dg_dynamics.rst | 10 +- doc/source/master_list.bib | 339 +- doc/source/science_guide/sg_dynamics.rst | 592 +-- doc/source/user_guide/ug_case_settings.rst | 19 + 33 files changed, 8744 insertions(+), 1689 deletions(-) create mode 100644 cicecore/cicedynB/dynamics/ice_dyn_evp.F90 create mode 100644 cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90 create mode 100644 cicecore/cicedynB/dynamics/ice_dyn_vp.F90 diff --git a/cicecore/cicedyn/dynamics/ice_dyn_eap.F90 b/cicecore/cicedyn/dynamics/ice_dyn_eap.F90 index cc85d8ab6..e6bb86bff 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_eap.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_eap.F90 @@ -5,14 +5,14 @@ ! ! See: ! -! Wilchinsky, A.V. and D.L. Feltham (2006). Modelling the rheology of -! sea ice as a collection of diamond-shaped floes. +! Wilchinsky, A.V. and D.L. Feltham (2006). Modelling the rheology of +! sea ice as a collection of diamond-shaped floes. ! Journal of Non-Newtonian Fluid Mechanics, 138(1), 22-32. ! ! Tsamados, M., D.L. Feltham, and A.V. Wilchinsky (2013). Impact on new ! anisotropic rheology on simulations of Arctic sea ice. JGR, 118, 91-107. ! -! authors: Michel Tsamados, CPOM +! authors: Michel Tsamados, CPOM ! David Schroeder, CPOM module ice_dyn_eap @@ -25,64 +25,80 @@ module ice_dyn_eap p001, p027, p055, p111, p166, p222, p25, p333 use ice_fileunits, only: nu_diag, nu_dump_eap, nu_restart_eap use ice_exit, only: abort_ice - use ice_flux, only: rdg_shear -! use ice_timers, only: & -! ice_timer_start, ice_timer_stop, & -! timer_tmp1, timer_tmp2, timer_tmp3, timer_tmp4, & -! timer_tmp5, timer_tmp6, timer_tmp7, timer_tmp8, timer_tmp9 - use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters use icepack_intfc, only: icepack_ice_strength implicit none private - public :: eap, init_eap, write_restart_eap, read_restart_eap + public :: eap, init_eap, write_restart_eap, read_restart_eap, & + alloc_dyn_eap ! Look-up table needed for calculating structure tensor - integer (int_kind), parameter :: & - nx_yield = 41, & - ny_yield = 41, & - na_yield = 21 + integer (int_kind), parameter :: & + nx_yield = 41, & + ny_yield = 41, & + na_yield = 21 - real (kind=dbl_kind), dimension (nx_yield,ny_yield,na_yield) :: & - s11r, s12r, s22r, s11s, s12s, s22s + real (kind=dbl_kind), dimension (nx_yield,ny_yield,na_yield) :: & + s11r, s12r, s22r, s11s, s12s, s22s real (kind=dbl_kind), dimension (:,:,:), allocatable :: & - a11_1, a11_2, a11_3, a11_4, & ! components of - a12_1, a12_2, a12_3, a12_4 ! structure tensor + a11_1, a11_2, a11_3, a11_4, & ! components of + a12_1, a12_2, a12_3, a12_4 ! structure tensor ! history real (kind=dbl_kind), dimension(:,:,:), allocatable, public :: & - e11 , & ! components of strain rate tensor (1/s) - e12 , & - e22 , & + e11 , & ! components of strain rate tensor (1/s) + e12 , & + e22 , & yieldstress11, & ! components of yield stress tensor (kg/s^2) yieldstress12, & yieldstress22, & - s11 , & ! components of stress tensor (kg/s^2) - s12 , & - s22 , & - a11 , & ! components of structure tensor () + s11 , & ! components of stress tensor (kg/s^2) + s12 , & + s22 , & + a11 , & ! components of structure tensor () a12 - ! private for reuse, set in init_eap - - real (kind=dbl_kind) :: & - puny, pi, pi2, piq, pih +!======================================================================= - real (kind=dbl_kind), parameter :: & - kfriction = 0.45_dbl_kind + contains - real (kind=dbl_kind), save :: & - invdx, invdy, invda, invsin +!======================================================================= +! +! Allocate space for all variables +! + subroutine alloc_dyn_eap + integer (int_kind) :: ierr -!======================================================================= + allocate( a11_1 (nx_block,ny_block,max_blocks), & + a11_2 (nx_block,ny_block,max_blocks), & + a11_3 (nx_block,ny_block,max_blocks), & + a11_4 (nx_block,ny_block,max_blocks), & + a12_1 (nx_block,ny_block,max_blocks), & + a12_2 (nx_block,ny_block,max_blocks), & + a12_3 (nx_block,ny_block,max_blocks), & + a12_4 (nx_block,ny_block,max_blocks), & + e11 (nx_block,ny_block,max_blocks), & + e12 (nx_block,ny_block,max_blocks), & + e22 (nx_block,ny_block,max_blocks), & + yieldstress11(nx_block,ny_block,max_blocks), & + yieldstress12(nx_block,ny_block,max_blocks), & + yieldstress22(nx_block,ny_block,max_blocks), & + s11 (nx_block,ny_block,max_blocks), & + s12 (nx_block,ny_block,max_blocks), & + s22 (nx_block,ny_block,max_blocks), & + a11 (nx_block,ny_block,max_blocks), & + a12 (nx_block,ny_block,max_blocks), & + stat=ierr) + if (ierr/=0) call abort_ice('(alloc_dyn_eap): Out of memory') - contains + end subroutine alloc_dyn_eap !======================================================================= +! ! Elastic-anisotropic-plastic dynamics driver ! based on subroutine evp @@ -90,9 +106,9 @@ subroutine eap (dt) #ifdef CICE_IN_NEMO ! Wind stress is set during this routine from the values supplied -! via NEMO (unless calc_strair is true). These values are supplied -! rotated on u grid and multiplied by aice. strairxT = 0 in this -! case so operations in dyn_prep1 are pointless but carried out to +! via NEMO (unless calc_strair is true). These values are supplied +! rotated on u grid and multiplied by aice. strairxT = 0 in this +! case so operations in dyn_prep1 are pointless but carried out to ! minimise code changes. #endif @@ -106,23 +122,23 @@ subroutine eap (dt) use ice_dyn_shared, only: fcor_blk, ndte, dtei, & denom1, uvel_init, vvel_init, arlx1i, & dyn_prep1, dyn_prep2, stepu, dyn_finish, & - seabed_stress_factor_LKD, seabed_stress_factor_prob, & - seabed_stress_method, seabed_stress, & - stack_fields, unstack_fields, iceTmask, iceUmask, & - fld2, fld3, fld4, dxhy, dyhx, cxp, cyp, cxm, cym + basal_stress_coeff, basalstress, & + stack_velocity_field, unstack_velocity_field use ice_flux, only: rdg_conv, strairxT, strairyT, & - strairxU, strairyU, uocn, vocn, ss_tltx, ss_tlty, fmU, & - strtltxU, strtltyU, strocnxU, strocnyU, strintxU, strintyU, taubxU, taubyU, & - strax, stray, & - TbU, hwater, & + strairx, strairy, uocn, vocn, ss_tltx, ss_tlty, iceumask, fm, & + strtltx, strtlty, strocnx, strocny, strintx, strinty, taubx, tauby, & + strocnxT, strocnyT, strax, stray, & + Tbu, hwater, & stressp_1, stressp_2, stressp_3, stressp_4, & stressm_1, stressm_2, stressm_3, stressm_4, & stress12_1, stress12_2, stress12_3, stress12_4 - use ice_grid, only: tmask, umask, dxT, dyT, dxU, dyU, & - tarear, uarear, grid_average_X2Y, & - grid_atm_dynu, grid_atm_dynv, grid_ocn_dynu, grid_ocn_dynv - use ice_state, only: aice, aiU, vice, vsno, uvel, vvel, divu, shear, vort, & + use ice_grid, only: tmask, umask, dxt, dyt, dxhy, dyhx, cxp, cyp, cxm, cym, & + tarear, uarear, to_ugrid, t2ugrid_vector, u2tgrid_vector + use ice_state, only: aice, vice, vsno, uvel, vvel, divu, shear, & aice_init, aice0, aicen, vicen, strength +! use ice_timers, only: timer_dynamics, timer_bound, & +! ice_timer_start, ice_timer_stop, & +! timer_tmp1, timer_tmp2, timer_tmp3 use ice_timers, only: timer_dynamics, timer_bound, & ice_timer_start, ice_timer_stop @@ -131,51 +147,49 @@ subroutine eap (dt) ! local variables - integer (kind=int_kind) :: & - ksub , & ! subcycle step - iblk , & ! block index + integer (kind=int_kind) :: & + ksub , & ! subcycle step + iblk , & ! block index ilo,ihi,jlo,jhi, & ! beginning and end of physical domain i, j, ij - integer (kind=int_kind), dimension(max_blocks) :: & - icellT , & ! no. of cells where iceTmask = .true. - icellU ! no. of cells where iceUmask = .true. + integer (kind=int_kind), dimension(max_blocks) :: & + icellt , & ! no. of cells where icetmask = 1 + icellu ! no. of cells where iceumask = 1 integer (kind=int_kind), dimension (nx_block*ny_block, max_blocks) :: & - indxTi , & ! compressed index in i-direction - indxTj , & ! compressed index in j-direction - indxUi , & ! compressed index in i-direction - indxUj ! compressed index in j-direction + indxti , & ! compressed index in i-direction + indxtj , & ! compressed index in j-direction + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & - uocnU , & ! i ocean current (m/s) - vocnU , & ! j ocean current (m/s) - ss_tltxU , & ! sea surface slope, x-direction (m/m) - ss_tltyU , & ! sea surface slope, y-direction (m/m) - cdn_ocnU , & ! ocn drag coefficient - tmass , & ! total mass of ice and snow (kg/m^2) - waterxU , & ! for ocean stress calculation, x (m/s) - wateryU , & ! for ocean stress calculation, y (m/s) - forcexU , & ! work array: combined atm stress and ocn tilt, x - forceyU , & ! work array: combined atm stress and ocn tilt, y - umass , & ! total mass of ice and snow (u grid) - umassdti ! mass of U-cell/dte (kg/m^2 s) + tmass , & ! total mass of ice and snow (kg/m^2) + waterx , & ! for ocean stress calculation, x (m/s) + watery , & ! for ocean stress calculation, y (m/s) + forcex , & ! work array: combined atm stress and ocn tilt, x + forcey , & ! work array: combined atm stress and ocn tilt, y + aiu , & ! ice fraction on u-grid + umass , & ! total mass of ice and snow (u grid) + umassdti ! mass of U-cell/dte (kg/m^2 s) + + real (kind=dbl_kind), allocatable :: fld2(:,:,:,:) real (kind=dbl_kind), dimension(nx_block,ny_block,8):: & - strtmp ! stress combinations for momentum equation + strtmp ! stress combinations for momentum equation - logical (kind=log_kind) :: & - calc_strair + logical (kind=log_kind) :: calc_strair integer (kind=int_kind), dimension (nx_block,ny_block,max_blocks) :: & - halomask ! ice mask for halo update + icetmask, & ! ice extent mask (T-cell) + halomask ! ice mask for halo update type (ice_halo) :: & halo_info_mask ! ghost cell update info for masked halo type (block) :: & - this_block ! block information for current block - + this_block ! block information for current block + character(len=*), parameter :: subname = '(eap)' call ice_timer_start(timer_dynamics) ! dynamics @@ -184,18 +198,19 @@ subroutine eap (dt) ! Initialize !----------------------------------------------------------------- + allocate(fld2(nx_block,ny_block,2,max_blocks)) + ! This call is needed only if dt changes during runtime. ! call set_evp_parameters (dt) - !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) SCHEDULE(runtime) + !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks - do j = 1, ny_block - do i = 1, nx_block - rdg_conv (i,j,iblk) = c0 - rdg_shear(i,j,iblk) = c0 ! always zero. Could be moved - divu (i,j,iblk) = c0 - shear(i,j,iblk) = c0 - vort(i,j,iblk) = c0 + do j = 1, ny_block + do i = 1, nx_block + rdg_conv (i,j,iblk) = c0 +! rdg_shear(i,j,iblk) = c0 + divu (i,j,iblk) = c0 + shear(i,j,iblk) = c0 e11(i,j,iblk) = c0 e12(i,j,iblk) = c0 e22(i,j,iblk) = c0 @@ -208,27 +223,29 @@ subroutine eap (dt) enddo enddo - !----------------------------------------------------------------- - ! preparation for dynamics - !----------------------------------------------------------------- + !----------------------------------------------------------------- + ! preparation for dynamics + !----------------------------------------------------------------- - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo jhi = this_block%jhi - call dyn_prep1 (nx_block, ny_block, & + call dyn_prep1 (nx_block, ny_block, & ilo, ihi, jlo, jhi, & - aice (:,:,iblk), vice (:,:,iblk), & - vsno (:,:,iblk), tmask (:,:,iblk), & - tmass (:,:,iblk), iceTmask(:,:,iblk)) + aice (:,:,iblk), vice (:,:,iblk), & + vsno (:,:,iblk), tmask (:,:,iblk), & + strairxT(:,:,iblk), strairyT(:,:,iblk), & + strairx (:,:,iblk), strairy (:,:,iblk), & + tmass (:,:,iblk), icetmask(:,:,iblk)) enddo ! iblk !$OMP END PARALLEL DO call ice_timer_start(timer_bound) - call ice_HaloUpdate (iceTmask, halo_info, & + call ice_HaloUpdate (icetmask, halo_info, & field_loc_center, field_type_scalar) call ice_timer_stop(timer_bound) @@ -236,133 +253,110 @@ subroutine eap (dt) ! convert fields from T to U grid !----------------------------------------------------------------- - call stack_fields(tmass, aice_init, cdn_ocn, fld3) - call ice_HaloUpdate (fld3, halo_info, & - field_loc_center, field_type_scalar) - call stack_fields(uocn, vocn, ss_tltx, ss_tlty, fld4) - call ice_HaloUpdate (fld4, halo_info, & - field_loc_center, field_type_vector) - call unstack_fields(fld3, tmass, aice_init, cdn_ocn) - call unstack_fields(fld4, uocn, vocn, ss_tltx, ss_tlty) - - call grid_average_X2Y('S', tmass , 'T' , umass , 'U') - call grid_average_X2Y('S', aice_init, 'T' , aiU , 'U') - call grid_average_X2Y('S', cdn_ocn , 'T' , cdn_ocnU, 'U') - call grid_average_X2Y('S', uocn , grid_ocn_dynu, uocnU , 'U') - call grid_average_X2Y('S', vocn , grid_ocn_dynv, vocnU , 'U') - call grid_average_X2Y('S', ss_tltx , grid_ocn_dynu, ss_tltxU, 'U') - call grid_average_X2Y('S', ss_tlty , grid_ocn_dynv, ss_tltyU, 'U') + call to_ugrid(tmass,umass) + call to_ugrid(aice_init, aiu) !---------------------------------------------------------------- ! Set wind stress to values supplied via NEMO or other forcing ! This wind stress is rotated on u grid and multiplied by aice !---------------------------------------------------------------- - call icepack_query_parameters(calc_strair_out=calc_strair) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - if (.not. calc_strair) then - call grid_average_X2Y('F', strax, grid_atm_dynu, strairxU, 'U') - call grid_average_X2Y('F', stray, grid_atm_dynv, strairyU, 'U') + if (.not. calc_strair) then + strairx(:,:,:) = strax(:,:,:) + strairy(:,:,:) = stray(:,:,:) else - call ice_HaloUpdate (strairxT, halo_info, & - field_loc_center, field_type_vector) - call ice_HaloUpdate (strairyT, halo_info, & - field_loc_center, field_type_vector) - call grid_average_X2Y('F', strairxT, 'T', strairxU, 'U') - call grid_average_X2Y('F', strairyT, 'T', strairyU, 'U') + call t2ugrid_vector(strairx) + call t2ugrid_vector(strairy) endif - !$OMP PARALLEL DO PRIVATE(iblk,ilo,ihi,jlo,jhi,this_block,ij,i,j) SCHEDULE(runtime) +! tcraig, tcx, turned off this threaded region, in evp, this block and +! the icepack_ice_strength call seems to not be thread safe. more +! debugging needed + !$TCXOMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks - !----------------------------------------------------------------- - ! more preparation for dynamics - !----------------------------------------------------------------- + !----------------------------------------------------------------- + ! more preparation for dynamics + !----------------------------------------------------------------- - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo jhi = this_block%jhi - call dyn_prep2 (nx_block, ny_block, & + call dyn_prep2 (nx_block, ny_block, & ilo, ihi, jlo, jhi, & - icellT (iblk), icellU (iblk), & - indxTi (:,iblk), indxTj (:,iblk), & - indxUi (:,iblk), indxUj (:,iblk), & - aiU (:,:,iblk), umass (:,:,iblk), & - umassdti (:,:,iblk), fcor_blk (:,:,iblk), & - umask (:,:,iblk), & - uocnU (:,:,iblk), vocnU (:,:,iblk), & - strairxU (:,:,iblk), strairyU (:,:,iblk), & - ss_tltxU (:,:,iblk), ss_tltyU (:,:,iblk), & - iceTmask (:,:,iblk), iceUmask (:,:,iblk), & - fmU (:,:,iblk), dt, & - strtltxU (:,:,iblk), strtltyU (:,:,iblk), & - strocnxU (:,:,iblk), strocnyU (:,:,iblk), & - strintxU (:,:,iblk), strintyU (:,:,iblk), & - taubxU (:,:,iblk), taubyU (:,:,iblk), & - waterxU (:,:,iblk), wateryU (:,:,iblk), & - forcexU (:,:,iblk), forceyU (:,:,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), & + icellt(iblk), icellu(iblk), & + indxti (:,iblk), indxtj (:,iblk), & + indxui (:,iblk), indxuj (:,iblk), & + aiu (:,:,iblk), umass (:,:,iblk), & + umassdti (:,:,iblk), fcor_blk (:,:,iblk), & + umask (:,:,iblk), & + uocn (:,:,iblk), vocn (:,:,iblk), & + strairx (:,:,iblk), strairy (:,:,iblk), & + ss_tltx (:,:,iblk), ss_tlty (:,:,iblk), & + icetmask (:,:,iblk), iceumask (:,:,iblk), & + fm (:,:,iblk), dt, & + strtltx (:,:,iblk), strtlty (:,:,iblk), & + strocnx (:,:,iblk), strocny (:,:,iblk), & + strintx (:,:,iblk), strinty (:,:,iblk), & + taubx (:,:,iblk), tauby (:,:,iblk), & + waterx (:,:,iblk), watery (:,:,iblk), & + forcex (:,:,iblk), forcey (:,:,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), & uvel_init (:,:,iblk), vvel_init (:,:,iblk), & uvel (:,:,iblk), vvel (:,:,iblk), & - TbU (:,:,iblk)) + Tbu (:,:,iblk)) - !----------------------------------------------------------------- - ! Initialize structure tensor - !----------------------------------------------------------------- + !----------------------------------------------------------------- + ! Initialize structure tensor + !----------------------------------------------------------------- do j = 1, ny_block do i = 1, nx_block - if (.not.iceTmask(i,j,iblk)) then - if (tmask(i,j,iblk)) then - ! structure tensor - a11_1(i,j,iblk) = p5 - a11_2(i,j,iblk) = p5 - a11_3(i,j,iblk) = p5 - a11_4(i,j,iblk) = p5 - else - a11_1(i,j,iblk) = c0 - a11_2(i,j,iblk) = c0 - a11_3(i,j,iblk) = c0 - a11_4(i,j,iblk) = c0 - endif + if (icetmask(i,j,iblk)==0) then + ! structure tensor + a11_1(i,j,iblk) = p5 + a11_2(i,j,iblk) = p5 + a11_3(i,j,iblk) = p5 + a11_4(i,j,iblk) = p5 a12_1(i,j,iblk) = c0 a12_2(i,j,iblk) = c0 a12_3(i,j,iblk) = c0 a12_4(i,j,iblk) = c0 - endif ! iceTmask + endif ! icetmask enddo ! i enddo ! j - !----------------------------------------------------------------- - ! ice strength - ! New strength used in Ukita Moritz rheology - !----------------------------------------------------------------- + !----------------------------------------------------------------- + ! ice strength + ! New strength used in Ukita Moritz rheology + !----------------------------------------------------------------- strength(:,:,iblk) = c0 ! initialize - do ij = 1, icellT(iblk) - i = indxTi(ij, iblk) - j = indxTj(ij, iblk) + do ij = 1, icellt(iblk) + i = indxti(ij, iblk) + j = indxtj(ij, iblk) call icepack_ice_strength(ncat=ncat, & - aice = aice (i,j, iblk), & - vice = vice (i,j, iblk), & - aice0 = aice0 (i,j, iblk), & - aicen = aicen (i,j,:,iblk), & - vicen = vicen (i,j,:,iblk), & + aice = aice (i,j, iblk), & + vice = vice (i,j, iblk), & + aice0 = aice0 (i,j, iblk), & + aicen = aicen (i,j,:,iblk), & + vicen = vicen (i,j,:,iblk), & strength = strength(i,j, iblk) ) enddo ! ij enddo ! iblk - !$OMP END PARALLEL DO + !$TCXOMP END PARALLEL DO call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -372,16 +366,16 @@ subroutine eap (dt) call ice_HaloUpdate (strength, halo_info, & field_loc_center, field_type_scalar) ! velocities may have changed in dyn_prep2 - call stack_fields(uvel, vvel, fld2) + call stack_velocity_field(uvel, vvel, fld2) call ice_HaloUpdate (fld2, halo_info, & field_loc_NEcorner, field_type_vector) - call unstack_fields(fld2, uvel, vvel) + call unstack_velocity_field(fld2, uvel, vvel) call ice_timer_stop(timer_bound) if (maskhalo_dyn) then call ice_timer_start(timer_bound) halomask = 0 - where (iceUmask) halomask = 1 + where (iceumask) halomask = 1 call ice_HaloUpdate (halomask, halo_info, & field_loc_center, field_type_scalar) call ice_timer_stop(timer_bound) @@ -389,60 +383,46 @@ subroutine eap (dt) endif !----------------------------------------------------------------- - ! seabed stress factor TbU (TbU is part of Cb coefficient) + ! basal stress coefficients (landfast ice) !----------------------------------------------------------------- - - if (seabed_stress) then - if ( seabed_stress_method == 'LKD' ) then - !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime) - do iblk = 1, nblocks - call seabed_stress_factor_LKD (nx_block , ny_block , & - icellU (iblk), & - indxUi (:,iblk), indxUj(:,iblk), & - vice (:,:,iblk), aice(:,:,iblk), & - hwater(:,:,iblk), TbU (:,:,iblk)) - enddo - !$OMP END PARALLEL DO - - elseif ( seabed_stress_method == 'probabilistic' ) then - !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime) - do iblk = 1, nblocks - call seabed_stress_factor_prob (nx_block , ny_block , & - icellT(iblk), indxTi(:,iblk), indxTj(:,iblk), & - icellU(iblk), indxUi(:,iblk), indxUj(:,iblk), & - aicen(:,:,:,iblk), vicen(:,:,:,iblk), & - hwater (:,:,iblk), TbU (:,:,iblk)) - enddo - !$OMP END PARALLEL DO - endif + + if (basalstress) then + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call basal_stress_coeff (nx_block, ny_block, & + icellu (iblk), & + indxui(:,iblk), indxuj(:,iblk), & + vice(:,:,iblk), aice(:,:,iblk), & + hwater(:,:,iblk), Tbu(:,:,iblk)) + enddo + !$OMP END PARALLEL DO endif - + do ksub = 1,ndte ! subcycling - !----------------------------------------------------------------- - ! stress tensor equation, total surface stress - !----------------------------------------------------------------- + !----------------------------------------------------------------- + ! stress tensor equation, total surface stress + !----------------------------------------------------------------- - !$OMP PARALLEL DO PRIVATE(iblk,strtmp) SCHEDULE(runtime) + !$TCXOMP PARALLEL DO PRIVATE(iblk,strtmp) do iblk = 1, nblocks -! call ice_timer_start(timer_tmp1,iblk) +! call ice_timer_start(timer_tmp1) ! dynamics call stress_eap (nx_block, ny_block, & ksub, ndte, & - icellT (iblk), & - indxTi (:,iblk), indxTj (:,iblk), & - arlx1i, denom1, & + icellt(iblk), & + indxti (:,iblk), indxtj (:,iblk), & + arlx1i, denom1, & uvel (:,:,iblk), vvel (:,:,iblk), & - dxT (:,:,iblk), dyT (:,:,iblk), & - dxU (:,:,iblk), dyU (:,:,iblk), & + dxt (:,:,iblk), dyt (:,:,iblk), & dxhy (:,:,iblk), dyhx (:,:,iblk), & cxp (:,:,iblk), cyp (:,:,iblk), & cxm (:,:,iblk), cym (:,:,iblk), & tarear (:,:,iblk), strength (:,:,iblk), & - a11_1 (:,:,iblk), a11_2 (:,:,iblk), & - a11_3 (:,:,iblk), a11_4 (:,:,iblk), & - a12_1 (:,:,iblk), a12_2 (:,:,iblk), & - a12_3 (:,:,iblk), a12_4 (:,:,iblk), & + a11_1 (:,:,iblk), a11_2 (:,:,iblk), & + a11_3 (:,:,iblk), a11_4 (:,:,iblk), & + a12_1 (:,:,iblk), a12_2 (:,:,iblk), & + a12_3 (:,:,iblk), a12_4 (:,:,iblk), & stressp_1 (:,:,iblk), stressp_2 (:,:,iblk), & stressp_3 (:,:,iblk), stressp_4 (:,:,iblk), & stressm_1 (:,:,iblk), stressm_2 (:,:,iblk), & @@ -450,66 +430,64 @@ subroutine eap (dt) stress12_1(:,:,iblk), stress12_2(:,:,iblk), & stress12_3(:,:,iblk), stress12_4(:,:,iblk), & shear (:,:,iblk), divu (:,:,iblk), & - vort (:,:,iblk), & e11 (:,:,iblk), e12 (:,:,iblk), & e22 (:,:,iblk), & s11 (:,:,iblk), s12 (:,:,iblk), & s22 (:,:,iblk), & - yieldstress11 (:,:,iblk), & - yieldstress12 (:,:,iblk), & - yieldstress22 (:,:,iblk), & -! rdg_conv (:,:,iblk), rdg_shear (:,:,iblk), & + yieldstress11 (:,:,iblk), & + yieldstress12 (:,:,iblk), & + yieldstress22 (:,:,iblk), & +! rdg_conv (:,:,iblk), rdg_shear (:,:,iblk), & rdg_conv (:,:,iblk), & strtmp (:,:,:)) -! call ice_timer_stop(timer_tmp1,iblk) - - !----------------------------------------------------------------- - ! momentum equation - !----------------------------------------------------------------- - -! call ice_timer_start(timer_tmp2,iblk) - call stepu (nx_block, ny_block, & - icellU (iblk), Cdn_ocnU (:,:,iblk), & - indxUi (:,iblk), indxUj (:,iblk), & - aiU (:,:,iblk), strtmp (:,:,:), & - uocnU (:,:,iblk), vocnU (:,:,iblk), & - waterxU (:,:,iblk), wateryU (:,:,iblk), & - forcexU (:,:,iblk), forceyU (:,:,iblk), & - umassdti (:,:,iblk), fmU (:,:,iblk), & - uarear (:,:,iblk), & - strintxU (:,:,iblk), strintyU (:,:,iblk), & - taubxU (:,:,iblk), taubyU (:,:,iblk), & - uvel_init(:,:,iblk), vvel_init(:,:,iblk), & - uvel (:,:,iblk), vvel (:,:,iblk), & - TbU (:,:,iblk)) -! call ice_timer_stop(timer_tmp2,iblk) - - !----------------------------------------------------------------- - ! evolution of structure tensor A - !----------------------------------------------------------------- - -! call ice_timer_start(timer_tmp3,iblk) +! call ice_timer_stop(timer_tmp1) ! dynamics + + !----------------------------------------------------------------- + ! 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)) + + !----------------------------------------------------------------- + ! evolution of structure tensor A + !----------------------------------------------------------------- + +! call ice_timer_start(timer_tmp3) ! dynamics if (mod(ksub,10) == 1) then ! only called every 10th timestep - call stepa (nx_block , ny_block , & - dtei , icellT (iblk), & - indxTi (:,iblk), indxTj (:,iblk), & - a11 (:,:,iblk), a12 (:,:,iblk), & - a11_1 (:,:,iblk), a11_2 (:,:,iblk), & - a11_3 (:,:,iblk), a11_4 (:,:,iblk), & - a12_1 (:,:,iblk), a12_2 (:,:,iblk), & - a12_3 (:,:,iblk), a12_4 (:,:,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), & + call stepa (nx_block, ny_block, & + dtei, icellt (iblk), & + indxti (:,iblk), indxtj (:,iblk), & + a11 (:,:,iblk), a12 (:,:,iblk), & + a11_1 (:,:,iblk), a11_2 (:,:,iblk), & + a11_3 (:,:,iblk), a11_4 (:,:,iblk), & + a12_1 (:,:,iblk), a12_2 (:,:,iblk), & + a12_3 (:,:,iblk), a12_4 (:,:,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)) endif -! call ice_timer_stop(timer_tmp3,iblk) +! call ice_timer_stop(timer_tmp3) ! dynamics enddo - !$OMP END PARALLEL DO + !$TCXOMP END PARALLEL DO - call stack_fields(uvel, vvel, fld2) + call stack_velocity_field(uvel, vvel, fld2) call ice_timer_start(timer_bound) if (maskhalo_dyn) then call ice_HaloUpdate (fld2, halo_info_mask, & @@ -519,36 +497,44 @@ subroutine eap (dt) field_loc_NEcorner, field_type_vector) endif call ice_timer_stop(timer_bound) - call unstack_fields(fld2, uvel, vvel) + call unstack_velocity_field(fld2, uvel, vvel) enddo ! subcycling + deallocate(fld2) if (maskhalo_dyn) call ice_HaloDestroy(halo_info_mask) !----------------------------------------------------------------- ! ice-ocean stress !----------------------------------------------------------------- - !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime) + !$OMP PARALLEL DO PRIVATE(iblk) do iblk = 1, nblocks - call dyn_finish & - (nx_block, ny_block, & - icellU (iblk), Cdn_ocnU(:,:,iblk), & - indxUi (:,iblk), indxUj (:,iblk), & - uvel (:,:,iblk), vvel (:,:,iblk), & - uocnU (:,:,iblk), vocnU (:,:,iblk), & - aiU (:,:,iblk), fmU (:,:,iblk), & - strocnxU(:,:,iblk), strocnyU(:,:,iblk)) + call dyn_finish & + (nx_block, ny_block, & + icellu (iblk), Cdn_ocn (:,:,iblk), & + indxui (:,iblk), indxuj (:,iblk), & + uvel (:,:,iblk), vvel (:,:,iblk), & + uocn (:,:,iblk), vocn (:,:,iblk), & + aiu (:,:,iblk), fm (:,:,iblk), & + strintx (:,:,iblk), strinty (:,:,iblk), & + strairx (:,:,iblk), strairy (:,:,iblk), & + strocnx (:,:,iblk), strocny (:,:,iblk), & + strocnxT(:,:,iblk), strocnyT(:,:,iblk)) enddo !$OMP END PARALLEL DO + call u2tgrid_vector(strocnxT) ! shift + call u2tgrid_vector(strocnyT) + call ice_timer_stop(timer_dynamics) ! dynamics end subroutine eap !======================================================================= + ! Initialize parameters and variables needed for the eap dynamics ! (based on init_dyn) @@ -556,8 +542,6 @@ subroutine init_eap use ice_blocks, only: nx_block, ny_block use ice_domain, only: nblocks - use ice_calendar, only: dt_dyn - use ice_dyn_shared, only: init_dyn_shared ! local variables @@ -565,79 +549,49 @@ subroutine init_eap i, j, & iblk ! block index - real (kind=dbl_kind), parameter :: & + real (kind=dbl_kind), parameter :: & eps6 = 1.0e-6_dbl_kind - integer (kind=int_kind) :: & - ix, iy, iz, ia, ierr + integer (kind=int_kind) :: & + ix, iy, iz, ia - integer (kind=int_kind), parameter :: & + integer (kind=int_kind), parameter :: & nz = 100 - real (kind=dbl_kind) :: & + real (kind=dbl_kind) :: & ainit, xinit, yinit, zinit, & da, dx, dy, dz, & - phi - - real (kind=dbl_kind) :: invstressconviso + pi, pih, piq, phi character(len=*), parameter :: subname = '(init_eap)' - call icepack_query_parameters(puny_out=puny, & - pi_out=pi, pi2_out=pi2, piq_out=piq, pih_out=pih) + call icepack_query_parameters(pi_out=pi, pih_out=pih, piq_out=piq) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - phi = pi/c12 ! diamond shaped floe smaller angle (default phi = 30 deg) - call init_dyn_shared(dt_dyn) - - allocate( a11_1 (nx_block,ny_block,max_blocks), & - a11_2 (nx_block,ny_block,max_blocks), & - a11_3 (nx_block,ny_block,max_blocks), & - a11_4 (nx_block,ny_block,max_blocks), & - a12_1 (nx_block,ny_block,max_blocks), & - a12_2 (nx_block,ny_block,max_blocks), & - a12_3 (nx_block,ny_block,max_blocks), & - a12_4 (nx_block,ny_block,max_blocks), & - e11 (nx_block,ny_block,max_blocks), & - e12 (nx_block,ny_block,max_blocks), & - e22 (nx_block,ny_block,max_blocks), & - yieldstress11(nx_block,ny_block,max_blocks), & - yieldstress12(nx_block,ny_block,max_blocks), & - yieldstress22(nx_block,ny_block,max_blocks), & - s11 (nx_block,ny_block,max_blocks), & - s12 (nx_block,ny_block,max_blocks), & - s22 (nx_block,ny_block,max_blocks), & - a11 (nx_block,ny_block,max_blocks), & - a12 (nx_block,ny_block,max_blocks), & - stat=ierr) - if (ierr/=0) call abort_ice(subname//' ERROR: Out of memory') - - - !$OMP PARALLEL DO PRIVATE(iblk,i,j) SCHEDULE(runtime) + !$OMP PARALLEL DO PRIVATE(iblk,i,j) do iblk = 1, nblocks do j = 1, ny_block do i = 1, nx_block - e11 (i,j,iblk) = c0 - e12 (i,j,iblk) = c0 - e22 (i,j,iblk) = c0 - s11 (i,j,iblk) = c0 - s12 (i,j,iblk) = c0 - s22 (i,j,iblk) = c0 + e11(i,j,iblk) = c0 + e12(i,j,iblk) = c0 + e22(i,j,iblk) = c0 + s11(i,j,iblk) = c0 + s12(i,j,iblk) = c0 + s22(i,j,iblk) = c0 yieldstress11(i,j,iblk) = c0 yieldstress12(i,j,iblk) = c0 yieldstress22(i,j,iblk) = c0 - a11_1 (i,j,iblk) = p5 - a11_2 (i,j,iblk) = p5 - a11_3 (i,j,iblk) = p5 - a11_4 (i,j,iblk) = p5 - a12_1 (i,j,iblk) = c0 - a12_2 (i,j,iblk) = c0 - a12_3 (i,j,iblk) = c0 - a12_4 (i,j,iblk) = c0 - rdg_shear (i,j,iblk) = c0 + a11_1 (i,j,iblk) = p5 + a11_2 (i,j,iblk) = p5 + a11_3 (i,j,iblk) = p5 + a11_4 (i,j,iblk) = p5 + a12_1 (i,j,iblk) = c0 + a12_2 (i,j,iblk) = c0 + a12_3 (i,j,iblk) = c0 + a12_4 (i,j,iblk) = c0 enddo ! i enddo ! j enddo ! iblk @@ -655,13 +609,10 @@ subroutine init_eap zinit = -pih dy = pi/real(ny_yield-1,kind=dbl_kind) yinit = -dy - invdx = c1/dx - invdy = c1/dy - invda = c1/da do ia=1,na_yield - do ix=1,nx_yield - do iy=1,ny_yield + do ix=1,nx_yield + do iy=1,ny_yield s11r(ix,iy,ia) = c0 s12r(ix,iy,ia) = c0 s22r(ix,iy,ia) = c0 @@ -669,55 +620,49 @@ subroutine init_eap s12s(ix,iy,ia) = c0 s22s(ix,iy,ia) = c0 if (ia <= na_yield-1) then - do iz=1,nz - s11r(ix,iy,ia) = s11r(ix,iy,ia) + 1*w1(ainit+ia*da)* & - exp(-w2(ainit+ia*da)*(zinit+iz*dz)*(zinit+iz*dz))* & - s11kr(xinit+ix*dx,yinit+iy*dy,zinit+iz*dz,phi)*dz/sin(c2*phi) - s12r(ix,iy,ia) = s12r(ix,iy,ia) + 1*w1(ainit+ia*da)* & - exp(-w2(ainit+ia*da)*(zinit+iz*dz)*(zinit+iz*dz))* & - s12kr(xinit+ix*dx,yinit+iy*dy,zinit+iz*dz,phi)*dz/sin(c2*phi) - s22r(ix,iy,ia) = s22r(ix,iy,ia) + 1*w1(ainit+ia*da)* & - exp(-w2(ainit+ia*da)*(zinit+iz*dz)*(zinit+iz*dz))* & - s22kr(xinit+ix*dx,yinit+iy*dy,zinit+iz*dz,phi)*dz/sin(c2*phi) - s11s(ix,iy,ia) = s11s(ix,iy,ia) + 1*w1(ainit+ia*da)* & - exp(-w2(ainit+ia*da)*(zinit+iz*dz)*(zinit+iz*dz))* & - s11ks(xinit+ix*dx,yinit+iy*dy,zinit+iz*dz,phi)*dz/sin(c2*phi) - s12s(ix,iy,ia) = s12s(ix,iy,ia) + 1*w1(ainit+ia*da)* & - exp(-w2(ainit+ia*da)*(zinit+iz*dz)*(zinit+iz*dz))* & - s12ks(xinit+ix*dx,yinit+iy*dy,zinit+iz*dz,phi)*dz/sin(c2*phi) - s22s(ix,iy,ia) = s22s(ix,iy,ia) + 1*w1(ainit+ia*da)* & - exp(-w2(ainit+ia*da)*(zinit+iz*dz)*(zinit+iz*dz))* & - s22ks(xinit+ix*dx,yinit+iy*dy,zinit+iz*dz,phi)*dz/sin(c2*phi) - enddo - if (abs(s11r(ix,iy,ia)) < eps6) s11r(ix,iy,ia) = c0 - if (abs(s12r(ix,iy,ia)) < eps6) s12r(ix,iy,ia) = c0 - if (abs(s22r(ix,iy,ia)) < eps6) s22r(ix,iy,ia) = c0 - if (abs(s11s(ix,iy,ia)) < eps6) s11s(ix,iy,ia) = c0 - if (abs(s12s(ix,iy,ia)) < eps6) s12s(ix,iy,ia) = c0 - if (abs(s22s(ix,iy,ia)) < eps6) s22s(ix,iy,ia) = c0 + do iz=1,nz + s11r(ix,iy,ia) = s11r(ix,iy,ia) + 1*w1(ainit+ia*da)* & + exp(-w2(ainit+ia*da)*(zinit+iz*dz)*(zinit+iz*dz))* & + s11kr(xinit+ix*dx,yinit+iy*dy,zinit+iz*dz,phi)*dz/sin(c2*phi) + s12r(ix,iy,ia) = s12r(ix,iy,ia) + 1*w1(ainit+ia*da)* & + exp(-w2(ainit+ia*da)*(zinit+iz*dz)*(zinit+iz*dz))* & + s12kr(xinit+ix*dx,yinit+iy*dy,zinit+iz*dz,phi)*dz/sin(c2*phi) + s22r(ix,iy,ia) = s22r(ix,iy,ia) + 1*w1(ainit+ia*da)* & + exp(-w2(ainit+ia*da)*(zinit+iz*dz)*(zinit+iz*dz))* & + s22kr(xinit+ix*dx,yinit+iy*dy,zinit+iz*dz,phi)*dz/sin(c2*phi) + s11s(ix,iy,ia) = s11s(ix,iy,ia) + 1*w1(ainit+ia*da)* & + exp(-w2(ainit+ia*da)*(zinit+iz*dz)*(zinit+iz*dz))* & + s11ks(xinit+ix*dx,yinit+iy*dy,zinit+iz*dz,phi)*dz/sin(c2*phi) + s12s(ix,iy,ia) = s12s(ix,iy,ia) + 1*w1(ainit+ia*da)* & + exp(-w2(ainit+ia*da)*(zinit+iz*dz)*(zinit+iz*dz))* & + s12ks(xinit+ix*dx,yinit+iy*dy,zinit+iz*dz,phi)*dz/sin(c2*phi) + s22s(ix,iy,ia) = s22s(ix,iy,ia) + 1*w1(ainit+ia*da)* & + exp(-w2(ainit+ia*da)*(zinit+iz*dz)*(zinit+iz*dz))* & + s22ks(xinit+ix*dx,yinit+iy*dy,zinit+iz*dz,phi)*dz/sin(c2*phi) + enddo + if (abs(s11r(ix,iy,ia)) < eps6) s11r(ix,iy,ia) = c0 + if (abs(s12r(ix,iy,ia)) < eps6) s12r(ix,iy,ia) = c0 + if (abs(s22r(ix,iy,ia)) < eps6) s22r(ix,iy,ia) = c0 + if (abs(s11s(ix,iy,ia)) < eps6) s11s(ix,iy,ia) = c0 + if (abs(s12s(ix,iy,ia)) < eps6) s12s(ix,iy,ia) = c0 + if (abs(s22s(ix,iy,ia)) < eps6) s22s(ix,iy,ia) = c0 else - s11r(ix,iy,ia) = p5*s11kr(xinit+ix*dx,yinit+iy*dy,c0,phi)/sin(c2*phi) - s12r(ix,iy,ia) = p5*s12kr(xinit+ix*dx,yinit+iy*dy,c0,phi)/sin(c2*phi) - s22r(ix,iy,ia) = p5*s22kr(xinit+ix*dx,yinit+iy*dy,c0,phi)/sin(c2*phi) - s11s(ix,iy,ia) = p5*s11ks(xinit+ix*dx,yinit+iy*dy,c0,phi)/sin(c2*phi) - s12s(ix,iy,ia) = p5*s12ks(xinit+ix*dx,yinit+iy*dy,c0,phi)/sin(c2*phi) - s22s(ix,iy,ia) = p5*s22ks(xinit+ix*dx,yinit+iy*dy,c0,phi)/sin(c2*phi) - if (abs(s11r(ix,iy,ia)) < eps6) s11r(ix,iy,ia) = c0 - if (abs(s12r(ix,iy,ia)) < eps6) s12r(ix,iy,ia) = c0 - if (abs(s22r(ix,iy,ia)) < eps6) s22r(ix,iy,ia) = c0 - if (abs(s11s(ix,iy,ia)) < eps6) s11s(ix,iy,ia) = c0 - if (abs(s12s(ix,iy,ia)) < eps6) s12s(ix,iy,ia) = c0 - if (abs(s22s(ix,iy,ia)) < eps6) s22s(ix,iy,ia) = c0 + s11r(ix,iy,ia) = p5*s11kr(xinit+ix*dx,yinit+iy*dy,c0,phi)/sin(c2*phi) + s12r(ix,iy,ia) = p5*s12kr(xinit+ix*dx,yinit+iy*dy,c0,phi)/sin(c2*phi) + s22r(ix,iy,ia) = p5*s22kr(xinit+ix*dx,yinit+iy*dy,c0,phi)/sin(c2*phi) + s11s(ix,iy,ia) = p5*s11ks(xinit+ix*dx,yinit+iy*dy,c0,phi)/sin(c2*phi) + s12s(ix,iy,ia) = p5*s12ks(xinit+ix*dx,yinit+iy*dy,c0,phi)/sin(c2*phi) + s22s(ix,iy,ia) = p5*s22ks(xinit+ix*dx,yinit+iy*dy,c0,phi)/sin(c2*phi) + if (abs(s11r(ix,iy,ia)) < eps6) s11r(ix,iy,ia) = c0 + if (abs(s12r(ix,iy,ia)) < eps6) s12r(ix,iy,ia) = c0 + if (abs(s22r(ix,iy,ia)) < eps6) s22r(ix,iy,ia) = c0 + if (abs(s11s(ix,iy,ia)) < eps6) s11s(ix,iy,ia) = c0 + if (abs(s12s(ix,iy,ia)) < eps6) s12s(ix,iy,ia) = c0 + if (abs(s22s(ix,iy,ia)) < eps6) s22s(ix,iy,ia) = c0 endif + enddo + enddo enddo - enddo - enddo - - ! Factor to maintain the same stress as in EVP (see Section 3) - ! Can be set to 1 otherwise - - invstressconviso = c1/(c1+kfriction*kfriction) - invsin = c1/sin(pi2/c12) * invstressconviso end subroutine init_eap @@ -764,26 +709,31 @@ end FUNCTION w2 !======================================================================= ! Function : s11kr - FUNCTION s11kr(x,y,z,phi) + FUNCTION s11kr(x,y,z,phi) real (kind=dbl_kind), intent(in) :: & x,y,z,phi real (kind=dbl_kind) :: & - s11kr, p + s11kr, p real (kind=dbl_kind) :: & - n1t2i11, n1t2i12, n1t2i21, n1t2i22, & - n2t1i11, n2t1i12, n2t1i21, n2t1i22, & -! t1t2i11, t1t2i12, t1t2i21, t1t2i22, & -! t2t1i11, t2t1i12, t2t1i21, t2t1i22, & - d11, d12, d22, & - IIn1t2, IIn2t1, & -! IIt1t2, & - Hen1t2, Hen2t1 - + n1t2i11, n1t2i12, n1t2i21, n1t2i22, & + n2t1i11, n2t1i12, n2t1i21, n2t1i22, & +! t1t2i11, t1t2i12, t1t2i21, t1t2i22, & +! t2t1i11, t2t1i12, t2t1i21, t2t1i22, & + d11, d12, d22, & + IIn1t2, IIn2t1, & +! IIt1t2, & + Hen1t2, Hen2t1, & + pih, puny character(len=*), parameter :: subname = '(s11kr)' + call icepack_query_parameters(pih_out=pih, puny_out=puny) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + p = phi n1t2i11 = cos(z+pih-p) * cos(z+p) @@ -812,15 +762,15 @@ FUNCTION s11kr(x,y,z,phi) ! IIt1t2 = t1t2i11 * d11 + (t1t2i12 + t1t2i21) * d12 + t1t2i22 * d22 if (-IIn1t2>=puny) then - Hen1t2 = c1 + Hen1t2 = c1 else - Hen1t2 = c0 + Hen1t2 = c0 endif if (-IIn2t1>=puny) then - Hen2t1 = c1 + Hen2t1 = c1 else - Hen2t1 = c0 + Hen2t1 = c0 endif s11kr = (- Hen1t2 * n1t2i11 - Hen2t1 * n2t1i11) @@ -833,23 +783,28 @@ end FUNCTION s11kr FUNCTION s12kr(x,y,z,phi) real (kind=dbl_kind), intent(in) :: & - x,y,z,phi + x,y,z,phi real (kind=dbl_kind) :: & - s12kr, s12r0, s21r0, p + s12kr, s12r0, s21r0, p real (kind=dbl_kind) :: & - n1t2i11, n1t2i12, n1t2i21, n1t2i22, & - n2t1i11, n2t1i12, n2t1i21, n2t1i22, & -! t1t2i11, t1t2i12, t1t2i21, t1t2i22, & -! t2t1i11, t2t1i12, t2t1i21, t2t1i22, & - d11, d12, d22, & - IIn1t2, IIn2t1, & -! IIt1t2, & - Hen1t2, Hen2t1 - + n1t2i11, n1t2i12, n1t2i21, n1t2i22, & + n2t1i11, n2t1i12, n2t1i21, n2t1i22, & +! t1t2i11, t1t2i12, t1t2i21, t1t2i22, & +! t2t1i11, t2t1i12, t2t1i21, t2t1i22, & + d11, d12, d22, & + IIn1t2, IIn2t1, & +! IIt1t2, & + Hen1t2, Hen2t1, & + pih, puny character(len=*), parameter :: subname = '(s12kr)' + call icepack_query_parameters(pih_out=pih, puny_out=puny) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + p = phi n1t2i11 = cos(z+pih-p) * cos(z+p) @@ -876,15 +831,15 @@ FUNCTION s12kr(x,y,z,phi) ! IIt1t2 = t1t2i11 * d11 + (t1t2i12 + t1t2i21) * d12 + t1t2i22 * d22 if (-IIn1t2>=puny) then - Hen1t2 = c1 + Hen1t2 = c1 else - Hen1t2 = c0 + Hen1t2 = c0 endif if (-IIn2t1>=puny) then - Hen2t1 = c1 + Hen2t1 = c1 else - Hen2t1 = c0 + Hen2t1 = c0 endif s12r0 = (- Hen1t2 * n1t2i12 - Hen2t1 * n2t1i12) @@ -899,23 +854,28 @@ end FUNCTION s12kr FUNCTION s22kr(x,y,z,phi) real (kind=dbl_kind), intent(in) :: & - x,y,z,phi + x,y,z,phi real (kind=dbl_kind) :: & - s22kr, p + s22kr, p real (kind=dbl_kind) :: & - n1t2i11, n1t2i12, n1t2i21, n1t2i22, & - n2t1i11, n2t1i12, n2t1i21, n2t1i22, & -! t1t2i11, t1t2i12, t1t2i21, t1t2i22, & -! t2t1i11, t2t1i12, t2t1i21, t2t1i22, & - d11, d12, d22, & - IIn1t2, IIn2t1, & -! IIt1t2, & - Hen1t2, Hen2t1 - + n1t2i11, n1t2i12, n1t2i21, n1t2i22, & + n2t1i11, n2t1i12, n2t1i21, n2t1i22, & +! t1t2i11, t1t2i12, t1t2i21, t1t2i22, & +! t2t1i11, t2t1i12, t2t1i21, t2t1i22, & + d11, d12, d22, & + IIn1t2, IIn2t1, & +! IIt1t2, & + Hen1t2, Hen2t1, & + pih, puny character(len=*), parameter :: subname = '(s22kr)' + call icepack_query_parameters(pih_out=pih, puny_out=puny) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + p = phi n1t2i11 = cos(z+pih-p) * cos(z+p) @@ -942,15 +902,15 @@ FUNCTION s22kr(x,y,z,phi) ! IIt1t2 = t1t2i11 * d11 + (t1t2i12 + t1t2i21) * d12 + t1t2i22 * d22 if (-IIn1t2>=puny) then - Hen1t2 = c1 + Hen1t2 = c1 else - Hen1t2 = c0 + Hen1t2 = c0 endif if (-IIn2t1>=puny) then - Hen2t1 = c1 + Hen2t1 = c1 else - Hen2t1 = c0 + Hen2t1 = c0 endif s22kr = (- Hen1t2 * n1t2i22 - Hen2t1 * n2t1i22) @@ -963,24 +923,29 @@ end FUNCTION s22kr FUNCTION s11ks(x,y,z,phi) real (kind=dbl_kind), intent(in):: & - x,y,z,phi + x,y,z,phi real (kind=dbl_kind) :: & - s11ks, p + s11ks, p real (kind=dbl_kind) :: & - n1t2i11, n1t2i12, n1t2i21, n1t2i22, & - n2t1i11, n2t1i12, n2t1i21, n2t1i22, & - t1t2i11, & - t1t2i12, t1t2i21, t1t2i22, & - t2t1i11, & -! t2t1i12, t2t1i21, t2t1i22, & - d11, d12, d22, & - IIn1t2, IIn2t1, IIt1t2, & - Hen1t2, Hen2t1 - + n1t2i11, n1t2i12, n1t2i21, n1t2i22, & + n2t1i11, n2t1i12, n2t1i21, n2t1i22, & + t1t2i11, & + t1t2i12, t1t2i21, t1t2i22, & + t2t1i11, & +! t2t1i12, t2t1i21, t2t1i22, & + d11, d12, d22, & + IIn1t2, IIn2t1, IIt1t2, & + Hen1t2, Hen2t1, & + pih, puny character(len=*), parameter :: subname = '(s11ks)' + call icepack_query_parameters(pih_out=pih, puny_out=puny) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + p = phi n1t2i11 = cos(z+pih-p) * cos(z+p) @@ -1007,15 +972,15 @@ FUNCTION s11ks(x,y,z,phi) IIt1t2 = t1t2i11 * d11 + (t1t2i12 + t1t2i21) * d12 + t1t2i22 * d22 if (-IIn1t2>=puny) then - Hen1t2 = c1 + Hen1t2 = c1 else - Hen1t2 = c0 + Hen1t2 = c0 endif if (-IIn2t1>=puny) then - Hen2t1 = c1 + Hen2t1 = c1 else - Hen2t1 = c0 + Hen2t1 = c0 endif s11ks = sign(c1,IIt1t2+puny)*(Hen1t2 * t1t2i11 + Hen2t1 * t2t1i11) @@ -1028,23 +993,28 @@ end FUNCTION s11ks FUNCTION s12ks(x,y,z,phi) real (kind=dbl_kind), intent(in) :: & - x,y,z,phi + x,y,z,phi real (kind=dbl_kind) :: & - s12ks,s12s0,s21s0,p + s12ks,s12s0,s21s0,p real (kind=dbl_kind) :: & - n1t2i11, n1t2i12, n1t2i21, n1t2i22, & - n2t1i11, n2t1i12, n2t1i21, n2t1i22, & - t1t2i11, t1t2i12, t1t2i21, t1t2i22, & -! t2t1i11, t2t1i22, & - t2t1i12, t2t1i21, & - d11, d12, d22, & - IIn1t2, IIn2t1, IIt1t2, & - Hen1t2, Hen2t1 - + n1t2i11, n1t2i12, n1t2i21, n1t2i22, & + n2t1i11, n2t1i12, n2t1i21, n2t1i22, & + t1t2i11, t1t2i12, t1t2i21, t1t2i22, & +! t2t1i11, t2t1i22, & + t2t1i12, t2t1i21, & + d11, d12, d22, & + IIn1t2, IIn2t1, IIt1t2, & + Hen1t2, Hen2t1, & + pih, puny character(len=*), parameter :: subname = '(s12ks)' + call icepack_query_parameters(pih_out=pih, puny_out=puny) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + p =phi n1t2i11 = cos(z+pih-p) * cos(z+p) @@ -1071,15 +1041,15 @@ FUNCTION s12ks(x,y,z,phi) IIt1t2 = t1t2i11 * d11 + (t1t2i12 + t1t2i21) * d12 + t1t2i22 * d22 if (-IIn1t2>=puny) then - Hen1t2 = c1 + Hen1t2 = c1 else - Hen1t2 = c0 + Hen1t2 = c0 endif if (-IIn2t1>=puny) then - Hen2t1 = c1 + Hen2t1 = c1 else - Hen2t1 = c0 + Hen2t1 = c0 endif s12s0 = sign(c1,IIt1t2+puny)*(Hen1t2 * t1t2i12 + Hen2t1 * t2t1i12) @@ -1091,26 +1061,31 @@ end FUNCTION s12ks !======================================================================= ! Function : s22ks - FUNCTION s22ks(x,y,z,phi) + FUNCTION s22ks(x,y,z,phi) real (kind=dbl_kind), intent(in) :: & - x,y,z,phi + x,y,z,phi real (kind=dbl_kind) :: & - s22ks,p + s22ks,p real (kind=dbl_kind) :: & - n1t2i11, n1t2i12, n1t2i21, n1t2i22, & - n2t1i11, n2t1i12, n2t1i21, n2t1i22, & - t1t2i11, t1t2i12, t1t2i21, t1t2i22, & -! t2t1i11, t2t1i12, t2t1i21, & - t2t1i22, & - d11, d12, d22, & - IIn1t2, IIn2t1, IIt1t2, & - Hen1t2, Hen2t1 - + n1t2i11, n1t2i12, n1t2i21, n1t2i22, & + n2t1i11, n2t1i12, n2t1i21, n2t1i22, & + t1t2i11, t1t2i12, t1t2i21, t1t2i22, & +! t2t1i11, t2t1i12, t2t1i21, & + t2t1i22, & + d11, d12, d22, & + IIn1t2, IIn2t1, IIt1t2, & + Hen1t2, Hen2t1, & + pih, puny character(len=*), parameter :: subname = '(s22ks)' + call icepack_query_parameters(pih_out=pih, puny_out=puny) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + p = phi n1t2i11 = cos(z+pih-p) * cos(z+p) @@ -1137,22 +1112,24 @@ FUNCTION s22ks(x,y,z,phi) IIt1t2 = t1t2i11 * d11 + (t1t2i12 + t1t2i21) * d12 + t1t2i22 * d22 if (-IIn1t2>=puny) then - Hen1t2 = c1 + Hen1t2 = c1 else - Hen1t2 = c0 + Hen1t2 = c0 endif if (-IIn2t1>=puny) then - Hen2t1 = c1 + Hen2t1 = c1 else - Hen2t1 = c0 + Hen2t1 = c0 endif s22ks = sign(c1,IIt1t2+puny)*(Hen1t2 * t1t2i22 + Hen2t1 * t2t1i22) end FUNCTION s22ks + !======================================================================= + ! Computes the rates of strain and internal stress components for ! each of the four corners on each T-grid cell. ! Computes stress terms for the momentum equation @@ -1160,12 +1137,11 @@ end FUNCTION s22ks subroutine stress_eap (nx_block, ny_block, & ksub, ndte, & - icellT, & - indxTi, indxTj, & + icellt, & + indxti, indxtj, & arlx1i, denom1, & uvel, vvel, & - dxT, dyT, & - dxU, dyU, & + dxt, dyt, & dxhy, dyhx, & cxp, cyp, & cxm, cym, & @@ -1179,7 +1155,6 @@ subroutine stress_eap (nx_block, ny_block, & stress12_1, stress12_2, & stress12_3, stress12_4, & shear, divu, & - vort, & e11, e12, & e22, & s11, s12, & @@ -1191,15 +1166,20 @@ subroutine stress_eap (nx_block, ny_block, & rdg_conv, & strtmp) - integer (kind=int_kind), intent(in) :: & +!echmod tmp +! use ice_timers, only: & +! ice_timer_start, ice_timer_stop, & +! timer_tmp1, timer_tmp2, timer_tmp3 + + integer (kind=int_kind), intent(in) :: & nx_block, ny_block, & ! block dimensions ksub , & ! subcycling step ndte , & ! number of subcycles - icellT ! no. of cells where iceTmask = .true. + icellt ! no. of cells where icetmask = 1 integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & - indxTi , & ! compressed index in i-direction - indxTj ! compressed index in j-direction + indxti , & ! compressed index in i-direction + indxtj ! compressed index in j-direction real (kind=dbl_kind), intent(in) :: & arlx1i , & ! dte/2T (original) or 1/alpha1 (revised) @@ -1209,16 +1189,14 @@ subroutine stress_eap (nx_block, ny_block, & strength , & ! ice strength (N/m) uvel , & ! x-component of velocity (m/s) vvel , & ! y-component of velocity (m/s) - dxT , & ! width of T-cell through the middle (m) - dyT , & ! height of T-cell through the middle (m) - dxU , & ! width of U-cell through the middle (m) - dyU , & ! height of U-cell through the middle (m) - dxhy , & ! 0.5*(HTE - HTW) - dyhx , & ! 0.5*(HTN - HTS) - cyp , & ! 1.5*HTE - 0.5*HTW - cxp , & ! 1.5*HTN - 0.5*HTS - cym , & ! 0.5*HTE - 1.5*HTW - cxm , & ! 0.5*HTN - 1.5*HTS + dxt , & ! width of T-cell through the middle (m) + dyt , & ! height of T-cell through the middle (m) + dxhy , & ! 0.5*(HTE - HTE) + dyhx , & ! 0.5*(HTN - HTN) + cyp , & ! 1.5*HTE - 0.5*HTE + cxp , & ! 1.5*HTN - 0.5*HTN + cym , & ! 0.5*HTE - 1.5*HTE + cxm , & ! 0.5*HTN - 1.5*HTN tarear ! 1/tarea real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & @@ -1233,13 +1211,12 @@ subroutine stress_eap (nx_block, ny_block, & real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & shear , & ! strain rate II component (1/s) divu , & ! strain rate I component, velocity divergence (1/s) - vort , & ! vorticity (1/s) e11 , & ! components of strain rate tensor (1/s) - e12 , & ! - e22 , & ! + e12 , & ! + e22 , & ! s11 , & ! components of stress tensor (kg/s^2) - s12 , & ! - s22 , & ! + s12 , & ! + s22 , & ! yieldstress11, & ! components of yield stress tensor (kg/s^2) yieldstress12, & yieldstress22, & @@ -1260,23 +1237,22 @@ subroutine stress_eap (nx_block, ny_block, & stress12tmp_1,stress12tmp_2,stress12tmp_3,stress12tmp_4 ! sigma12 real (kind=dbl_kind) :: & - divune, divunw, divuse, divusw , & ! divergence - tensionne, tensionnw, tensionse, tensionsw, & ! tension - shearne, shearnw, shearse, shearsw , & ! shearing - dvdxn, dvdxs, dudye, dudyw , & ! for vorticity calc - ssigpn, ssigps, ssigpe, ssigpw , & - ssigmn, ssigms, ssigme, ssigmw , & - ssig12n, ssig12s, ssig12e, ssig12w , & - ssigp1, ssigp2, ssigm1, ssigm2, ssig121, ssig122, & - csigpne, csigpnw, csigpse, csigpsw , & - csigmne, csigmnw, csigmse, csigmsw , & - csig12ne, csig12nw, csig12se, csig12sw , & - str12ew, str12we, str12ns, str12sn , & - strp_tmp, strm_tmp + divune, divunw, divuse, divusw , & ! divergence + tensionne, tensionnw, tensionse, tensionsw, & ! tension + shearne, shearnw, shearse, shearsw , & ! shearing + ssigpn, ssigps, ssigpe, ssigpw , & + ssigmn, ssigms, ssigme, ssigmw , & + ssig12n, ssig12s, ssig12e, ssig12w , & + ssigp1, ssigp2, ssigm1, ssigm2, ssig121, ssig122, & + csigpne, csigpnw, csigpse, csigpsw , & + csigmne, csigmnw, csigmse, csigmsw , & + csig12ne, csig12nw, csig12se, csig12sw , & + str12ew, str12we, str12ns, str12sn , & + strp_tmp, strm_tmp, puny real (kind=dbl_kind) :: & - alpharne, alpharnw, alpharsw, alpharse, & - alphasne, alphasnw, alphassw, alphasse + alpharne, alpharnw, alpharsw, alpharse, & + alphasne, alphasnw, alphassw, alphasse character(len=*), parameter :: subname = '(stress_eap)' @@ -1284,50 +1260,55 @@ subroutine stress_eap (nx_block, ny_block, & ! Initialize !----------------------------------------------------------------- - strtmp(:,:,:) = c0 + call icepack_query_parameters(puny_out=puny) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) - do ij = 1, icellT - i = indxTi(ij) - j = indxTj(ij) + strtmp(:,:,:) = c0 - !----------------------------------------------------------------- - ! strain rates - ! NOTE these are actually strain rates * area (m^2/s) - !----------------------------------------------------------------- + do ij = 1, icellt + i = indxti(ij) + j = indxtj(ij) + !----------------------------------------------------------------- + ! strain rates + ! NOTE these are actually strain rates * area (m^2/s) + !----------------------------------------------------------------- ! divergence = e_11 + e_22 - divune = cyp(i,j)*uvel(i ,j ) - dyT(i,j)*uvel(i-1,j ) & - + cxp(i,j)*vvel(i ,j ) - dxT(i,j)*vvel(i ,j-1) - divunw = cym(i,j)*uvel(i-1,j ) + dyT(i,j)*uvel(i ,j ) & - + cxp(i,j)*vvel(i-1,j ) - dxT(i,j)*vvel(i-1,j-1) - divusw = cym(i,j)*uvel(i-1,j-1) + dyT(i,j)*uvel(i ,j-1) & - + cxm(i,j)*vvel(i-1,j-1) + dxT(i,j)*vvel(i-1,j ) - divuse = cyp(i,j)*uvel(i ,j-1) - dyT(i,j)*uvel(i-1,j-1) & - + cxm(i,j)*vvel(i ,j-1) + dxT(i,j)*vvel(i ,j ) + divune = cyp(i,j)*uvel(i ,j ) - dyt(i,j)*uvel(i-1,j ) & + + cxp(i,j)*vvel(i ,j ) - dxt(i,j)*vvel(i ,j-1) + divunw = cym(i,j)*uvel(i-1,j ) + dyt(i,j)*uvel(i ,j ) & + + cxp(i,j)*vvel(i-1,j ) - dxt(i,j)*vvel(i-1,j-1) + divusw = cym(i,j)*uvel(i-1,j-1) + dyt(i,j)*uvel(i ,j-1) & + + cxm(i,j)*vvel(i-1,j-1) + dxt(i,j)*vvel(i-1,j ) + divuse = cyp(i,j)*uvel(i ,j-1) - dyt(i,j)*uvel(i-1,j-1) & + + cxm(i,j)*vvel(i ,j-1) + dxt(i,j)*vvel(i ,j ) ! tension strain rate = e_11 - e_22 - tensionne = -cym(i,j)*uvel(i ,j ) - dyT(i,j)*uvel(i-1,j ) & - + cxm(i,j)*vvel(i ,j ) + dxT(i,j)*vvel(i ,j-1) - tensionnw = -cyp(i,j)*uvel(i-1,j ) + dyT(i,j)*uvel(i ,j ) & - + cxm(i,j)*vvel(i-1,j ) + dxT(i,j)*vvel(i-1,j-1) - tensionsw = -cyp(i,j)*uvel(i-1,j-1) + dyT(i,j)*uvel(i ,j-1) & - + cxp(i,j)*vvel(i-1,j-1) - dxT(i,j)*vvel(i-1,j ) - tensionse = -cym(i,j)*uvel(i ,j-1) - dyT(i,j)*uvel(i-1,j-1) & - + cxp(i,j)*vvel(i ,j-1) - dxT(i,j)*vvel(i ,j ) + tensionne = -cym(i,j)*uvel(i ,j ) - dyt(i,j)*uvel(i-1,j ) & + + cxm(i,j)*vvel(i ,j ) + dxt(i,j)*vvel(i ,j-1) + tensionnw = -cyp(i,j)*uvel(i-1,j ) + dyt(i,j)*uvel(i ,j ) & + + cxm(i,j)*vvel(i-1,j ) + dxt(i,j)*vvel(i-1,j-1) + tensionsw = -cyp(i,j)*uvel(i-1,j-1) + dyt(i,j)*uvel(i ,j-1) & + + cxp(i,j)*vvel(i-1,j-1) - dxt(i,j)*vvel(i-1,j ) + tensionse = -cym(i,j)*uvel(i ,j-1) - dyt(i,j)*uvel(i-1,j-1) & + + cxp(i,j)*vvel(i ,j-1) - dxt(i,j)*vvel(i ,j ) ! shearing strain rate = 2*e_12 - shearne = -cym(i,j)*vvel(i ,j ) - dyT(i,j)*vvel(i-1,j ) & - - cxm(i,j)*uvel(i ,j ) - dxT(i,j)*uvel(i ,j-1) - shearnw = -cyp(i,j)*vvel(i-1,j ) + dyT(i,j)*vvel(i ,j ) & - - cxm(i,j)*uvel(i-1,j ) - dxT(i,j)*uvel(i-1,j-1) - shearsw = -cyp(i,j)*vvel(i-1,j-1) + dyT(i,j)*vvel(i ,j-1) & - - cxp(i,j)*uvel(i-1,j-1) + dxT(i,j)*uvel(i-1,j ) - shearse = -cym(i,j)*vvel(i ,j-1) - dyT(i,j)*vvel(i-1,j-1) & - - cxp(i,j)*uvel(i ,j-1) + dxT(i,j)*uvel(i ,j ) - - !----------------------------------------------------------------- - ! Stress updated depending on strain rate and structure tensor - !----------------------------------------------------------------- + shearne = -cym(i,j)*vvel(i ,j ) - dyt(i,j)*vvel(i-1,j ) & + - cxm(i,j)*uvel(i ,j ) - dxt(i,j)*uvel(i ,j-1) + shearnw = -cyp(i,j)*vvel(i-1,j ) + dyt(i,j)*vvel(i ,j ) & + - cxm(i,j)*uvel(i-1,j ) - dxt(i,j)*uvel(i-1,j-1) + shearsw = -cyp(i,j)*vvel(i-1,j-1) + dyt(i,j)*vvel(i ,j-1) & + - cxp(i,j)*uvel(i-1,j-1) + dxt(i,j)*uvel(i-1,j ) + shearse = -cym(i,j)*vvel(i ,j-1) - dyt(i,j)*vvel(i-1,j-1) & + - cxp(i,j)*uvel(i ,j-1) + dxt(i,j)*uvel(i ,j ) + + !----------------------------------------------------------------- + ! Stress updated depending on strain rate and structure tensor + !----------------------------------------------------------------- +! call ice_timer_start(timer_tmp2) ! dynamics ! ne call update_stress_rdg (ksub, ndte, divune, tensionne, & @@ -1354,10 +1335,10 @@ subroutine stress_eap (nx_block, ny_block, & stress12tmp_4, strength(i,j), & alpharse, alphasse) - !----------------------------------------------------------------- - ! on last subcycle, save quantities for mechanical redistribution - !----------------------------------------------------------------- - +! call ice_timer_stop(timer_tmp2) ! dynamics + !----------------------------------------------------------------- + ! on last subcycle, save quantities for mechanical redistribution + !----------------------------------------------------------------- if (ksub == ndte) then ! diagnostic only @@ -1366,13 +1347,6 @@ subroutine stress_eap (nx_block, ny_block, & (tensionne + tensionnw + tensionse + tensionsw)**2 & + (shearne + shearnw + shearse + shearsw)**2) - ! vorticity - dvdxn = dyU(i,j)*vvel(i,j) - dyU(i-1,j)*vvel(i-1,j) - dvdxs = dyU(i,j-1)*vvel(i,j-1) - dyU(i-1,j-1)*vvel(i-1,j-1) - dudye = dxU(i,j)*uvel(i,j) - dxU(i,j-1)*uvel(i,j-1) - dudyw = dxU(i-1,j)*uvel(i-1,j) - dxU(i-1,j-1)*uvel(i-1,j-1) - vort(i,j) = p5*tarear(i,j)*(dvdxn + dvdxs - dudye - dudyw) - divu(i,j) = p25*(divune + divunw + divuse + divusw) * tarear(i,j) rdg_conv(i,j) = -min(p25*(alpharne + alpharnw & + alpharsw + alpharse),c0) * tarear(i,j) @@ -1389,9 +1363,9 @@ subroutine stress_eap (nx_block, ny_block, & e22(i,j) = p5*p25*(divune + divunw + divuse + divusw - & tensionne - tensionnw - tensionse - tensionsw) * tarear(i,j) - !----------------------------------------------------------------- - ! elastic relaxation, see Eq. A12-A14 - !----------------------------------------------------------------- + !----------------------------------------------------------------- + ! elastic relaxation, see Eq. A12-A14 + !----------------------------------------------------------------- stressp_1(i,j) = (stressp_1(i,j) + stressptmp_1*arlx1i) & * denom1 @@ -1420,14 +1394,14 @@ subroutine stress_eap (nx_block, ny_block, & stress12_4(i,j) = (stress12_4(i,j) + stress12tmp_4*arlx1i) & * denom1 - s11(i,j) = p5 * p25 * (stressp_1 (i,j) + stressp_2 (i,j) & - + stressp_3 (i,j) + stressp_4 (i,j) & - + stressm_1 (i,j) + stressm_2 (i,j) & - + stressm_3 (i,j) + stressm_4 (i,j)) - s22(i,j) = p5 * p25 * (stressp_1 (i,j) + stressp_2 (i,j) & - + stressp_3 (i,j) + stressp_4 (i,j) & - - stressm_1 (i,j) - stressm_2 (i,j) & - - stressm_3 (i,j) - stressm_4 (i,j)) + s11(i,j) = p5 * p25 * (stressp_1(i,j) + stressp_2(i,j) & + + stressp_3(i,j) + stressp_4(i,j) & + + stressm_1(i,j) + stressm_2(i,j) & + + stressm_3(i,j) + stressm_4(i,j)) + s22(i,j) = p5 * p25 * (stressp_1(i,j) + stressp_2(i,j) & + + stressp_3(i,j) + stressp_4(i,j) & + - stressm_1(i,j) - stressm_2(i,j) & + - stressm_3(i,j) - stressm_4(i,j)) s12(i,j) = p25 * (stress12_1(i,j) + stress12_2(i,j) & + stress12_3(i,j) + stress12_4(i,j)) @@ -1442,34 +1416,34 @@ subroutine stress_eap (nx_block, ny_block, & yieldstress12(i,j) = p25 * (stress12tmp_1 + stress12tmp_2 & + stress12tmp_3 + stress12tmp_4) - !----------------------------------------------------------------- - ! Eliminate underflows. - ! The following code is commented out because it is relatively - ! expensive and most compilers include a flag that accomplishes - ! the same thing more efficiently. This code is cheaper than - ! handling underflows if the compiler lacks a flag; uncomment - ! it in that case. The compiler flag is often described with the - ! phrase "flush to zero". - !----------------------------------------------------------------- - -! stressp_1(i,j) = sign(max(abs(stressp_1(i,j)),puny),stressp_1(i,j)) -! stressp_2(i,j) = sign(max(abs(stressp_2(i,j)),puny),stressp_2(i,j)) -! stressp_3(i,j) = sign(max(abs(stressp_3(i,j)),puny),stressp_3(i,j)) -! stressp_4(i,j) = sign(max(abs(stressp_4(i,j)),puny),stressp_4(i,j)) - -! stressm_1(i,j) = sign(max(abs(stressm_1(i,j)),puny),stressm_1(i,j)) -! stressm_2(i,j) = sign(max(abs(stressm_2(i,j)),puny),stressm_2(i,j)) -! stressm_3(i,j) = sign(max(abs(stressm_3(i,j)),puny),stressm_3(i,j)) -! stressm_4(i,j) = sign(max(abs(stressm_4(i,j)),puny),stressm_4(i,j)) - -! stress12_1(i,j) = sign(max(abs(stress12_1(i,j)),puny),stress12_1(i,j)) -! stress12_2(i,j) = sign(max(abs(stress12_2(i,j)),puny),stress12_2(i,j)) -! stress12_3(i,j) = sign(max(abs(stress12_3(i,j)),puny),stress12_3(i,j)) -! stress12_4(i,j) = sign(max(abs(stress12_4(i,j)),puny),stress12_4(i,j)) - - !----------------------------------------------------------------- - ! combinations of the stresses for the momentum equation ! kg/s^2 - !----------------------------------------------------------------- + !----------------------------------------------------------------- + ! Eliminate underflows. + ! The following code is commented out because it is relatively + ! expensive and most compilers include a flag that accomplishes + ! the same thing more efficiently. This code is cheaper than + ! handling underflows if the compiler lacks a flag; uncomment + ! it in that case. The compiler flag is often described with the + ! phrase "flush to zero". + !----------------------------------------------------------------- + +! stressp_1(i,j) = sign(max(abs(stressp_1(i,j)),puny),stressp_1(i,j)) +! stressp_2(i,j) = sign(max(abs(stressp_2(i,j)),puny),stressp_2(i,j)) +! stressp_3(i,j) = sign(max(abs(stressp_3(i,j)),puny),stressp_3(i,j)) +! stressp_4(i,j) = sign(max(abs(stressp_4(i,j)),puny),stressp_4(i,j)) + +! stressm_1(i,j) = sign(max(abs(stressm_1(i,j)),puny),stressm_1(i,j)) +! stressm_2(i,j) = sign(max(abs(stressm_2(i,j)),puny),stressm_2(i,j)) +! stressm_3(i,j) = sign(max(abs(stressm_3(i,j)),puny),stressm_3(i,j)) +! stressm_4(i,j) = sign(max(abs(stressm_4(i,j)),puny),stressm_4(i,j)) + +! stress12_1(i,j) = sign(max(abs(stress12_1(i,j)),puny),stress12_1(i,j)) +! stress12_2(i,j) = sign(max(abs(stress12_2(i,j)),puny),stress12_2(i,j)) +! stress12_3(i,j) = sign(max(abs(stress12_3(i,j)),puny),stress12_3(i,j)) +! stress12_4(i,j) = sign(max(abs(stress12_4(i,j)),puny),stress12_4(i,j)) + + !----------------------------------------------------------------- + ! combinations of the stresses for the momentum equation ! kg/s^2 + !----------------------------------------------------------------- ssigpn = stressp_1(i,j) + stressp_2(i,j) ssigps = stressp_3(i,j) + stressp_4(i,j) @@ -1496,12 +1470,12 @@ subroutine stress_eap (nx_block, ny_block, & csigpnw = p111*stressp_2(i,j) + ssigp1 + p027*stressp_4(i,j) csigpsw = p111*stressp_3(i,j) + ssigp2 + p027*stressp_1(i,j) csigpse = p111*stressp_4(i,j) + ssigp1 + p027*stressp_2(i,j) - + csigmne = p111*stressm_1(i,j) + ssigm2 + p027*stressm_3(i,j) csigmnw = p111*stressm_2(i,j) + ssigm1 + p027*stressm_4(i,j) csigmsw = p111*stressm_3(i,j) + ssigm2 + p027*stressm_1(i,j) csigmse = p111*stressm_4(i,j) + ssigm1 + p027*stressm_2(i,j) - + csig12ne = p222*stress12_1(i,j) + ssig122 & + p055*stress12_3(i,j) csig12nw = p222*stress12_2(i,j) + ssig121 & @@ -1511,17 +1485,16 @@ subroutine stress_eap (nx_block, ny_block, & csig12se = p222*stress12_4(i,j) + ssig121 & + p055*stress12_2(i,j) - str12ew = p5*dxT(i,j)*(p333*ssig12e + p166*ssig12w) - str12we = p5*dxT(i,j)*(p333*ssig12w + p166*ssig12e) - str12ns = p5*dyT(i,j)*(p333*ssig12n + p166*ssig12s) - str12sn = p5*dyT(i,j)*(p333*ssig12s + p166*ssig12n) + str12ew = p5*dxt(i,j)*(p333*ssig12e + p166*ssig12w) + str12we = p5*dxt(i,j)*(p333*ssig12w + p166*ssig12e) + str12ns = p5*dyt(i,j)*(p333*ssig12n + p166*ssig12s) + str12sn = p5*dyt(i,j)*(p333*ssig12s + p166*ssig12n) - !----------------------------------------------------------------- - ! for dF/dx (u momentum) - !----------------------------------------------------------------- - - strp_tmp = p25*dyT(i,j)*(p333*ssigpn + p166*ssigps) - strm_tmp = p25*dyT(i,j)*(p333*ssigmn + p166*ssigms) + !----------------------------------------------------------------- + ! for dF/dx (u momentum) + !----------------------------------------------------------------- + strp_tmp = p25*dyt(i,j)*(p333*ssigpn + p166*ssigps) + strm_tmp = p25*dyt(i,j)*(p333*ssigmn + p166*ssigms) ! northeast (i,j) strtmp(i,j,1) = -strp_tmp - strm_tmp - str12ew & @@ -1531,8 +1504,8 @@ subroutine stress_eap (nx_block, ny_block, & strtmp(i,j,2) = strp_tmp + strm_tmp - str12we & + dxhy(i,j)*(-csigpnw + csigmnw) + dyhx(i,j)*csig12nw - strp_tmp = p25*dyT(i,j)*(p333*ssigps + p166*ssigpn) - strm_tmp = p25*dyT(i,j)*(p333*ssigms + p166*ssigmn) + strp_tmp = p25*dyt(i,j)*(p333*ssigps + p166*ssigpn) + strm_tmp = p25*dyt(i,j)*(p333*ssigms + p166*ssigmn) ! southeast (i,j+1) strtmp(i,j,3) = -strp_tmp - strm_tmp + str12ew & @@ -1542,12 +1515,11 @@ subroutine stress_eap (nx_block, ny_block, & strtmp(i,j,4) = strp_tmp + strm_tmp + str12we & + dxhy(i,j)*(-csigpsw + csigmsw) + dyhx(i,j)*csig12sw - !----------------------------------------------------------------- - ! for dF/dy (v momentum) - !----------------------------------------------------------------- - - strp_tmp = p25*dxT(i,j)*(p333*ssigpe + p166*ssigpw) - strm_tmp = p25*dxT(i,j)*(p333*ssigme + p166*ssigmw) + !----------------------------------------------------------------- + ! for dF/dy (v momentum) + !----------------------------------------------------------------- + strp_tmp = p25*dxt(i,j)*(p333*ssigpe + p166*ssigpw) + strm_tmp = p25*dxt(i,j)*(p333*ssigme + p166*ssigmw) ! northeast (i,j) strtmp(i,j,5) = -strp_tmp + strm_tmp - str12ns & @@ -1557,8 +1529,8 @@ subroutine stress_eap (nx_block, ny_block, & strtmp(i,j,6) = strp_tmp - strm_tmp - str12sn & - dyhx(i,j)*(csigpse + csigmse) + dxhy(i,j)*csig12se - strp_tmp = p25*dxT(i,j)*(p333*ssigpw + p166*ssigpe) - strm_tmp = p25*dxT(i,j)*(p333*ssigmw + p166*ssigme) + strp_tmp = p25*dxt(i,j)*(p333*ssigpw + p166*ssigpe) + strm_tmp = p25*dxt(i,j)*(p333*ssigmw + p166*ssigme) ! northwest (i+1,j) strtmp(i,j,7) = -strp_tmp + strm_tmp + str12ns & @@ -1573,6 +1545,7 @@ subroutine stress_eap (nx_block, ny_block, & end subroutine stress_eap !======================================================================= + ! Updates the stress depending on values of strain rate and structure ! tensor and for ksub=ndte it computes closing and sliding rate @@ -1593,7 +1566,7 @@ subroutine update_stress_rdg (ksub, ndte, divu, tension, & real (kind=dbl_kind), intent(out) :: & stressp, stressm, stress12, & - alphar, alphas + alphar, alphas ! local variables @@ -1610,11 +1583,17 @@ subroutine update_stress_rdg (ksub, ndte, divu, tension, & rotstemp11s, rotstemp12s, rotstemp22s, & sig11, sig12, sig22, & sgprm11, sgprm12, sgprm22, & + invstressconviso, & Angle_denom_gamma, Angle_denom_alpha, & Tany_1, Tany_2, & x, y, dx, dy, da, & + invdx, invdy, invda, invsin, & dtemp1, dtemp2, atempprime, & - kxw, kyw, kaw + kxw, kyw, kaw, & + puny, pi, pi2, piq, pih + + real (kind=dbl_kind), parameter :: & + kfriction = 0.45_dbl_kind ! tcraig, temporary, should be moved to namelist ! turns on interpolation in stress_rdg @@ -1623,251 +1602,267 @@ subroutine update_stress_rdg (ksub, ndte, divu, tension, & character(len=*), parameter :: subname = '(update_stress_rdg)' - ! compute eigenvalues, eigenvectors and angles for structure tensor, strain rates + call icepack_query_parameters(puny_out=puny, & + pi_out=pi, pi2_out=pi2, piq_out=piq, pih_out=pih) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) - ! 1) structure tensor +! Factor to maintain the same stress as in EVP (see Section 3) +! Can be set to 1 otherwise - a22 = c1-a11 + invstressconviso = c1/(c1+kfriction*kfriction) + invsin = c1/sin(pi2/c12) * invstressconviso - ! gamma: angle between general coordinates and principal axis of A - ! here Tan2gamma = 2 a12 / (a11 - a22) +! compute eigenvalues, eigenvectors and angles for structure tensor, strain rates - Q11Q11 = c1 - Q12Q12 = puny - Q11Q12 = puny +! 1) structure tensor - if ((ABS(a11 - a22) > puny).or.(ABS(a12) > puny)) then - Angle_denom_gamma = sqrt( ( a11 - a22 )*( a11 - a22) + & - c4*a12*a12 ) - - Q11Q11 = p5 + ( a11 - a22 )*p5/Angle_denom_gamma !Cos^2 - Q12Q12 = p5 - ( a11 - a22 )*p5/Angle_denom_gamma !Sin^2 - Q11Q12 = a12/Angle_denom_gamma !CosSin - endif - - ! rotation Q*atemp*Q^T - atempprime = Q11Q11*a11 + c2*Q11Q12*a12 + Q12Q12*a22 + a22 = c1-a11 - ! make first principal value the largest - atempprime = max(atempprime, c1 - atempprime) +! gamma: angle between general coordiantes and principal axis of A +! here Tan2gamma = 2 a12 / (a11 - a22) - ! 2) strain rate + Q11Q11 = c1 + Q12Q12 = puny + Q11Q12 = puny - dtemp11 = p5*(divu + tension) - dtemp12 = shear*p5 - dtemp22 = p5*(divu - tension) - - ! here Tan2alpha = 2 dtemp12 / (dtemp11 - dtemp22) - - Qd11Qd11 = c1 - Qd12Qd12 = puny - Qd11Qd12 = puny + if((ABS(a11 - a22) > puny).or.(ABS(a12) > puny)) then + Angle_denom_gamma = sqrt( ( a11 - a22 )*( a11 - a22) + & + c4*a12*a12 ) - if ((ABS( dtemp11 - dtemp22) > puny).or.(ABS(dtemp12) > puny)) then - Angle_denom_alpha = sqrt( ( dtemp11 - dtemp22 )* & - ( dtemp11 - dtemp22 ) + c4*dtemp12*dtemp12) + Q11Q11 = p5 + ( a11 - a22 )*p5/Angle_denom_gamma !Cos^2 + Q12Q12 = p5 - ( a11 - a22 )*p5/Angle_denom_gamma !Sin^2 + Q11Q12 = a12/Angle_denom_gamma !CosSin + endif - Qd11Qd11 = p5 + ( dtemp11 - dtemp22 )*p5/Angle_denom_alpha !Cos^2 - Qd12Qd12 = p5 - ( dtemp11 - dtemp22 )*p5/Angle_denom_alpha !Sin^2 - Qd11Qd12 = dtemp12/Angle_denom_alpha !CosSin - endif +! rotation Q*atemp*Q^T + atempprime = Q11Q11*a11 + c2*Q11Q12*a12 + Q12Q12*a22 - dtemp1 = Qd11Qd11*dtemp11 + c2*Qd11Qd12*dtemp12 + Qd12Qd12*dtemp22 - dtemp2 = Qd12Qd12*dtemp11 - c2*Qd11Qd12*dtemp12 + Qd11Qd11*dtemp22 +! make first principal value the largest + atempprime = max(atempprime, c1 - atempprime) - ! In cos and sin values - x = c0 +! 2) strain rate - if ((ABS(dtemp1) > puny).or.(ABS(dtemp2) > puny)) then -! invleng = c1/sqrt(dtemp1*dtemp1 + dtemp2*dtemp2) ! not sure if this is neccessary -! dtemp1 = dtemp1*invleng -! dtemp2 = dtemp2*invleng - if (dtemp1 == c0) then - x = pih - else - x = atan2(dtemp2,dtemp1) - endif - endif + dtemp11 = p5*(divu + tension) + dtemp12 = shear*p5 + dtemp22 = p5*(divu - tension) - !echmod to ensure the angle lies between pi/4 and 9 pi/4 - if (x < piq) x = x + pi2 - !echmod require 0 <= x < (nx_yield-1)*dx = 2 pi -! x = mod(x+pi2, pi2) - ! y: angle between major principal axis of strain rate and structure tensor - ! y = gamma - alpha - ! Expressesed componently with - ! Tany = (Singamma*Cosgamma - Sinalpha*Cosgamma)/(Cos^2gamma - Sin^alpha) - - Tany_1 = Q11Q12 - Qd11Qd12 - Tany_2 = Q11Q11 - Qd12Qd12 - - y = c0 - - if ((ABS(Tany_1) > puny).or.(ABS(Tany_2) > puny)) then -! invleng = c1/sqrt(Tany_1*Tany_1 + Tany_2*Tany_2) ! not sure if this is neccessary -! Tany_1 = Tany_1*invleng -! Tany_2 = Tany_2*invleng - if (Tany_2 == c0) then - y = pih - else - y = atan2(Tany_1,Tany_2) - endif - endif +! here Tan2alpha = 2 dtemp12 / (dtemp11 - dtemp22) - ! to make sure y is between 0 and pi - - if (y > pi) y = y - pi - if (y < 0) y = y + pi - - if (interpolate_stress_rdg) then - - ! Interpolated lookup - - ! if (x>=9*pi/4) x=9*pi/4-puny; end - ! if (y>=pi/2) y=pi/2-puny; end - ! if (atempprime>=1.0), atempprime=1.0-puny; end - - ! % need 8 coords and 8 weights - ! % range in kx - - kx = int((x-piq-pi)*invdx) + 1 - kxw = c1 - ((x-piq-pi)*invdx - (kx-1)) - - ky = int(y*invdy) + 1 - kyw = c1 - (y*invdy - (ky-1)) - - ka = int((atempprime-p5)*invda) + 1 - kaw = c1 - ((atempprime-p5)*invda - (ka-1)) - - ! % Determine sigma_r(A1,Zeta,y) and sigma_s (see Section A1) - - stemp11r = kxw* kyw * kaw * s11r(kx ,ky ,ka ) & - + (c1-kxw) * kyw * kaw * s11r(kx+1,ky ,ka ) & - + kxw * (c1-kyw) * kaw * s11r(kx ,ky+1,ka ) & - + kxw * kyw * (c1-kaw) * s11r(kx ,ky ,ka+1) & - + (c1-kxw) * (c1-kyw) * kaw * s11r(kx+1,ky+1,ka ) & - + (c1-kxw) * kyw * (c1-kaw) * s11r(kx+1,ky ,ka+1) & - + kxw * (c1-kyw) * (c1-kaw) * s11r(kx ,ky+1,ka+1) & - + (c1-kxw) * (c1-kyw) * (c1-kaw) * s11r(kx+1,ky+1,ka+1) - - stemp12r = kxw* kyw * kaw * s12r(kx ,ky ,ka ) & - + (c1-kxw) * kyw * kaw * s12r(kx+1,ky ,ka ) & - + kxw * (c1-kyw) * kaw * s12r(kx ,ky+1,ka ) & - + kxw * kyw * (c1-kaw) * s12r(kx ,ky ,ka+1) & - + (c1-kxw) * (c1-kyw) * kaw * s12r(kx+1,ky+1,ka ) & - + (c1-kxw) * kyw * (c1-kaw) * s12r(kx+1,ky ,ka+1) & - + kxw * (c1-kyw) * (c1-kaw) * s12r(kx ,ky+1,ka+1) & - + (c1-kxw) * (c1-kyw) * (c1-kaw) * s12r(kx+1,ky+1,ka+1) - - stemp22r = kxw * kyw * kaw * s22r(kx ,ky ,ka ) & - + (c1-kxw) * kyw * kaw * s22r(kx+1,ky ,ka ) & - + kxw * (c1-kyw) * kaw * s22r(kx ,ky+1,ka ) & - + kxw * kyw * (c1-kaw) * s22r(kx ,ky ,ka+1) & - + (c1-kxw) * (c1-kyw) * kaw * s22r(kx+1,ky+1,ka ) & - + (c1-kxw) * kyw * (c1-kaw) * s22r(kx+1,ky ,ka+1) & - + kxw * (c1-kyw) * (c1-kaw) * s22r(kx ,ky+1,ka+1) & - + (c1-kxw) * (c1-kyw) * (c1-kaw) * s22r(kx+1,ky+1,ka+1) - - stemp11s = kxw* kyw * kaw * s11s(kx ,ky ,ka ) & - + (c1-kxw) * kyw * kaw * s11s(kx+1,ky ,ka ) & - + kxw * (c1-kyw) * kaw * s11s(kx ,ky+1,ka ) & - + kxw * kyw * (c1-kaw) * s11s(kx ,ky ,ka+1) & - + (c1-kxw) * (c1-kyw) * kaw * s11s(kx+1,ky+1,ka ) & - + (c1-kxw) * kyw * (c1-kaw) * s11s(kx+1,ky ,ka+1) & - + kxw * (c1-kyw) * (c1-kaw) * s11s(kx ,ky+1,ka+1) & - + (c1-kxw) * (c1-kyw) * (c1-kaw) * s11s(kx+1,ky+1,ka+1) - - stemp12s = kxw* kyw * kaw * s12s(kx ,ky ,ka ) & - + (c1-kxw) * kyw * kaw * s12s(kx+1,ky ,ka ) & - + kxw * (c1-kyw) * kaw * s12s(kx ,ky+1,ka ) & - + kxw * kyw * (c1-kaw) * s12s(kx ,ky ,ka+1) & - + (c1-kxw) * (c1-kyw) * kaw * s12s(kx+1,ky+1,ka ) & - + (c1-kxw) * kyw * (c1-kaw) * s12s(kx+1,ky ,ka+1) & - + kxw * (c1-kyw) * (c1-kaw) * s12s(kx ,ky+1,ka+1) & - + (c1-kxw) * (c1-kyw) * (c1-kaw) * s12s(kx+1,ky+1,ka+1) - - stemp22s = kxw* kyw * kaw * s22s(kx ,ky ,ka ) & - + (c1-kxw) * kyw * kaw * s22s(kx+1,ky ,ka ) & - + kxw * (c1-kyw) * kaw * s22s(kx ,ky+1,ka ) & - + kxw * kyw * (c1-kaw) * s22s(kx ,ky ,ka+1) & - + (c1-kxw) * (c1-kyw) * kaw * s22s(kx+1,ky+1,ka ) & - + (c1-kxw) * kyw * (c1-kaw) * s22s(kx+1,ky ,ka+1) & - + kxw * (c1-kyw) * (c1-kaw) * s22s(kx ,ky+1,ka+1) & - + (c1-kxw) * (c1-kyw) * (c1-kaw) * s22s(kx+1,ky+1,ka+1) + Qd11Qd11 = c1 + Qd12Qd12 = puny + Qd11Qd12 = puny - else + if((ABS( dtemp11 - dtemp22) > puny).or.(ABS(dtemp12) > puny)) then + Angle_denom_alpha = sqrt( ( dtemp11 - dtemp22 )* & + ( dtemp11 - dtemp22 ) + c4*dtemp12*dtemp12) - kx = int((x-piq-pi)*invdx) + 1 - ky = int(y*invdy) + 1 - ka = int((atempprime-p5)*invda) + 1 + Qd11Qd11 = p5 + ( dtemp11 - dtemp22 )*p5/Angle_denom_alpha !Cos^2 + Qd12Qd12 = p5 - ( dtemp11 - dtemp22 )*p5/Angle_denom_alpha !Sin^2 + Qd11Qd12 = dtemp12/Angle_denom_alpha !CosSin + endif - ! Determine sigma_r(A1,Zeta,y) and sigma_s (see Section A1) + dtemp1 = Qd11Qd11*dtemp11 + c2*Qd11Qd12*dtemp12 + Qd12Qd12*dtemp22 + dtemp2 = Qd12Qd12*dtemp11 - c2*Qd11Qd12*dtemp12 + Qd11Qd11*dtemp22 - stemp11r = s11r(kx,ky,ka) - stemp12r = s12r(kx,ky,ka) - stemp22r = s22r(kx,ky,ka) +! In cos and sin values + x = c0 - stemp11s = s11s(kx,ky,ka) - stemp12s = s12s(kx,ky,ka) - stemp22s = s22s(kx,ky,ka) - - endif - - ! Calculate mean ice stress over a collection of floes (Equation 3) + if ((ABS(dtemp1) > puny).or.(ABS(dtemp2) > puny)) then +! invleng = c1/sqrt(dtemp1*dtemp1 + dtemp2*dtemp2) ! not sure if this is neccessary +! dtemp1 = dtemp1*invleng +! dtemp2 = dtemp2*invleng + if (dtemp1 == c0) then + x = pih + else + x = atan2(dtemp2,dtemp1) + endif + endif - stressp = strength*(stemp11r + kfriction*stemp11s & - + stemp22r + kfriction*stemp22s) * invsin - stress12 = strength*(stemp12r + kfriction*stemp12s) * invsin - stressm = strength*(stemp11r + kfriction*stemp11s & - - stemp22r - kfriction*stemp22s) * invsin +!echmod to ensure the angle lies between pi/4 and 9 pi/4 + if (x < piq) x = x + pi2 +!echmod require 0 <= x < (nx_yield-1)*dx = 2 pi +! x = mod(x+pi2, pi2) + +! y: angle between major principal axis of strain rate and structure tensor +! y = gamma - alpha +! Expressesed componently with +! Tany = (Singamma*Cosgamma - Sinalpha*Cosgamma)/(Cos^2gamma - Sin^alpha) + + Tany_1 = Q11Q12 - Qd11Qd12 + Tany_2 = Q11Q11 - Qd12Qd12 + + y = c0 + + if ((ABS(Tany_1) > puny).or.(ABS(Tany_2) > puny)) then +! invleng = c1/sqrt(Tany_1*Tany_1 + Tany_2*Tany_2) ! not sure if this is neccessary +! Tany_1 = Tany_1*invleng +! Tany_2 = Tany_2*invleng + if (Tany_2 == c0) then + y = pih + else + y = atan2(Tany_1,Tany_2) + endif + endif - ! Back - rotation of the stress from principal axes into general coordinates +! to make sure y is between 0 and pi + if (y > pi) y = y - pi + if (y < 0) y = y + pi + +! Now calculate updated stress tensor + dx = pi/real(nx_yield-1,kind=dbl_kind) + dy = pi/real(ny_yield-1,kind=dbl_kind) + da = p5/real(na_yield-1,kind=dbl_kind) + invdx = c1/dx + invdy = c1/dy + invda = c1/da + + if (interpolate_stress_rdg) then + +! Interpolated lookup + + ! if (x>=9*pi/4) x=9*pi/4-puny; end + ! if (y>=pi/2) y=pi/2-puny; end + ! if (atempprime>=1.0), atempprime=1.0-puny; end + + ! % need 8 coords and 8 weights + ! % range in kx + + kx = int((x-piq-pi)*invdx) + 1 + kxw = c1 - ((x-piq-pi)*invdx - (kx-1)) + + ky = int(y*invdy) + 1 + kyw = c1 - (y*invdy - (ky-1)) + + ka = int((atempprime-p5)*invda) + 1 + kaw = c1 - ((atempprime-p5)*invda - (ka-1)) + +! % Determine sigma_r(A1,Zeta,y) and sigma_s (see Section A1) + + stemp11r = kxw* kyw * kaw * s11r(kx ,ky ,ka ) & + + (c1-kxw) * kyw * kaw * s11r(kx+1,ky ,ka ) & + + kxw * (c1-kyw) * kaw * s11r(kx ,ky+1,ka ) & + + kxw * kyw * (c1-kaw) * s11r(kx ,ky ,ka+1) & + + (c1-kxw) * (c1-kyw) * kaw * s11r(kx+1,ky+1,ka ) & + + (c1-kxw) * kyw * (c1-kaw) * s11r(kx+1,ky ,ka+1) & + + kxw * (c1-kyw) * (c1-kaw) * s11r(kx ,ky+1,ka+1) & + + (c1-kxw) * (c1-kyw) * (c1-kaw) * s11r(kx+1,ky+1,ka+1) + + stemp12r = kxw* kyw * kaw * s12r(kx ,ky ,ka ) & + + (c1-kxw) * kyw * kaw * s12r(kx+1,ky ,ka ) & + + kxw * (c1-kyw) * kaw * s12r(kx ,ky+1,ka ) & + + kxw * kyw * (c1-kaw) * s12r(kx ,ky ,ka+1) & + + (c1-kxw) * (c1-kyw) * kaw * s12r(kx+1,ky+1,ka ) & + + (c1-kxw) * kyw * (c1-kaw) * s12r(kx+1,ky ,ka+1) & + + kxw * (c1-kyw) * (c1-kaw) * s12r(kx ,ky+1,ka+1) & + + (c1-kxw) * (c1-kyw) * (c1-kaw) * s12r(kx+1,ky+1,ka+1) + + stemp22r = kxw * kyw * kaw * s22r(kx ,ky ,ka ) & + + (c1-kxw) * kyw * kaw * s22r(kx+1,ky ,ka ) & + + kxw * (c1-kyw) * kaw * s22r(kx ,ky+1,ka ) & + + kxw * kyw * (c1-kaw) * s22r(kx ,ky ,ka+1) & + + (c1-kxw) * (c1-kyw) * kaw * s22r(kx+1,ky+1,ka ) & + + (c1-kxw) * kyw * (c1-kaw) * s22r(kx+1,ky ,ka+1) & + + kxw * (c1-kyw) * (c1-kaw) * s22r(kx ,ky+1,ka+1) & + + (c1-kxw) * (c1-kyw) * (c1-kaw) * s22r(kx+1,ky+1,ka+1) + + stemp11s = kxw* kyw * kaw * s11s(kx ,ky ,ka ) & + + (c1-kxw) * kyw * kaw * s11s(kx+1,ky ,ka ) & + + kxw * (c1-kyw) * kaw * s11s(kx ,ky+1,ka ) & + + kxw * kyw * (c1-kaw) * s11s(kx ,ky ,ka+1) & + + (c1-kxw) * (c1-kyw) * kaw * s11s(kx+1,ky+1,ka ) & + + (c1-kxw) * kyw * (c1-kaw) * s11s(kx+1,ky ,ka+1) & + + kxw * (c1-kyw) * (c1-kaw) * s11s(kx ,ky+1,ka+1) & + + (c1-kxw) * (c1-kyw) * (c1-kaw) * s11s(kx+1,ky+1,ka+1) + + stemp12s = kxw* kyw * kaw * s12s(kx ,ky ,ka ) & + + (c1-kxw) * kyw * kaw * s12s(kx+1,ky ,ka ) & + + kxw * (c1-kyw) * kaw * s12s(kx ,ky+1,ka ) & + + kxw * kyw * (c1-kaw) * s12s(kx ,ky ,ka+1) & + + (c1-kxw) * (c1-kyw) * kaw * s12s(kx+1,ky+1,ka ) & + + (c1-kxw) * kyw * (c1-kaw) * s12s(kx+1,ky ,ka+1) & + + kxw * (c1-kyw) * (c1-kaw) * s12s(kx ,ky+1,ka+1) & + + (c1-kxw) * (c1-kyw) * (c1-kaw) * s12s(kx+1,ky+1,ka+1) + + stemp22s = kxw* kyw * kaw * s22s(kx ,ky ,ka ) & + + (c1-kxw) * kyw * kaw * s22s(kx+1,ky ,ka ) & + + kxw * (c1-kyw) * kaw * s22s(kx ,ky+1,ka ) & + + kxw * kyw * (c1-kaw) * s22s(kx ,ky ,ka+1) & + + (c1-kxw) * (c1-kyw) * kaw * s22s(kx+1,ky+1,ka ) & + + (c1-kxw) * kyw * (c1-kaw) * s22s(kx+1,ky ,ka+1) & + + kxw * (c1-kyw) * (c1-kaw) * s22s(kx ,ky+1,ka+1) & + + (c1-kxw) * (c1-kyw) * (c1-kaw) * s22s(kx+1,ky+1,ka+1) - ! Update stress + else + kx = int((x-piq-pi)*invdx) + 1 + ky = int(y*invdy) + 1 + ka = int((atempprime-p5)*invda) + 1 + +! Determine sigma_r(A1,Zeta,y) and sigma_s (see Section A1) + stemp11r = s11r(kx,ky,ka) + stemp12r = s12r(kx,ky,ka) + stemp22r = s22r(kx,ky,ka) + + stemp11s = s11s(kx,ky,ka) + stemp12s = s12s(kx,ky,ka) + stemp22s = s22s(kx,ky,ka) + endif - sig11 = p5*(stressp + stressm) - sig12 = stress12 - sig22 = p5*(stressp - stressm) +! Calculate mean ice stress over a collection of floes (Equation 3) - sgprm11 = Q11Q11*sig11 + Q12Q12*sig22 - c2*Q11Q12 *sig12 - sgprm12 = Q11Q12*sig11 - Q11Q12*sig22 + (Q11Q11 - Q12Q12)*sig12 - sgprm22 = Q12Q12*sig11 + Q11Q11*sig22 + c2*Q11Q12 *sig12 + stressp = strength*(stemp11r + kfriction*stemp11s & + + stemp22r + kfriction*stemp22s) * invsin + stress12 = strength*(stemp12r + kfriction*stemp12s) * invsin + stressm = strength*(stemp11r + kfriction*stemp11s & + - stemp22r - kfriction*stemp22s) * invsin - stressp = sgprm11 + sgprm22 - stress12 = sgprm12 - stressm = sgprm11 - sgprm22 +! Back - rotation of the stress from principal axes into general coordinates - ! Compute ridging and sliding functions in general coordinates (Equation 11) +! Update stress + sig11 = p5*(stressp + stressm) + sig12 = stress12 + sig22 = p5*(stressp - stressm) - if (ksub == ndte) then - rotstemp11r = Q11Q11*stemp11r - c2*Q11Q12* stemp12r & - + Q12Q12*stemp22r - rotstemp12r = Q11Q11*stemp12r + Q11Q12*(stemp11r-stemp22r) & - - Q12Q12*stemp12r - rotstemp22r = Q12Q12*stemp11r + c2*Q11Q12* stemp12r & - + Q11Q11*stemp22r + sgprm11 = Q11Q11*sig11 + Q12Q12*sig22 - c2*Q11Q12 *sig12 + sgprm12 = Q11Q12*sig11 - Q11Q12*sig22 + (Q11Q11 - Q12Q12)*sig12 + sgprm22 = Q12Q12*sig11 + Q11Q11*sig22 + c2*Q11Q12 *sig12 - rotstemp11s = Q11Q11*stemp11s - c2*Q11Q12* stemp12s & - + Q12Q12*stemp22s - rotstemp12s = Q11Q11*stemp12s + Q11Q12*(stemp11s-stemp22s) & - - Q12Q12*stemp12s - rotstemp22s = Q12Q12*stemp11s + c2*Q11Q12* stemp12s & - + Q11Q11*stemp22s + stressp = sgprm11 + sgprm22 + stress12 = sgprm12 + stressm = sgprm11 - sgprm22 - alphar = rotstemp11r*dtemp11 + c2*rotstemp12r*dtemp12 & - + rotstemp22r*dtemp22 - alphas = rotstemp11s*dtemp11 + c2*rotstemp12s*dtemp12 & - + rotstemp22s*dtemp22 - endif +! Compute ridging and sliding functions in general coordinates (Equation 11) + if (ksub == ndte) then + rotstemp11r = Q11Q11*stemp11r - c2*Q11Q12* stemp12r & + + Q12Q12*stemp22r + rotstemp12r = Q11Q11*stemp12r + Q11Q12*(stemp11r-stemp22r) & + - Q12Q12*stemp12r + rotstemp22r = Q12Q12*stemp11r + c2*Q11Q12* stemp12r & + + Q11Q11*stemp22r + + rotstemp11s = Q11Q11*stemp11s - c2*Q11Q12* stemp12s & + + Q12Q12*stemp22s + rotstemp12s = Q11Q11*stemp12s + Q11Q12*(stemp11s-stemp22s) & + - Q12Q12*stemp12s + rotstemp22s = Q12Q12*stemp11s + c2*Q11Q12* stemp12s & + + Q11Q11*stemp22s + + alphar = rotstemp11r*dtemp11 + c2*rotstemp12r*dtemp12 & + + rotstemp22r*dtemp22 + alphas = rotstemp11s*dtemp11 + c2*rotstemp12s*dtemp12 & + + rotstemp22s*dtemp22 + endif end subroutine update_stress_rdg !======================================================================= -! Solves evolution equation for structure tensor (A19, A20) + +! Solves evolution equation for structure tensor (A19, A20) subroutine stepa (nx_block, ny_block, & - dtei, icellT, & - indxTi, indxTj, & + dtei, icellt, & + indxti, indxtj, & a11, a12, & a11_1, a11_2, a11_3, a11_4, & a12_1, a12_2, a12_3, a12_4, & @@ -1880,25 +1875,25 @@ subroutine stepa (nx_block, ny_block, & integer (kind=int_kind), intent(in) :: & nx_block, ny_block, & ! block dimensions - icellT ! no. of cells where iceTmask = .true. + icellt ! no. of cells where icetmask = 1 real (kind=dbl_kind), intent(in) :: & dtei ! 1/dte, where dte is subcycling timestep (1/s) integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & - indxTi , & ! compressed index in i-direction - indxTj ! compressed index in j-direction + indxti , & ! compressed index in i-direction + indxtj ! compressed index in j-direction real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & ! ice stress tensor (kg/s^2) in each corner of T cell - stressp_1, stressp_2, stressp_3, stressp_4, & ! sigma11+sigma22 - stressm_1, stressm_2, stressm_3, stressm_4, & ! sigma11-sigma22 + stressp_1, stressp_2, stressp_3, stressp_4, & ! sigma11+sigma22 + stressm_1, stressm_2, stressm_3, stressm_4, & ! sigma11-sigma22 stress12_1, stress12_2, stress12_3, stress12_4 ! sigma12 real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & ! structure tensor () in each corner of T cell - a11, a12, a11_1, a11_2, a11_3, a11_4, & ! components of - a12_1, a12_2, a12_3, a12_4 ! structure tensor () + a11, a12, a11_1, a11_2, a11_3, a11_4, & ! components of + a12_1, a12_2, a12_3, a12_4 ! structure tensor () ! local variables @@ -1906,89 +1901,112 @@ subroutine stepa (nx_block, ny_block, & i, j, ij real (kind=dbl_kind) :: & - mresult11, mresult12, & - dteikth, p5kth + mresult11, mresult12, & + dteikth, p5kth real (kind=dbl_kind), parameter :: & - kth = p2*p001 + kth = p2*p001 character(len=*), parameter :: subname = '(stepa)' dteikth = c1 / (dtei + kth) p5kth = p5 * kth - do ij = 1, icellT - i = indxTi(ij) - j = indxTj(ij) + do ij = 1, icellt + i = indxti(ij) + j = indxtj(ij) - ! ne - call calc_ffrac(stressp_1(i,j), stressm_1(i,j), & - stress12_1(i,j), & - a11_1(i,j), a12_1(i,j), & - mresult11, mresult12) +! ne + call calc_ffrac(1, stressp_1(i,j), stressm_1(i,j), & + stress12_1(i,j), & + a11_1(i,j), & + mresult11) + + call calc_ffrac(2, stressp_1(i,j), stressm_1(i,j), & + stress12_1(i,j), & + a12_1(i,j), & + mresult12) a11_1(i,j) = (a11_1(i,j)*dtei + p5kth - mresult11) * dteikth ! implicit a12_1(i,j) = (a12_1(i,j)*dtei - mresult12) * dteikth ! implicit + +! nw + call calc_ffrac(1, stressp_2(i,j), stressm_2(i,j), & + stress12_2(i,j), & + a11_2(i,j), & + mresult11) - ! nw - call calc_ffrac(stressp_2(i,j), stressm_2(i,j), & - stress12_2(i,j), & - a11_2(i,j), a12_2(i,j), & - mresult11, mresult12) + call calc_ffrac(2, stressp_2(i,j), stressm_2(i,j), & + stress12_2(i,j), & + a12_2(i,j), & + mresult12) a11_2(i,j) = (a11_2(i,j)*dtei + p5kth - mresult11) * dteikth ! implicit a12_2(i,j) = (a12_2(i,j)*dtei - mresult12) * dteikth ! implicit - ! sw - call calc_ffrac(stressp_3(i,j), stressm_3(i,j), & - stress12_3(i,j), & - a11_3(i,j), a12_3(i,j), & - mresult11, mresult12) +! sw + call calc_ffrac(1, stressp_3(i,j), stressm_3(i,j), & + stress12_3(i,j), & + a11_3(i,j), & + mresult11) + + call calc_ffrac(2, stressp_3(i,j), stressm_3(i,j), & + stress12_3(i,j), & + a12_3(i,j), & + mresult12) a11_3(i,j) = (a11_3(i,j)*dtei + p5kth - mresult11) * dteikth ! implicit a12_3(i,j) = (a12_3(i,j)*dtei - mresult12) * dteikth ! implicit - - ! se - call calc_ffrac(stressp_4(i,j), stressm_4(i,j), & - stress12_4(i,j), & - a11_4(i,j), a12_4(i,j), & - mresult11, mresult12) + +! se + call calc_ffrac(1, stressp_4(i,j), stressm_4(i,j), & + stress12_4(i,j), & + a11_4(i,j), & + mresult11) + + call calc_ffrac(2, stressp_4(i,j), stressm_4(i,j), & + stress12_4(i,j), & + a12_4(i,j), & + mresult12) a11_4(i,j) = (a11_4(i,j)*dtei + p5kth - mresult11) * dteikth ! implicit a12_4(i,j) = (a12_4(i,j)*dtei - mresult12) * dteikth ! implicit - ! average structure tensor +! average structure tensor a11(i,j) = p25*(a11_1(i,j) + a11_2(i,j) + a11_3(i,j) + a11_4(i,j)) a12(i,j) = p25*(a12_1(i,j) + a12_2(i,j) + a12_3(i,j) + a12_4(i,j)) - + enddo ! ij - + end subroutine stepa !======================================================================= + ! computes term in evolution equation for structure tensor which determines ! the ice floe re-orientation due to fracture ! Eq. 7: Ffrac = -kf(A-S) or = 0 depending on sigma_1 and sigma_2 + subroutine calc_ffrac (blockno, stressp, stressm, & + stress12, & + a1x, & + mresult) - subroutine calc_ffrac (stressp, stressm, & - stress12, & - a1x, a2x, & - mresult1, mresult2) + integer(kind=int_kind), intent(in) :: & + blockno real (kind=dbl_kind), intent(in) :: & - stressp, stressm, stress12, a1x, a2x + stressp, stressm, stress12, a1x real (kind=dbl_kind), intent(out) :: & - mresult1, mresult2 + mresult ! local variables real (kind=dbl_kind) :: & sigma11, sigma12, sigma22, & - gamma, sigma_1, sigma_2, & + gamma, sigma_1, sigma_2, pih, & Q11, Q12, Q11Q11, Q11Q12, Q12Q12 real (kind=dbl_kind), parameter :: & @@ -1997,61 +2015,63 @@ subroutine calc_ffrac (stressp, stressm, & character(len=*), parameter :: subname = '(calc_ffrac)' - sigma11 = p5*(stressp+stressm) - sigma12 = stress12 - sigma22 = p5*(stressp-stressm) + call icepack_query_parameters(pih_out=pih) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) -! if ((sigma11-sigma22) == c0) then sigma11-sigma22 == 0 => stressn ==0 - if (stressm == c0) then + sigma11 = p5*(stressp+stressm) + sigma12 = stress12 + sigma22 = p5*(stressp-stressm) + + if ((sigma11-sigma22) == c0) then gamma = p5*(pih) - else + else gamma = p5*atan2((c2*sigma12),(sigma11-sigma22)) - endif + endif - ! rotate tensor to get into sigma principal axis +! rotate tensor to get into sigma principal axis - Q11 = cos(gamma) - Q12 = sin(gamma) + Q11 = cos(gamma) + Q12 = sin(gamma) - Q11Q11 = Q11*Q11 - Q11Q12 = Q11*Q12 - Q12Q12 = Q12*Q12 + Q11Q11 = Q11*Q11 + Q11Q12 = Q11*Q12 + Q12Q12 = Q12*Q12 - sigma_1 = Q11Q11*sigma11 + c2*Q11Q12*sigma12 & - + Q12Q12*sigma22 ! S(1,1) - sigma_2 = Q12Q12*sigma11 - c2*Q11Q12*sigma12 & - + Q11Q11*sigma22 ! S(2,2) + sigma_1 = Q11Q11*sigma11 + c2*Q11Q12*sigma12 & + + Q12Q12*sigma22 ! S(1,1) + sigma_2 = Q12Q12*sigma11 - c2*Q11Q12*sigma12 & + + Q11Q11*sigma22 ! S(2,2) - ! Pure divergence - if ((sigma_1 >= c0).and.(sigma_2 >= c0)) then - mresult1 = c0 - mresult2 = c0 +! Pure divergence + if ((sigma_1 >= c0).and.(sigma_2 >= c0)) then + mresult = c0 - ! Unconfined compression: cracking of blocks not along the axial splitting direction - ! which leads to the loss of their shape, so we again model it through diffusion - elseif ((sigma_1 >= c0).and.(sigma_2 < c0)) then - mresult1 = kfrac * (a1x - Q12Q12) - mresult2 = kfrac * (a2x + Q11Q12) +! Unconfined compression: cracking of blocks not along the axial splitting direction +! which leads to the loss of their shape, so we again model it through diffusion + elseif ((sigma_1 >= c0).and.(sigma_2 < c0)) then + if (blockno == 1) mresult = kfrac * (a1x - Q12Q12) + if (blockno == 2) mresult = kfrac * (a1x + Q11Q12) - ! Shear faulting - elseif (sigma_2 == c0) then - mresult1 = c0 - mresult2 = c0 - elseif ((sigma_1 <= c0).and.(sigma_1/sigma_2 <= threshold)) then - mresult1 = kfrac * (a1x - Q12Q12) - mresult2 = kfrac * (a2x + Q11Q12) +! Shear faulting + elseif (sigma_2 == c0) then + mresult = c0 + elseif ((sigma_1 <= c0).and.(sigma_1/sigma_2 <= threshold)) then + if (blockno == 1) mresult = kfrac * (a1x - Q12Q12) + if (blockno == 2) mresult = kfrac * (a1x + Q11Q12) - ! Horizontal spalling - else - mresult1 = c0 - mresult2 = c0 - endif +! Horizontal spalling + else + mresult = c0 + endif end subroutine calc_ffrac !======================================================================= !---! these subroutines write/read Fortran unformatted data files .. !======================================================================= + ! Dumps all values needed for a restart subroutine write_restart_eap () @@ -2067,7 +2087,7 @@ subroutine write_restart_eap () diag = .true. !----------------------------------------------------------------- - ! structure tensor + ! structure tensor !----------------------------------------------------------------- call write_restart_field(nu_dump_eap,0,a11_1,'ruf8','a11_1',1,diag) @@ -2083,6 +2103,7 @@ subroutine write_restart_eap () end subroutine write_restart_eap !======================================================================= + ! Reads all values needed for elastic anisotropic plastic dynamics restart subroutine read_restart_eap() @@ -2111,9 +2132,9 @@ subroutine read_restart_eap() ! Structure tensor must be read and scattered in pairs in order ! to properly match corner values across a tripole grid cut. !----------------------------------------------------------------- - if (my_task == master_task) write(nu_diag,*) & - 'structure tensor restart data' - + if (my_task == master_task) write(nu_diag,*) & + 'structure tensor restart data' + call read_restart_field(nu_restart_eap,0,a11_1,'ruf8', & 'a11_1',1,diag,field_loc_center,field_type_scalar) ! a11_1 call read_restart_field(nu_restart_eap,0,a11_3,'ruf8', & @@ -2134,22 +2155,22 @@ subroutine read_restart_eap() if (trim(grid_type) == 'tripole') then - call ice_HaloUpdate_stress(a11_1, a11_3, halo_info, & - field_loc_center, field_type_scalar) - call ice_HaloUpdate_stress(a11_3, a11_1, halo_info, & - field_loc_center, field_type_scalar) - call ice_HaloUpdate_stress(a11_2, a11_4, halo_info, & - field_loc_center, field_type_scalar) - call ice_HaloUpdate_stress(a11_4, a11_2, halo_info, & - field_loc_center, field_type_scalar) - call ice_HaloUpdate_stress(a12_1, a12_3, halo_info, & - field_loc_center, field_type_scalar) - call ice_HaloUpdate_stress(a12_3, a12_1, halo_info, & - field_loc_center, field_type_scalar) - call ice_HaloUpdate_stress(a12_2, a12_4, halo_info, & - field_loc_center, field_type_scalar) - call ice_HaloUpdate_stress(a12_4, a12_2, halo_info, & - field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(a11_1, a11_3, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(a11_3, a11_1, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(a11_2, a11_4, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(a11_4, a11_2, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(a12_1, a12_3, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(a12_3, a12_1, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(a12_2, a12_4, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(a12_4, a12_2, halo_info, & + field_loc_center, field_type_scalar) endif @@ -2157,34 +2178,34 @@ subroutine read_restart_eap() ! Ensure unused values in west and south ghost cells are 0 !----------------------------------------------------------------- - !$OMP PARALLEL DO PRIVATE(iblk,i,j) SCHEDULE(runtime) - do iblk = 1, nblocks - do j = 1, nghost - do i = 1, nx_block - a11_1 (i,j,iblk) = c0 - a11_2 (i,j,iblk) = c0 - a11_3 (i,j,iblk) = c0 - a11_4 (i,j,iblk) = c0 - a12_1 (i,j,iblk) = c0 - a12_2 (i,j,iblk) = c0 - a12_3 (i,j,iblk) = c0 - a12_4 (i,j,iblk) = c0 - enddo - enddo - do j = 1, ny_block - do i = 1, nghost - a11_1 (i,j,iblk) = c0 - a11_2 (i,j,iblk) = c0 - a11_3 (i,j,iblk) = c0 - a11_4 (i,j,iblk) = c0 - a12_1 (i,j,iblk) = c0 - a12_2 (i,j,iblk) = c0 - a12_3 (i,j,iblk) = c0 - a12_4 (i,j,iblk) = c0 - enddo + !$OMP PARALLEL DO PRIVATE(iblk,i,j) + do iblk = 1, nblocks + do j = 1, nghost + do i = 1, nx_block + a11_1 (i,j,iblk) = c0 + a11_2 (i,j,iblk) = c0 + a11_3 (i,j,iblk) = c0 + a11_4 (i,j,iblk) = c0 + a12_1 (i,j,iblk) = c0 + a12_2 (i,j,iblk) = c0 + a12_3 (i,j,iblk) = c0 + a12_4 (i,j,iblk) = c0 + enddo + enddo + do j = 1, ny_block + do i = 1, nghost + a11_1 (i,j,iblk) = c0 + a11_2 (i,j,iblk) = c0 + a11_3 (i,j,iblk) = c0 + a11_4 (i,j,iblk) = c0 + a12_1 (i,j,iblk) = c0 + a12_2 (i,j,iblk) = c0 + a12_3 (i,j,iblk) = c0 + a12_4 (i,j,iblk) = c0 + enddo + enddo enddo - enddo - !$OMP END PARALLEL DO + !$OMP END PARALLEL DO end subroutine read_restart_eap diff --git a/cicecore/cicedyn/general/ice_forcing.F90 b/cicecore/cicedyn/general/ice_forcing.F90 index 4c88037ed..43cf92a48 100755 --- a/cicecore/cicedyn/general/ice_forcing.F90 +++ b/cicecore/cicedyn/general/ice_forcing.F90 @@ -5059,23 +5059,31 @@ end subroutine ocn_data_ispol_init subroutine box2001_data ! wind and current fields as in Hunke, JCP 2001 +! these are defined at the u point ! authors: Elizabeth Hunke, LANL use ice_domain, only: nblocks + use ice_domain_size, only: max_blocks use ice_blocks, only: nx_block, ny_block, nghost use ice_flux, only: uocn, vocn, uatm, vatm, wind, rhoa, strax, stray - use ice_grid, only: uvm + use ice_grid, only: uvm, to_ugrid + use ice_state, only: aice ! local parameters integer (kind=int_kind) :: & iblk, i,j ! loop indices + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & + aiu ! ice fraction on u-grid + real (kind=dbl_kind) :: & secday, pi , puny, period, pi2, tau call icepack_query_parameters(pi_out=pi, pi2_out=pi2, puny_out=puny) call icepack_query_parameters(secday_out=secday) + call to_ugrid(aice, aiu) + period = c4*secday do iblk = 1, nblocks @@ -5106,8 +5114,8 @@ subroutine box2001_data ! wind stress wind(i,j,iblk) = sqrt(uatm(i,j,iblk)**2 + vatm(i,j,iblk)**2) tau = rhoa(i,j,iblk) * 0.0012_dbl_kind * wind(i,j,iblk) - strax(i,j,iblk) = tau * uatm(i,j,iblk) - stray(i,j,iblk) = tau * vatm(i,j,iblk) + strax(i,j,iblk) = aiu(i,j,iblk) * tau * uatm(i,j,iblk) + stray(i,j,iblk) = aiu(i,j,iblk) * tau * vatm(i,j,iblk) ! initialization test ! Diagonal wind vectors 1 diff --git a/cicecore/cicedyn/general/ice_step_mod.F90 b/cicecore/cicedyn/general/ice_step_mod.F90 index fde7a16cf..fafe38a29 100644 --- a/cicecore/cicedyn/general/ice_step_mod.F90 +++ b/cicecore/cicedyn/general/ice_step_mod.F90 @@ -848,6 +848,7 @@ subroutine step_dyn_horiz (dt) use ice_dyn_evp, only: evp use ice_dyn_eap, only: eap + use ice_dyn_vp, only: implicit_solver use ice_dyn_shared, only: kdyn, ktransport use ice_flux, only: init_history_dyn !deprecate upwind use ice_transport_driver, only: advection, transport_upwind, transport_remap @@ -861,11 +862,12 @@ subroutine step_dyn_horiz (dt) call init_history_dyn ! initialize dynamic history variables !----------------------------------------------------------------- - ! Elastic-viscous-plastic ice dynamics + ! Ice dynamics (momentum equation) !----------------------------------------------------------------- if (kdyn == 1) call evp (dt) if (kdyn == 2) call eap (dt) + if (kdyn == 3) call implicit_solver (dt) !----------------------------------------------------------------- ! Horizontal ice transport diff --git a/cicecore/cicedyn/infrastructure/comm/mpi/ice_global_reductions.F90 b/cicecore/cicedyn/infrastructure/comm/mpi/ice_global_reductions.F90 index 1f7592749..82de98a5f 100644 --- a/cicecore/cicedyn/infrastructure/comm/mpi/ice_global_reductions.F90 +++ b/cicecore/cicedyn/infrastructure/comm/mpi/ice_global_reductions.F90 @@ -36,6 +36,7 @@ module ice_global_reductions private public :: global_sum, & + global_allreduce_sum, & global_sum_prod, & global_maxval, & global_minval @@ -64,6 +65,12 @@ module ice_global_reductions global_sum_scalar_int end interface + interface global_allreduce_sum + module procedure global_allreduce_sum_vector_dbl!, & + ! module procedure global_allreduce_sum_vector_real, & ! not yet implemented + ! module procedure global_allreduce_sum_vector_int ! not yet implemented + end interface + interface global_sum_prod module procedure global_sum_prod_dbl, & global_sum_prod_real, & @@ -749,6 +756,69 @@ function global_sum_scalar_int(scalar, dist) & end function global_sum_scalar_int +!*********************************************************************** + + function global_allreduce_sum_vector_dbl(vector, dist) & + result(globalSums) + +! Computes the global sums of sets of scalars (elements of 'vector') +! distributed across a parallel machine. +! +! This is actually the specific interface for the generic global_allreduce_sum +! function corresponding to double precision vectors. The generic +! interface is identical but will handle real and integer vectors. + + real (dbl_kind), dimension(:), intent(in) :: & + vector ! vector whose components are to be summed + + type (distrb), intent(in) :: & + dist ! block distribution + + real (dbl_kind), dimension(size(vector)) :: & + globalSums ! resulting array of global sums + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + ierr, &! mpi error flag + numProcs, &! number of processor participating + numBlocks, &! number of local blocks + communicator, &! communicator for this distribution + numElem ! number of elements in vector + + real (dbl_kind), dimension(:,:), allocatable :: & + work ! temporary local array + + character(len=*), parameter :: subname = '(global_allreduce_sum_vector_dbl)' + +!----------------------------------------------------------------------- +! +! get communicator for MPI calls +! +!----------------------------------------------------------------------- + + call ice_distributionGet(dist, & + numLocalBlocks = numBlocks, & + nprocs = numProcs, & + communicator = communicator) + + numElem = size(vector) + allocate(work(1,numElem)) + work(1,:) = vector + globalSums = c0 + + call compute_sums_dbl(work,globalSums,communicator,numProcs) + + deallocate(work) + +!----------------------------------------------------------------------- + + end function global_allreduce_sum_vector_dbl + !*********************************************************************** function global_sum_prod_dbl (array1, array2, dist, field_loc, & diff --git a/cicecore/cicedyn/infrastructure/comm/serial/ice_global_reductions.F90 b/cicecore/cicedyn/infrastructure/comm/serial/ice_global_reductions.F90 index e4eb95b56..5e356b07b 100644 --- a/cicecore/cicedyn/infrastructure/comm/serial/ice_global_reductions.F90 +++ b/cicecore/cicedyn/infrastructure/comm/serial/ice_global_reductions.F90 @@ -37,6 +37,7 @@ module ice_global_reductions private public :: global_sum, & + global_allreduce_sum, & global_sum_prod, & global_maxval, & global_minval @@ -65,6 +66,12 @@ module ice_global_reductions global_sum_scalar_int end interface + interface global_allreduce_sum + module procedure global_allreduce_sum_vector_dbl!, & + ! module procedure global_allreduce_sum_vector_real, & ! not yet implemented + ! module procedure global_allreduce_sum_vector_int ! not yet implemented + end interface + interface global_sum_prod module procedure global_sum_prod_dbl, & global_sum_prod_real, & @@ -750,6 +757,69 @@ function global_sum_scalar_int(scalar, dist) & end function global_sum_scalar_int +!*********************************************************************** + + function global_allreduce_sum_vector_dbl(vector, dist) & + result(globalSums) + +! Computes the global sums of sets of scalars (elements of 'vector') +! distributed across a parallel machine. +! +! This is actually the specific interface for the generic global_allreduce_sum +! function corresponding to double precision vectors. The generic +! interface is identical but will handle real and integer vectors. + + real (dbl_kind), dimension(:), intent(in) :: & + vector ! vector whose components are to be summed + + type (distrb), intent(in) :: & + dist ! block distribution + + real (dbl_kind), dimension(size(vector)) :: & + globalSums ! resulting array of global sums + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + ierr, &! mpi error flag + numProcs, &! number of processor participating + numBlocks, &! number of local blocks + communicator, &! communicator for this distribution + numElem ! number of elements in vector + + real (dbl_kind), dimension(:,:), allocatable :: & + work ! temporary local array + + character(len=*), parameter :: subname = '(global_allreduce_sum_vector_dbl)' + +!----------------------------------------------------------------------- +! +! get communicator for MPI calls +! +!----------------------------------------------------------------------- + + call ice_distributionGet(dist, & + numLocalBlocks = numBlocks, & + nprocs = numProcs, & + communicator = communicator) + + numElem = size(vector) + allocate(work(1,numElem)) + work(1,:) = vector + globalSums = c0 + + call compute_sums_dbl(work,globalSums,communicator,numProcs) + + deallocate(work) + +!----------------------------------------------------------------------- + + end function global_allreduce_sum_vector_dbl + !*********************************************************************** function global_sum_prod_dbl (array1, array2, dist, field_loc, & diff --git a/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 b/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 new file mode 100644 index 000000000..5846cf143 --- /dev/null +++ b/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 @@ -0,0 +1,872 @@ +!======================================================================= +! +! Elastic-viscous-plastic sea ice dynamics model +! Computes ice velocity and deformation +! +! See: +! +! Hunke, E. C., and J. K. Dukowicz (1997). An elastic-viscous-plastic model +! for sea ice dynamics. {\em J. Phys. Oceanogr.}, {\bf 27}, 1849--1867. +! +! Hunke, E. C. (2001). Viscous-Plastic Sea Ice Dynamics with the EVP Model: +! Linearization Issues. {\em Journal of Computational Physics}, {\bf 170}, +! 18--38. +! +! Hunke, E. C., and J. K. Dukowicz (2002). The Elastic-Viscous-Plastic +! Sea Ice Dynamics Model in General Orthogonal Curvilinear Coordinates +! on a Sphere---Incorporation of Metric Terms. {\em Monthly Weather Review}, +! {\bf 130}, 1848--1865. +! +! Hunke, E. C., and J. K. Dukowicz (2003). The sea ice momentum +! equation in the free drift regime. Los Alamos Tech. Rep. LA-UR-03-2219. +! +! Bouillon, S., T. Fichefet, V. Legat and G. Madec (submitted 2013). The +! revised elastic-viscous-plastic method. Ocean Modelling. +! +! author: Elizabeth C. Hunke, LANL +! +! 2003: Vectorized by Clifford Chen (Fujitsu) and William Lipscomb (LANL) +! 2004: Block structure added by William Lipscomb +! 2005: Removed boundary calls for stress arrays (WHL) +! 2006: Streamlined for efficiency by Elizabeth Hunke +! Converted to free source form (F90) + + module ice_dyn_evp + + use ice_kinds_mod + use ice_communicate, only: my_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, & + p222, p25, p333, p5, c1 + use ice_dyn_shared, only: stepu, dyn_prep1, dyn_prep2, dyn_finish, & + ndte, yield_curve, ecci, denom1, arlx1i, fcor_blk, uvel_init, & + vvel_init, basal_stress_coeff, basalstress, Ktens, revp + use ice_fileunits, only: nu_diag + use ice_exit, only: abort_ice + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + use icepack_intfc, only: icepack_ice_strength, icepack_query_parameters + + implicit none + private + public :: evp + +!======================================================================= + + contains + +!======================================================================= + +! Elastic-viscous-plastic dynamics driver +! +#ifdef CICE_IN_NEMO +! Wind stress is set during this routine from the values supplied +! via NEMO (unless calc_strair is true). These values are supplied +! rotated on u grid and multiplied by aice. strairxT = 0 in this +! case so operations in dyn_prep1 are pointless but carried out to +! minimise code changes. +#endif +! +! author: Elizabeth C. Hunke, LANL + + subroutine evp (dt) + + use ice_arrays_column, only: Cdn_ocn + use ice_boundary, only: ice_halo, ice_HaloMask, ice_HaloUpdate, & + ice_HaloDestroy, ice_HaloUpdate_stress + use ice_blocks, only: block, get_block, nx_block, ny_block, nghost + use ice_domain, only: nblocks, blocks_ice, halo_info, maskhalo_dyn + use ice_domain_size, only: max_blocks, ncat, nx_global, ny_global + use ice_flux, only: rdg_conv, rdg_shear, strairxT, strairyT, & + strairx, strairy, uocn, vocn, ss_tltx, ss_tlty, iceumask, fm, & + strtltx, strtlty, strocnx, strocny, strintx, strinty, taubx, tauby, & + strocnxT, strocnyT, strax, stray, & + Tbu, hwater, & + stressp_1, stressp_2, stressp_3, stressp_4, & + stressm_1, stressm_2, stressm_3, stressm_4, & + stress12_1, stress12_2, stress12_3, stress12_4 + use ice_grid, only: tmask, umask, dxt, dyt, dxhy, dyhx, cxp, cyp, cxm, cym, & + tarear, uarear, tinyarea, to_ugrid, t2ugrid_vector, u2tgrid_vector, & + grid_type, HTE, HTN + use ice_state, only: aice, vice, vsno, uvel, vvel, divu, shear, & + aice_init, aice0, aicen, vicen, strength + use ice_timers, only: timer_dynamics, timer_bound, & + ice_timer_start, ice_timer_stop, timer_evp_1d, timer_evp_2d + use ice_dyn_evp_1d, only: ice_dyn_evp_1d_copyin, ice_dyn_evp_1d_kernel, & + ice_dyn_evp_1d_copyout + use ice_dyn_shared, only: kevp_kernel, stack_velocity_field, unstack_velocity_field + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + ! local variables + + integer (kind=int_kind) :: & + ksub , & ! subcycle step + iblk , & ! block index + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + i, j, ij + + integer (kind=int_kind), dimension(max_blocks) :: & + icellt , & ! no. of cells where icetmask = 1 + icellu ! no. of cells where iceumask = 1 + + integer (kind=int_kind), dimension (nx_block*ny_block, max_blocks) :: & + indxti , & ! compressed index in i-direction + indxtj , & ! compressed index in j-direction + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & + tmass , & ! total mass of ice and snow (kg/m^2) + waterx , & ! for ocean stress calculation, x (m/s) + watery , & ! for ocean stress calculation, y (m/s) + forcex , & ! work array: combined atm stress and ocn tilt, x + forcey , & ! work array: combined atm stress and ocn tilt, y + aiu , & ! ice fraction on u-grid + umass , & ! total mass of ice and snow (u grid) + umassdti ! mass of U-cell/dte (kg/m^2 s) + + real (kind=dbl_kind), allocatable :: fld2(:,:,:,:) + + real (kind=dbl_kind), dimension(nx_block,ny_block,8):: & + strtmp ! stress combinations for momentum equation + + logical (kind=log_kind) :: calc_strair + + integer (kind=int_kind), dimension (nx_block,ny_block,max_blocks) :: & + icetmask, & ! ice extent mask (T-cell) + halomask ! generic halo mask + + type (ice_halo) :: & + halo_info_mask ! ghost cell update info for masked halo + + type (block) :: & + this_block ! block information for current block + + logical (kind=log_kind), save :: first_time = .true. + + character(len=*), parameter :: subname = '(evp)' + + call ice_timer_start(timer_dynamics) ! dynamics + + !----------------------------------------------------------------- + ! Initialize + !----------------------------------------------------------------- + + allocate(fld2(nx_block,ny_block,2,max_blocks)) + + ! This call is needed only if dt changes during runtime. +! call set_evp_parameters (dt) + + !----------------------------------------------------------------- + ! boundary updates + ! commented out because the ghost cells are freshly + ! updated after cleanup_itd + !----------------------------------------------------------------- + +! call ice_timer_start(timer_bound) +! call ice_HaloUpdate (aice, halo_info, & +! field_loc_center, field_type_scalar) +! call ice_HaloUpdate (vice, halo_info, & +! field_loc_center, field_type_scalar) +! call ice_HaloUpdate (vsno, halo_info, & +! field_loc_center, field_type_scalar) +! call ice_timer_stop(timer_bound) + + !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) + do iblk = 1, nblocks + + do j = 1, ny_block + do i = 1, nx_block + rdg_conv (i,j,iblk) = c0 + rdg_shear(i,j,iblk) = c0 + divu (i,j,iblk) = c0 + shear(i,j,iblk) = c0 + enddo + enddo + + !----------------------------------------------------------------- + ! preparation for dynamics + !----------------------------------------------------------------- + + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + call dyn_prep1 (nx_block, ny_block, & + ilo, ihi, jlo, jhi, & + aice (:,:,iblk), vice (:,:,iblk), & + vsno (:,:,iblk), tmask (:,:,iblk), & + strairxT(:,:,iblk), strairyT(:,:,iblk), & + strairx (:,:,iblk), strairy (:,:,iblk), & + tmass (:,:,iblk), icetmask(:,:,iblk)) + + enddo ! iblk + !$OMP END PARALLEL DO + + call ice_timer_start(timer_bound) + call ice_HaloUpdate (icetmask, halo_info, & + field_loc_center, field_type_scalar) + call ice_timer_stop(timer_bound) + + !----------------------------------------------------------------- + ! convert fields from T to U grid + !----------------------------------------------------------------- + + call to_ugrid(tmass,umass) + call to_ugrid(aice_init, aiu) + + !---------------------------------------------------------------- + ! Set wind stress to values supplied via NEMO or other forcing + ! This wind stress is rotated on u grid and multiplied by aice + !---------------------------------------------------------------- + call icepack_query_parameters(calc_strair_out=calc_strair) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + if (.not. calc_strair) then + strairx(:,:,:) = strax(:,:,:) + strairy(:,:,:) = stray(:,:,:) + else + call t2ugrid_vector(strairx) + call t2ugrid_vector(strairy) + endif + +! tcraig, tcx, threading here leads to some non-reproducbile results and failures in icepack_ice_strength +! need to do more debugging + !$TCXOMP PARALLEL DO PRIVATE(iblk,ilo,ihi,jlo,jhi,this_block) + do iblk = 1, nblocks + + !----------------------------------------------------------------- + ! more preparation for dynamics + !----------------------------------------------------------------- + + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + call dyn_prep2 (nx_block, ny_block, & + ilo, ihi, jlo, jhi, & + icellt(iblk), icellu(iblk), & + indxti (:,iblk), indxtj (:,iblk), & + indxui (:,iblk), indxuj (:,iblk), & + aiu (:,:,iblk), umass (:,:,iblk), & + umassdti (:,:,iblk), fcor_blk (:,:,iblk), & + umask (:,:,iblk), & + uocn (:,:,iblk), vocn (:,:,iblk), & + strairx (:,:,iblk), strairy (:,:,iblk), & + ss_tltx (:,:,iblk), ss_tlty (:,:,iblk), & + icetmask (:,:,iblk), iceumask (:,:,iblk), & + fm (:,:,iblk), dt, & + strtltx (:,:,iblk), strtlty (:,:,iblk), & + strocnx (:,:,iblk), strocny (:,:,iblk), & + strintx (:,:,iblk), strinty (:,:,iblk), & + taubx (:,:,iblk), tauby (:,:,iblk), & + waterx (:,:,iblk), watery (:,:,iblk), & + forcex (:,:,iblk), forcey (:,:,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), & + uvel_init (:,:,iblk), vvel_init (:,:,iblk), & + uvel (:,:,iblk), vvel (:,:,iblk), & + Tbu (:,:,iblk)) + + !----------------------------------------------------------------- + ! ice strength + !----------------------------------------------------------------- + + strength(:,:,iblk) = c0 ! initialize + do ij = 1, icellt(iblk) + i = indxti(ij, iblk) + j = indxtj(ij, iblk) + call icepack_ice_strength(ncat = ncat, & + aice = aice (i,j, iblk), & + vice = vice (i,j, iblk), & + aice0 = aice0 (i,j, iblk), & + aicen = aicen (i,j,:,iblk), & + vicen = vicen (i,j,:,iblk), & + strength = strength(i,j, iblk) ) + enddo ! ij + + enddo ! iblk + !$TCXOMP END PARALLEL DO + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call ice_timer_start(timer_bound) + call ice_HaloUpdate (strength, halo_info, & + field_loc_center, field_type_scalar) + ! velocities may have changed in dyn_prep2 + call stack_velocity_field(uvel, vvel, fld2) + call ice_HaloUpdate (fld2, halo_info, & + field_loc_NEcorner, field_type_vector) + call unstack_velocity_field(fld2, uvel, vvel) + call ice_timer_stop(timer_bound) + + if (maskhalo_dyn) then + call ice_timer_start(timer_bound) + halomask = 0 + where (iceumask) halomask = 1 + call ice_HaloUpdate (halomask, halo_info, & + field_loc_center, field_type_scalar) + call ice_timer_stop(timer_bound) + call ice_HaloMask(halo_info_mask, halo_info, halomask) + endif + + !----------------------------------------------------------------- + ! basal stress coefficients (landfast ice) + !----------------------------------------------------------------- + + if (basalstress) then + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call basal_stress_coeff (nx_block, ny_block, & + icellu (iblk), & + indxui(:,iblk), indxuj(:,iblk), & + vice(:,:,iblk), aice(:,:,iblk), & + hwater(:,:,iblk), Tbu(:,:,iblk)) + enddo + !$OMP END PARALLEL DO + endif + call ice_timer_start(timer_evp_2d) + if (kevp_kernel > 0) then + if (first_time .and. my_task == 0) then + write(nu_diag,'(2a,i6)') subname,' Entering kevp_kernel version ',kevp_kernel + first_time = .false. + endif + if (trim(grid_type) == 'tripole') then + call abort_ice(trim(subname)//' & + & Kernel not tested on tripole grid. Set kevp_kernel=0') + endif + call ice_dyn_evp_1d_copyin( & + nx_block,ny_block,nblocks,nx_global+2*nghost,ny_global+2*nghost, & + HTE,HTN, & +!v1 dxhy,dyhx,cyp,cxp,cym,cxm,tinyarea, & +!v1 waterx,watery, & + 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 ) + if (kevp_kernel == 2) then + call ice_timer_start(timer_evp_1d) + call ice_dyn_evp_1d_kernel() + call ice_timer_stop(timer_evp_1d) +!v1 else if (kevp_kernel == 1) then +!v1 call evp_kernel_v1() + else + if (my_task == 0) write(nu_diag,*) subname,' ERROR: kevp_kernel = ',kevp_kernel + call abort_ice(subname//' kevp_kernel not supported.') + endif + 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 ! kevp_kernel == 0 (Standard CICE) + + 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 + endif ! kevp_kernel + call ice_timer_stop(timer_evp_2d) + + deallocate(fld2) + if (maskhalo_dyn) call ice_HaloDestroy(halo_info_mask) + + ! Force symmetry across the tripole seam + if (trim(grid_type) == 'tripole') then + if (maskhalo_dyn) then + !------------------------------------------------------- + ! set halomask to zero because ice_HaloMask always keeps + ! local copies AND tripole zipper communication + !------------------------------------------------------- + halomask = 0 + call ice_HaloMask(halo_info_mask, halo_info, halomask) + + call ice_HaloUpdate_stress(stressp_1, stressp_3, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressp_3, stressp_1, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressp_2, stressp_4, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressp_4, stressp_2, halo_info_mask, & + field_loc_center, field_type_scalar) + + call ice_HaloUpdate_stress(stressm_1, stressm_3, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressm_3, stressm_1, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressm_2, stressm_4, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressm_4, stressm_2, halo_info_mask, & + field_loc_center, field_type_scalar) + + call ice_HaloUpdate_stress(stress12_1, stress12_3, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stress12_3, stress12_1, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stress12_2, stress12_4, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stress12_4, stress12_2, halo_info_mask, & + field_loc_center, field_type_scalar) + + call ice_HaloDestroy(halo_info_mask) + else + call ice_HaloUpdate_stress(stressp_1, stressp_3, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressp_3, stressp_1, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressp_2, stressp_4, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressp_4, stressp_2, halo_info, & + field_loc_center, field_type_scalar) + + call ice_HaloUpdate_stress(stressm_1, stressm_3, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressm_3, stressm_1, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressm_2, stressm_4, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressm_4, stressm_2, halo_info, & + field_loc_center, field_type_scalar) + + call ice_HaloUpdate_stress(stress12_1, stress12_3, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stress12_3, stress12_1, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stress12_2, stress12_4, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stress12_4, stress12_2, halo_info, & + field_loc_center, field_type_scalar) + endif ! maskhalo + endif ! tripole + + !----------------------------------------------------------------- + ! ice-ocean stress + !----------------------------------------------------------------- + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + + call dyn_finish & + (nx_block, ny_block, & + icellu (iblk), Cdn_ocn (:,:,iblk), & + indxui (:,iblk), indxuj (:,iblk), & + uvel (:,:,iblk), vvel (:,:,iblk), & + uocn (:,:,iblk), vocn (:,:,iblk), & + aiu (:,:,iblk), fm (:,:,iblk), & + strintx (:,:,iblk), strinty (:,:,iblk), & + strairx (:,:,iblk), strairy (:,:,iblk), & + strocnx (:,:,iblk), strocny (:,:,iblk), & + strocnxT(:,:,iblk), strocnyT(:,:,iblk)) + + enddo + !$OMP END PARALLEL DO + + call u2tgrid_vector(strocnxT) ! shift + call u2tgrid_vector(strocnyT) + + call ice_timer_stop(timer_dynamics) ! dynamics + + end subroutine evp + +!======================================================================= + +! Computes the rates of strain and internal stress components for +! each of the four corners on each T-grid cell. +! Computes stress terms for the momentum equation +! +! author: Elizabeth C. Hunke, LANL + + subroutine stress (nx_block, ny_block, & + ksub, icellt, & + indxti, indxtj, & + uvel, vvel, & + dxt, dyt, & + dxhy, dyhx, & + cxp, cyp, & + cxm, cym, & + tarear, tinyarea, & + strength, & + stressp_1, stressp_2, & + stressp_3, stressp_4, & + stressm_1, stressm_2, & + stressm_3, stressm_4, & + stress12_1, stress12_2, & + stress12_3, stress12_4, & + shear, divu, & + rdg_conv, rdg_shear, & + str ) + + use ice_dyn_shared, only: strain_rates, deformations + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + ksub , & ! subcycling step + icellt ! no. of cells where icetmask = 1 + + integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & + indxti , & ! compressed index in i-direction + indxtj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + strength , & ! ice strength (N/m) + uvel , & ! x-component of velocity (m/s) + vvel , & ! y-component of velocity (m/s) + dxt , & ! width of T-cell through the middle (m) + dyt , & ! height of T-cell through the middle (m) + dxhy , & ! 0.5*(HTE - HTE) + dyhx , & ! 0.5*(HTN - HTN) + cyp , & ! 1.5*HTE - 0.5*HTE + cxp , & ! 1.5*HTN - 0.5*HTN + cym , & ! 0.5*HTE - 1.5*HTE + cxm , & ! 0.5*HTN - 1.5*HTN + tarear , & ! 1/tarea + tinyarea ! puny*tarea + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & + stressp_1, stressp_2, stressp_3, stressp_4 , & ! sigma11+sigma22 + stressm_1, stressm_2, stressm_3, stressm_4 , & ! sigma11-sigma22 + stress12_1,stress12_2,stress12_3,stress12_4 ! sigma12 + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & + shear , & ! strain rate II component (1/s) + divu , & ! strain rate I component, velocity divergence (1/s) + rdg_conv , & ! convergence term for ridging (1/s) + rdg_shear ! shear term for ridging (1/s) + + real (kind=dbl_kind), dimension(nx_block,ny_block,8), intent(out) :: & + str ! stress combinations + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij + + real (kind=dbl_kind) :: & + divune, divunw, divuse, divusw , & ! divergence + tensionne, tensionnw, tensionse, tensionsw, & ! tension + shearne, shearnw, shearse, shearsw , & ! shearing + Deltane, Deltanw, Deltase, Deltasw , & ! Delt +! puny , & ! puny + c0ne, c0nw, c0se, c0sw , & ! useful combinations + c1ne, c1nw, c1se, c1sw , & + ssigpn, ssigps, ssigpe, ssigpw , & + ssigmn, ssigms, ssigme, ssigmw , & + ssig12n, ssig12s, ssig12e, ssig12w , & + ssigp1, ssigp2, ssigm1, ssigm2, ssig121, ssig122, & + csigpne, csigpnw, csigpse, csigpsw , & + csigmne, csigmnw, csigmse, csigmsw , & + csig12ne, csig12nw, csig12se, csig12sw , & + str12ew, str12we, str12ns, str12sn , & + strp_tmp, strm_tmp, tmp + + character(len=*), parameter :: subname = '(stress)' + + !----------------------------------------------------------------- + ! Initialize + !----------------------------------------------------------------- + + str(:,:,:) = c0 + + do ij = 1, icellt + i = indxti(ij) + j = indxtj(ij) + + !----------------------------------------------------------------- + ! strain rates + ! NOTE these are actually strain rates * area (m^2/s) + !----------------------------------------------------------------- + call strain_rates (nx_block, ny_block, & + i, j, & + uvel, vvel, & + dxt, dyt, & + cxp, cyp, & + cxm, cym, & + divune, divunw, & + divuse, divusw, & + tensionne, tensionnw, & + tensionse, tensionsw, & + shearne, shearnw, & + shearse, shearsw, & + Deltane, Deltanw, & + Deltase, Deltasw ) + + !----------------------------------------------------------------- + ! strength/Delta ! kg/s + !----------------------------------------------------------------- + c0ne = strength(i,j)/max(Deltane,tinyarea(i,j)) + c0nw = strength(i,j)/max(Deltanw,tinyarea(i,j)) + c0sw = strength(i,j)/max(Deltasw,tinyarea(i,j)) + c0se = strength(i,j)/max(Deltase,tinyarea(i,j)) + + c1ne = c0ne*arlx1i + c1nw = c0nw*arlx1i + c1sw = c0sw*arlx1i + c1se = c0se*arlx1i + + c0ne = c1ne*ecci + c0nw = c1nw*ecci + c0sw = c1sw*ecci + c0se = c1se*ecci + + !----------------------------------------------------------------- + ! the stresses ! kg/s^2 + ! (1) northeast, (2) northwest, (3) southwest, (4) southeast + !----------------------------------------------------------------- + + stressp_1(i,j) = (stressp_1(i,j)*(c1-arlx1i*revp) + c1ne*(divune*(c1+Ktens) - Deltane*(c1-Ktens))) & + * denom1 + stressp_2(i,j) = (stressp_2(i,j)*(c1-arlx1i*revp) + c1nw*(divunw*(c1+Ktens) - Deltanw*(c1-Ktens))) & + * denom1 + stressp_3(i,j) = (stressp_3(i,j)*(c1-arlx1i*revp) + c1sw*(divusw*(c1+Ktens) - Deltasw*(c1-Ktens))) & + * denom1 + stressp_4(i,j) = (stressp_4(i,j)*(c1-arlx1i*revp) + c1se*(divuse*(c1+Ktens) - Deltase*(c1-Ktens))) & + * denom1 + + stressm_1(i,j) = (stressm_1(i,j)*(c1-arlx1i*revp) + c0ne*tensionne*(c1+Ktens)) * denom1 + stressm_2(i,j) = (stressm_2(i,j)*(c1-arlx1i*revp) + c0nw*tensionnw*(c1+Ktens)) * denom1 + stressm_3(i,j) = (stressm_3(i,j)*(c1-arlx1i*revp) + c0sw*tensionsw*(c1+Ktens)) * denom1 + stressm_4(i,j) = (stressm_4(i,j)*(c1-arlx1i*revp) + c0se*tensionse*(c1+Ktens)) * denom1 + + stress12_1(i,j) = (stress12_1(i,j)*(c1-arlx1i*revp) + c0ne*shearne*p5*(c1+Ktens)) * denom1 + stress12_2(i,j) = (stress12_2(i,j)*(c1-arlx1i*revp) + c0nw*shearnw*p5*(c1+Ktens)) * denom1 + stress12_3(i,j) = (stress12_3(i,j)*(c1-arlx1i*revp) + c0sw*shearsw*p5*(c1+Ktens)) * denom1 + stress12_4(i,j) = (stress12_4(i,j)*(c1-arlx1i*revp) + c0se*shearse*p5*(c1+Ktens)) * denom1 + + !----------------------------------------------------------------- + ! Eliminate underflows. + ! The following code is commented out because it is relatively + ! expensive and most compilers include a flag that accomplishes + ! the same thing more efficiently. This code is cheaper than + ! handling underflows if the compiler lacks a flag; uncomment + ! it in that case. The compiler flag is often described with the + ! phrase "flush to zero". + !----------------------------------------------------------------- + +! call icepack_query_parameters(puny_out=puny) +! call icepack_warnings_flush(nu_diag) +! if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & +! file=__FILE__, line=__LINE__) + +! stressp_1(i,j) = sign(max(abs(stressp_1(i,j)),puny),stressp_1(i,j)) +! stressp_2(i,j) = sign(max(abs(stressp_2(i,j)),puny),stressp_2(i,j)) +! stressp_3(i,j) = sign(max(abs(stressp_3(i,j)),puny),stressp_3(i,j)) +! stressp_4(i,j) = sign(max(abs(stressp_4(i,j)),puny),stressp_4(i,j)) + +! stressm_1(i,j) = sign(max(abs(stressm_1(i,j)),puny),stressm_1(i,j)) +! stressm_2(i,j) = sign(max(abs(stressm_2(i,j)),puny),stressm_2(i,j)) +! stressm_3(i,j) = sign(max(abs(stressm_3(i,j)),puny),stressm_3(i,j)) +! stressm_4(i,j) = sign(max(abs(stressm_4(i,j)),puny),stressm_4(i,j)) + +! stress12_1(i,j) = sign(max(abs(stress12_1(i,j)),puny),stress12_1(i,j)) +! stress12_2(i,j) = sign(max(abs(stress12_2(i,j)),puny),stress12_2(i,j)) +! stress12_3(i,j) = sign(max(abs(stress12_3(i,j)),puny),stress12_3(i,j)) +! stress12_4(i,j) = sign(max(abs(stress12_4(i,j)),puny),stress12_4(i,j)) + + !----------------------------------------------------------------- + ! combinations of the stresses for the momentum equation ! kg/s^2 + !----------------------------------------------------------------- + + ssigpn = stressp_1(i,j) + stressp_2(i,j) + ssigps = stressp_3(i,j) + stressp_4(i,j) + ssigpe = stressp_1(i,j) + stressp_4(i,j) + ssigpw = stressp_2(i,j) + stressp_3(i,j) + ssigp1 =(stressp_1(i,j) + stressp_3(i,j))*p055 + ssigp2 =(stressp_2(i,j) + stressp_4(i,j))*p055 + + ssigmn = stressm_1(i,j) + stressm_2(i,j) + ssigms = stressm_3(i,j) + stressm_4(i,j) + ssigme = stressm_1(i,j) + stressm_4(i,j) + ssigmw = stressm_2(i,j) + stressm_3(i,j) + ssigm1 =(stressm_1(i,j) + stressm_3(i,j))*p055 + ssigm2 =(stressm_2(i,j) + stressm_4(i,j))*p055 + + ssig12n = stress12_1(i,j) + stress12_2(i,j) + ssig12s = stress12_3(i,j) + stress12_4(i,j) + ssig12e = stress12_1(i,j) + stress12_4(i,j) + ssig12w = stress12_2(i,j) + stress12_3(i,j) + ssig121 =(stress12_1(i,j) + stress12_3(i,j))*p111 + ssig122 =(stress12_2(i,j) + stress12_4(i,j))*p111 + + csigpne = p111*stressp_1(i,j) + ssigp2 + p027*stressp_3(i,j) + csigpnw = p111*stressp_2(i,j) + ssigp1 + p027*stressp_4(i,j) + csigpsw = p111*stressp_3(i,j) + ssigp2 + p027*stressp_1(i,j) + csigpse = p111*stressp_4(i,j) + ssigp1 + p027*stressp_2(i,j) + + csigmne = p111*stressm_1(i,j) + ssigm2 + p027*stressm_3(i,j) + csigmnw = p111*stressm_2(i,j) + ssigm1 + p027*stressm_4(i,j) + csigmsw = p111*stressm_3(i,j) + ssigm2 + p027*stressm_1(i,j) + csigmse = p111*stressm_4(i,j) + ssigm1 + p027*stressm_2(i,j) + + csig12ne = p222*stress12_1(i,j) + ssig122 & + + p055*stress12_3(i,j) + csig12nw = p222*stress12_2(i,j) + ssig121 & + + p055*stress12_4(i,j) + csig12sw = p222*stress12_3(i,j) + ssig122 & + + p055*stress12_1(i,j) + csig12se = p222*stress12_4(i,j) + ssig121 & + + p055*stress12_2(i,j) + + str12ew = p5*dxt(i,j)*(p333*ssig12e + p166*ssig12w) + str12we = p5*dxt(i,j)*(p333*ssig12w + p166*ssig12e) + str12ns = p5*dyt(i,j)*(p333*ssig12n + p166*ssig12s) + str12sn = p5*dyt(i,j)*(p333*ssig12s + p166*ssig12n) + + !----------------------------------------------------------------- + ! for dF/dx (u momentum) + !----------------------------------------------------------------- + strp_tmp = p25*dyt(i,j)*(p333*ssigpn + p166*ssigps) + strm_tmp = p25*dyt(i,j)*(p333*ssigmn + p166*ssigms) + + ! northeast (i,j) + str(i,j,1) = -strp_tmp - strm_tmp - str12ew & + + dxhy(i,j)*(-csigpne + csigmne) + dyhx(i,j)*csig12ne + + ! northwest (i+1,j) + str(i,j,2) = strp_tmp + strm_tmp - str12we & + + dxhy(i,j)*(-csigpnw + csigmnw) + dyhx(i,j)*csig12nw + + strp_tmp = p25*dyt(i,j)*(p333*ssigps + p166*ssigpn) + strm_tmp = p25*dyt(i,j)*(p333*ssigms + p166*ssigmn) + + ! southeast (i,j+1) + str(i,j,3) = -strp_tmp - strm_tmp + str12ew & + + dxhy(i,j)*(-csigpse + csigmse) + dyhx(i,j)*csig12se + + ! southwest (i+1,j+1) + str(i,j,4) = strp_tmp + strm_tmp + str12we & + + dxhy(i,j)*(-csigpsw + csigmsw) + dyhx(i,j)*csig12sw + + !----------------------------------------------------------------- + ! for dF/dy (v momentum) + !----------------------------------------------------------------- + strp_tmp = p25*dxt(i,j)*(p333*ssigpe + p166*ssigpw) + strm_tmp = p25*dxt(i,j)*(p333*ssigme + p166*ssigmw) + + ! northeast (i,j) + str(i,j,5) = -strp_tmp + strm_tmp - str12ns & + - dyhx(i,j)*(csigpne + csigmne) + dxhy(i,j)*csig12ne + + ! southeast (i,j+1) + str(i,j,6) = strp_tmp - strm_tmp - str12sn & + - dyhx(i,j)*(csigpse + csigmse) + dxhy(i,j)*csig12se + + strp_tmp = p25*dxt(i,j)*(p333*ssigpw + p166*ssigpe) + strm_tmp = p25*dxt(i,j)*(p333*ssigmw + p166*ssigme) + + ! northwest (i+1,j) + str(i,j,7) = -strp_tmp + strm_tmp + str12ns & + - dyhx(i,j)*(csigpnw + csigmnw) + dxhy(i,j)*csig12nw + + ! southwest (i+1,j+1) + str(i,j,8) = strp_tmp - strm_tmp + str12sn & + - dyhx(i,j)*(csigpsw + csigmsw) + dxhy(i,j)*csig12sw + + enddo ! ij + + !----------------------------------------------------------------- + ! on last subcycle, save quantities for mechanical redistribution + !----------------------------------------------------------------- + if (ksub == ndte) then + call deformations (nx_block , ny_block , & + icellt , & + indxti , indxtj , & + uvel , vvel , & + dxt , dyt , & + cxp , cyp , & + cxm , cym , & + tarear , & + shear , divu , & + rdg_conv , rdg_shear ) + + endif + + end subroutine stress + +!======================================================================= + + end module ice_dyn_evp + +!======================================================================= diff --git a/cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90 b/cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90 new file mode 100644 index 000000000..9fac97a89 --- /dev/null +++ b/cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90 @@ -0,0 +1,2135 @@ +! ice_dyn_evp_1d +! +! Contained 3 Fortran modules, +! * dmi_omp +! * bench_v2 +! * ice_dyn_evp_1d +! These were merged into one module, ice_dyn_evp_1d to support some +! coupled build systems. +! +! Modules used for: +! * convert 2D arrays into 1D vectors +! * Do stress/stepu/halo_update interations +! * convert 1D vectors into 2D matrices +! +! Call from ice_dyn_evp.F90: +! call ice_dyn_evp_1d_copyin(...) +! call ice_dyn_evp_1d_kernel() +! call ice_dyn_evp_1d_copyout(...) +! +! * REAL4 internal version: +! mv evp_kernel1d.F90 evp_kernel1d_r8.F90 +! cat evp_kernel1d_r8.F90 | sed s/DBL_KIND/REAL_KIND/g > evp_kernel1d.F90 +! +! * !v1 : a) "dxhy,dyhx,cyp,cxp,cym,cxm,tinyarea" input variables is replaced by +! "HTE,HTN"->"HTE,HTN,HTEm1,HTNm1" and variables are calculated in-line +! b) "waterx,watery" is calculated using existing input "uocn,vocn" +! +! Jacob Weismann Poulsen (JWP), Mads Hvid Ribergaard (MHRI), DMI +!=============================================================================== + +!=============================================================================== + +!-- One dimension representation of EVP 2D arrays used for EVP kernels +module ice_dyn_evp_1d + + use ice_kinds_mod + use ice_fileunits, only: nu_diag + use ice_exit, only: abort_ice + use icepack_intfc, only: icepack_query_parameters + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + + implicit none + private + public :: ice_dyn_evp_1d_copyin, ice_dyn_evp_1d_copyout, ice_dyn_evp_1d_kernel + + interface ice_dyn_evp_1d_copyin +! module procedure evp_copyin_v1 + module procedure evp_copyin_v2 + end interface + + interface ice_dyn_evp_1d_kernel +! module procedure evp_kernel_v1 + module procedure evp_kernel_v2 + end interface + + interface ice_dyn_evp_1d_copyout + module procedure evp_copyout + end interface + + interface convert_2d_1d +! module procedure convert_2d_1d_v1 + module procedure convert_2d_1d_v2 + end interface + + integer(kind=int_kind) :: & + NA_len, NAVEL_len + logical(kind=log_kind), dimension(:), allocatable :: & + skipucell + integer(kind=int_kind), dimension(:), allocatable :: & + ee,ne,se,nw,sw,sse,indi,indj,indij , halo_parent + real (kind=dbl_kind), dimension(:), allocatable :: & + cdn_ocn,aiu,uocn,vocn,forcex,forcey,Tbu,tarear, & + umassdti,fm,uarear,strintx,strinty,uvel_init,vvel_init + real (kind=dbl_kind), dimension(:), allocatable :: & + strength,uvel,vvel,dxt,dyt, & +!v1 dxhy,dyhx,cyp,cxp,cym,cxm,tinyarea, & +!v1 waterx,watery, & + 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 + real (kind=DBL_KIND), dimension(:), allocatable :: & + str1, str2, str3, str4, str5, str6, str7, str8 + real (kind=dbl_kind), dimension(:), allocatable :: & + HTE,HTN, & + HTEm1,HTNm1 + logical(kind=log_kind),parameter :: dbug = .false. + + +!--- dmi_omp --------------------------- + interface domp_get_domain + module procedure domp_get_domain_rlu + end interface + + INTEGER, PARAMETER :: JPIM = SELECTED_INT_KIND(9) + integer(int_kind) :: domp_iam, domp_nt + +#if defined (_OPENMP) + ! Please note, this constant will create a compiler info for a constant + ! expression in IF statements: + real(kind=dbl_kind) :: rdomp_iam, rdomp_nt + !$OMP THREADPRIVATE(domp_iam,domp_nt,rdomp_iam,rdomp_nt) +#endif +!--- dmi_omp --------------------------- + +!--- bench_v2 -------------------------- + interface evp1d_stress + module procedure stress_i + module procedure stress_l + end interface + interface evp1d_stepu + module procedure stepu_iter + module procedure stepu_last + end interface +!--- bench_v2 -------------------------- + + contains + +!=============================================================================== +!former module dmi_omp + + subroutine domp_init(nt_out) + +#if defined (_OPENMP) + use omp_lib, only : omp_get_thread_num, omp_get_num_threads +#endif + + integer(int_kind), intent(out) :: nt_out + + character(len=*), parameter :: subname = '(domp_init)' + !--------------------------------------- + + !$OMP PARALLEL DEFAULT(none) +#if defined (_OPENMP) + domp_iam = omp_get_thread_num() + rdomp_iam = real(domp_iam,dbl_kind) + domp_nt = omp_get_num_threads() + rdomp_nt = real(domp_nt,dbl_kind) +#else + domp_iam = 0 + domp_nt = 1 +#endif + !$OMP END PARALLEL + + if (dbug) then +#if defined (_OPENACC) + write(nu_diag,'(2a)') subname,' Build with openACC support' +!#elif defined (_OPENMP) +! write(nu_diag,'(2a)') subname,' Build with openMP support' +!#else +! write(nu_diag,'(2a)') subname,' Build without openMP and openACC support' +#endif + + !- echo #threads: + if (domp_nt > 1) then + write(nu_diag,'(2a,i5,a)') subname,' Running openMP with ', domp_nt, ' threads' + else +#if defined (_OPENMP) + write(nu_diag,'(2a)') subname,' Running openMP with a single thread' +#else + write(nu_diag,'(2a)') subname,' Running without openMP' +#endif + endif + endif + + !- return value of #threads: + nt_out = domp_nt + + end subroutine domp_init + +!---------------------------------------------------------------------------- + + subroutine domp_get_domain_rlu(lower,upper,d_lower,d_upper) + +#if defined (_OPENMP) + use omp_lib, only : omp_in_parallel + use ice_constants, only: p5 +#endif + + integer(KIND=JPIM), intent(in) :: lower,upper + integer(KIND=JPIM), intent(out) :: d_lower,d_upper + +#if defined (_OPENMP) + !-- local variables + real(kind=dbl_kind) :: dlen +#endif + + character(len=*), parameter :: subname = '(domp_get_domain_rlu)' + !--------------------------------------- + + ! proper action in "null" cases: + if (upper <= 0 .or. upper < lower) then + d_lower = 0 + d_upper = -1 + return + endif + + ! proper action in serial sections + d_lower = lower + d_upper = upper + +#if defined (_OPENMP) + if (omp_in_parallel()) then + dlen = real(upper-lower+1, dbl_kind) + d_lower = lower + floor((rdomp_iam*dlen+p5)/rdomp_nt, JPIM) + d_upper = lower -1 + floor((rdomp_iam*dlen+dlen+p5)/rdomp_nt, JPIM) + endif +#endif + + if (.false.) then + write(nu_diag,'(2a,i3,a,2i10)') subname,' openMP thread ', domp_iam, & + ' handles range: ', d_lower, d_upper + endif + + end subroutine domp_get_domain_rlu + +!---------------------------------------------------------------------------- + + subroutine domp_get_thread_no (tnum) + + implicit none + integer(int_kind), intent(out) :: tnum + character(len=*), parameter :: subname = '(domp_get_thread_no)' + + tnum = domp_iam + 1 + + end subroutine domp_get_thread_no + +!---------------------------------------------------------------------------- + +!former end module dmi_omp + +!=============================================================================== + +!former module bench_v2 + +!---------------------------------------------------------------------------- + + subroutine stress_i(NA_len, & + ee,ne,se,lb,ub,uvel,vvel,dxt,dyt, & + hte,htn,htem1,htnm1, & + strength,stressp_1,stressp_2,stressp_3,stressp_4, & + stressm_1,stressm_2,stressm_3,stressm_4,stress12_1, & + stress12_2,stress12_3,stress12_4,str1,str2,str3,str4,str5, & + str6,str7,str8) + + use ice_kinds_mod + use ice_constants, only: p027, p055, p111, p166, p222, p25, p333, p5, c1p5, c1 + use ice_dyn_shared, only: ecci, denom1, arlx1i, Ktens, revp + + implicit none + + integer (kind=int_kind), intent(in) :: NA_len + integer (kind=int_kind), intent(in) :: lb,ub + integer (kind=int_kind), dimension(:), intent(in), contiguous :: ee,ne,se + real (kind=dbl_kind), dimension(:), intent(in), contiguous :: & + strength, uvel, vvel, dxt, dyt, & + hte,htn,htem1,htnm1 + real (kind=dbl_kind), dimension(:), intent(inout), contiguous :: & + stressp_1,stressp_2, stressp_3, stressp_4, stressm_1, stressm_2, & + stressm_3,stressm_4, stress12_1,stress12_2,stress12_3, stress12_4 + real (kind=DBL_KIND), dimension(:), intent(out), contiguous :: & + str1,str2,str3,str4,str5,str6,str7,str8 + + !-- local variables + + integer (kind=int_kind) :: iw,il,iu + real (kind=dbl_kind) :: & + puny + real (kind=DBL_KIND) :: & + divune, divunw, divuse, divusw,tensionne, tensionnw, tensionse, tensionsw, & + shearne, shearnw, shearse, shearsw, Deltane, Deltanw, Deltase, Deltasw , & + c0ne, c0nw, c0se, c0sw, c1ne, c1nw, c1se, c1sw , & + ssigpn, ssigps, ssigpe, ssigpw, ssigmn, ssigms, ssigme, ssigmw , & + ssig12n, ssig12s, ssig12e, ssig12w, ssigp1, ssigp2,ssigm1, ssigm2,ssig121, & + ssig122, csigpne, csigpnw, csigpse, csigpsw,csigmne, csigmnw, csigmse , & + csigmsw, csig12ne, csig12nw, csig12se, csig12sw, str12ew, str12we,str12ns, & + str12sn, strp_tmp, strm_tmp, tmp_uvel_ee, tmp_vvel_se, tmp_vvel_ee, & + tmp_vvel_ne, tmp_uvel_ne, tmp_uvel_se + real (kind=DBL_KIND) :: dxhy,dyhx,cxp,cyp,cxm,cym,tinyarea + + character(len=*), parameter :: subname = '(stress_i)' + !--------------------------------------- + + call icepack_query_parameters(puny_out=puny) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + +#ifdef _OPENACC + !$acc parallel & + !$acc present(ee,ne,se,strength,uvel,vvel,dxt,dyt, & + !$acc hte, htn, htem1, htnm1, & + !$acc str1,str2,str3,str4,str5,str6,str7,str8, & + !$acc stressp_1,stressp_2,stressp_3,stressp_4, & + !$acc stressm_1,stressm_2,stressm_3,stressm_4, & + !$acc stress12_1,stress12_2,stress12_3,stress12_4) + !$acc loop + do iw = 1,NA_len +#else + call domp_get_domain(lb,ub,il,iu) + do iw = il, iu +#endif + tinyarea = puny*dxt(iw)*dyt(iw) + dxhy = p5*(hte(iw) - htem1(iw)) + dyhx = p5*(htn(iw) - htnm1(iw)) + cxp = c1p5*htn(iw) - p5*htnm1(iw) + cyp = c1p5*hte(iw) - p5*htem1(iw) + cxm = -(c1p5*htnm1(iw) - p5*htn(iw)) + cym = -(c1p5*htem1(iw) - p5*hte(iw)) + + !----------------------------------------------------------------- + ! strain rates + ! NOTE these are actually strain rates * area (m^2/s) + !----------------------------------------------------------------- + ! divergence = e_11 + e_22 + tmp_uvel_ee = uvel(ee(iw)) + tmp_vvel_ee = vvel(ee(iw)) + + tmp_vvel_se = vvel(se(iw)) + tmp_uvel_se = uvel(se(iw)) + + ! ne + divune = cyp*uvel(iw) - dyt(iw)*tmp_uvel_ee & + + cxp*vvel(iw) - dxt(iw)*tmp_vvel_se + ! tension strain rate = e_11 - e_22 + tensionne = -cym*uvel(iw) - dyt(iw)*tmp_uvel_ee & + + cxm*vvel(iw) + dxt(iw)*tmp_vvel_se + ! shearing strain rate = 2*e_12 + shearne = -cym*vvel(iw) - dyt(iw)*tmp_vvel_ee & + - cxm*uvel(iw) - dxt(iw)*tmp_uvel_se + ! Delta (in the denominator of zeta, eta) + Deltane = sqrt(divune**2 + ecci*(tensionne**2 + shearne**2)) + + ! These two can move after ne block + ! + tmp_uvel_ne = uvel(ne(iw)) + tmp_vvel_ne = vvel(ne(iw)) + + ! nw + divunw = cym*tmp_uvel_ee + dyt(iw)*uvel(iw) & + + cxp*tmp_vvel_ee - dxt(iw)*tmp_vvel_ne + tensionnw = -cyp*tmp_uvel_ee + dyt(iw)*uvel(iw) & + + cxm*tmp_vvel_ee + dxt(iw)*tmp_vvel_ne + shearnw = -cyp*tmp_vvel_ee + dyt(iw)*vvel(iw) & + - cxm*tmp_uvel_ee - dxt(iw)*tmp_uvel_ne + Deltanw = sqrt(divunw**2 + ecci*(tensionnw**2 + shearnw**2)) + + ! sw + divusw = cym*tmp_uvel_ne + dyt(iw)*tmp_uvel_se & + + cxm*tmp_vvel_ne + dxt(iw)*tmp_vvel_ee + tensionsw = -cyp*tmp_uvel_ne + dyt(iw)*tmp_uvel_se & + + cxp*tmp_vvel_ne - dxt(iw)*tmp_vvel_ee + shearsw = -cyp*tmp_vvel_ne + dyt(iw)*tmp_vvel_se & + - cxp*tmp_uvel_ne + dxt(iw)*tmp_uvel_ee + Deltasw = sqrt(divusw**2 + ecci*(tensionsw**2 + shearsw**2)) + + ! se + divuse = cyp*tmp_uvel_se - dyt(iw)*tmp_uvel_ne & + + cxm*tmp_vvel_se + dxt(iw)*vvel(iw) + tensionse = -cym*tmp_uvel_se - dyt(iw)*tmp_uvel_ne & + + cxp*tmp_vvel_se - dxt(iw)*vvel(iw) + shearse = -cym*tmp_vvel_se - dyt(iw)*tmp_vvel_ne & + - cxp*tmp_uvel_se + dxt(iw)*uvel(iw) + Deltase = sqrt(divuse**2 + ecci*(tensionse**2 + shearse**2)) + + !----------------------------------------------------------------- + ! replacement pressure/Delta ! kg/s + ! save replacement pressure for principal stress calculation + !----------------------------------------------------------------- + c0ne = strength(iw)/max(Deltane,tinyarea) + c0nw = strength(iw)/max(Deltanw,tinyarea) + c0sw = strength(iw)/max(Deltasw,tinyarea) + c0se = strength(iw)/max(Deltase,tinyarea) + + c1ne = c0ne*arlx1i + c1nw = c0nw*arlx1i + c1sw = c0sw*arlx1i + c1se = c0se*arlx1i + + c0ne = c1ne*ecci + c0nw = c1nw*ecci + c0sw = c1sw*ecci + c0se = c1se*ecci + + !----------------------------------------------------------------- + ! the stresses ! kg/s^2 + ! (1) northeast, (2) northwest, (3) southwest, (4) southeast + !----------------------------------------------------------------- + + stressp_1(iw) = (stressp_1(iw)*(c1-arlx1i*revp) + c1ne*(divune*(c1+Ktens) - Deltane*(c1-Ktens))) * denom1 + stressp_2(iw) = (stressp_2(iw)*(c1-arlx1i*revp) + c1nw*(divunw*(c1+Ktens) - Deltanw*(c1-Ktens))) * denom1 + stressp_3(iw) = (stressp_3(iw)*(c1-arlx1i*revp) + c1sw*(divusw*(c1+Ktens) - Deltasw*(c1-Ktens))) * denom1 + stressp_4(iw) = (stressp_4(iw)*(c1-arlx1i*revp) + c1se*(divuse*(c1+Ktens) - Deltase*(c1-Ktens))) * denom1 + + stressm_1(iw) = (stressm_1(iw)*(c1-arlx1i*revp) + c0ne*tensionne*(c1+Ktens)) * denom1 + stressm_2(iw) = (stressm_2(iw)*(c1-arlx1i*revp) + c0nw*tensionnw*(c1+Ktens)) * denom1 + stressm_3(iw) = (stressm_3(iw)*(c1-arlx1i*revp) + c0sw*tensionsw*(c1+Ktens)) * denom1 + stressm_4(iw) = (stressm_4(iw)*(c1-arlx1i*revp) + c0se*tensionse*(c1+Ktens)) * denom1 + + stress12_1(iw) = (stress12_1(iw)*(c1-arlx1i*revp) + c0ne*shearne*p5*(c1+Ktens)) * denom1 + stress12_2(iw) = (stress12_2(iw)*(c1-arlx1i*revp) + c0nw*shearnw*p5*(c1+Ktens)) * denom1 + stress12_3(iw) = (stress12_3(iw)*(c1-arlx1i*revp) + c0sw*shearsw*p5*(c1+Ktens)) * denom1 + stress12_4(iw) = (stress12_4(iw)*(c1-arlx1i*revp) + c0se*shearse*p5*(c1+Ktens)) * denom1 + + !----------------------------------------------------------------- + ! combinations of the stresses for the momentum equation ! kg/s^2 + !----------------------------------------------------------------- + + ssigpn = stressp_1(iw) + stressp_2(iw) + ssigps = stressp_3(iw) + stressp_4(iw) + ssigpe = stressp_1(iw) + stressp_4(iw) + ssigpw = stressp_2(iw) + stressp_3(iw) + ssigp1 =(stressp_1(iw) + stressp_3(iw))*p055 + ssigp2 =(stressp_2(iw) + stressp_4(iw))*p055 + + ssigmn = stressm_1(iw) + stressm_2(iw) + ssigms = stressm_3(iw) + stressm_4(iw) + ssigme = stressm_1(iw) + stressm_4(iw) + ssigmw = stressm_2(iw) + stressm_3(iw) + ssigm1 =(stressm_1(iw) + stressm_3(iw))*p055 + ssigm2 =(stressm_2(iw) + stressm_4(iw))*p055 + + ssig12n = stress12_1(iw) + stress12_2(iw) + ssig12s = stress12_3(iw) + stress12_4(iw) + ssig12e = stress12_1(iw) + stress12_4(iw) + ssig12w = stress12_2(iw) + stress12_3(iw) + ssig121 =(stress12_1(iw) + stress12_3(iw))*p111 + ssig122 =(stress12_2(iw) + stress12_4(iw))*p111 + + csigpne = p111*stressp_1(iw) + ssigp2 + p027*stressp_3(iw) + csigpnw = p111*stressp_2(iw) + ssigp1 + p027*stressp_4(iw) + csigpsw = p111*stressp_3(iw) + ssigp2 + p027*stressp_1(iw) + csigpse = p111*stressp_4(iw) + ssigp1 + p027*stressp_2(iw) + + csigmne = p111*stressm_1(iw) + ssigm2 + p027*stressm_3(iw) + csigmnw = p111*stressm_2(iw) + ssigm1 + p027*stressm_4(iw) + csigmsw = p111*stressm_3(iw) + ssigm2 + p027*stressm_1(iw) + csigmse = p111*stressm_4(iw) + ssigm1 + p027*stressm_2(iw) + + csig12ne = p222*stress12_1(iw) + ssig122 + p055*stress12_3(iw) + csig12nw = p222*stress12_2(iw) + ssig121 + p055*stress12_4(iw) + csig12sw = p222*stress12_3(iw) + ssig122 + p055*stress12_1(iw) + csig12se = p222*stress12_4(iw) + ssig121 + p055*stress12_2(iw) + + str12ew = p5*dxt(iw)*(p333*ssig12e + p166*ssig12w) + str12we = p5*dxt(iw)*(p333*ssig12w + p166*ssig12e) + str12ns = p5*dyt(iw)*(p333*ssig12n + p166*ssig12s) + str12sn = p5*dyt(iw)*(p333*ssig12s + p166*ssig12n) + + !----------------------------------------------------------------- + ! for dF/dx (u momentum) + !----------------------------------------------------------------- + strp_tmp = p25*dyt(iw)*(p333*ssigpn + p166*ssigps) + strm_tmp = p25*dyt(iw)*(p333*ssigmn + p166*ssigms) + + ! northeast (iw) + str1(iw) = -strp_tmp - strm_tmp - str12ew & + + dxhy*(-csigpne + csigmne) + dyhx*csig12ne + + ! northwest (i+1,j) + str2(iw) = strp_tmp + strm_tmp - str12we & + + dxhy*(-csigpnw + csigmnw) + dyhx*csig12nw + + strp_tmp = p25*dyt(iw)*(p333*ssigps + p166*ssigpn) + strm_tmp = p25*dyt(iw)*(p333*ssigms + p166*ssigmn) + + ! southeast (i,j+1) + str3(iw) = -strp_tmp - strm_tmp + str12ew & + + dxhy*(-csigpse + csigmse) + dyhx*csig12se + + ! southwest (i+1,j+1) + str4(iw) = strp_tmp + strm_tmp + str12we & + + dxhy*(-csigpsw + csigmsw) + dyhx*csig12sw + + !----------------------------------------------------------------- + ! for dF/dy (v momentum) + !----------------------------------------------------------------- + strp_tmp = p25*dxt(iw)*(p333*ssigpe + p166*ssigpw) + strm_tmp = p25*dxt(iw)*(p333*ssigme + p166*ssigmw) + + ! northeast (i,j) + str5(iw) = -strp_tmp + strm_tmp - str12ns & + - dyhx*(csigpne + csigmne) + dxhy*csig12ne + + ! southeast (i,j+1) + str6(iw) = strp_tmp - strm_tmp - str12sn & + - dyhx*(csigpse + csigmse) + dxhy*csig12se + + strp_tmp = p25*dxt(iw)*(p333*ssigpw + p166*ssigpe) + strm_tmp = p25*dxt(iw)*(p333*ssigmw + p166*ssigme) + + ! northwest (i+1,j) + str7(iw) = -strp_tmp + strm_tmp + str12ns & + - dyhx*(csigpnw + csigmnw) + dxhy*csig12nw + + ! southwest (i+1,j+1) + str8(iw) = strp_tmp - strm_tmp + str12sn & + - dyhx*(csigpsw + csigmsw) + dxhy*csig12sw + enddo +#ifdef _OPENACC + !$acc end parallel +#endif + + end subroutine stress_i + +!---------------------------------------------------------------------------- + + subroutine stress_l(NA_len, tarear, & + ee,ne,se,lb,ub,uvel,vvel,dxt,dyt, & + hte,htn,htem1,htnm1, & + strength,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, & + str1,str2,str3,str4,str5,str6,str7,str8 ) + + use ice_kinds_mod + use ice_constants, only: p027, p055, p111, p166, p222, p25, p333, p5, c1p5, c0, c1 + use ice_dyn_shared, only: ecci, denom1, arlx1i, Ktens, revp + + implicit none + + integer (kind=int_kind), intent(in) :: NA_len + integer (kind=int_kind), intent(in) :: lb,ub + integer (kind=int_kind), dimension(:), intent(in), contiguous :: ee,ne,se + real (kind=dbl_kind), dimension(:), intent(in), contiguous :: & + strength, uvel, vvel, dxt, dyt, tarear, & + hte,htn,htem1,htnm1 + real (kind=dbl_kind), dimension(:), intent(inout), contiguous :: & + stressp_1,stressp_2, stressp_3, stressp_4, stressm_1, stressm_2, & + stressm_3,stressm_4, stress12_1,stress12_2,stress12_3, stress12_4 + real (kind=DBL_KIND), dimension(:), intent(out), contiguous :: & + str1,str2,str3,str4,str5,str6,str7,str8 + real (kind=dbl_kind), dimension(:), intent(out), contiguous :: & + divu,rdg_conv,rdg_shear,shear + + !-- local variables + + integer (kind=int_kind) :: iw,il,iu + real (kind=dbl_kind) :: & + puny + real (kind=DBL_KIND) :: & + divune, divunw, divuse, divusw,tensionne, tensionnw, tensionse, tensionsw, & + shearne, shearnw, shearse, shearsw, Deltane, Deltanw, Deltase, Deltasw , & + c0ne, c0nw, c0se, c0sw, c1ne, c1nw, c1se, c1sw , & + ssigpn, ssigps, ssigpe, ssigpw, ssigmn, ssigms, ssigme, ssigmw , & + ssig12n, ssig12s, ssig12e, ssig12w, ssigp1, ssigp2,ssigm1, ssigm2,ssig121, & + ssig122, csigpne, csigpnw, csigpse, csigpsw,csigmne, csigmnw, csigmse , & + csigmsw, csig12ne, csig12nw, csig12se, csig12sw, str12ew, str12we,str12ns, & + str12sn, strp_tmp, strm_tmp, tmp_uvel_ee, tmp_vvel_se, tmp_vvel_ee, & + tmp_vvel_ne, tmp_uvel_ne, tmp_uvel_se + real (kind=DBL_KIND) :: dxhy,dyhx,cxp,cyp,cxm,cym,tinyarea + + character(len=*), parameter :: subname = '(stress_l)' + !--------------------------------------- + + call icepack_query_parameters(puny_out=puny) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + +#ifdef _OPENACC + !$acc parallel & + !$acc present(ee,ne,se,strength,uvel,vvel,dxt,dyt,tarear, & + !$acc hte,htn,htem1,htnm1, & + !$acc str1,str2,str3,str4,str5,str6,str7,str8, & + !$acc stressp_1,stressp_2,stressp_3,stressp_4, & + !$acc stressm_1,stressm_2,stressm_3,stressm_4, & + !$acc stress12_1,stress12_2,stress12_3,stress12_4, & + !$acc divu,rdg_conv,rdg_shear,shear) + !$acc loop + do iw = 1,NA_len +#else + call domp_get_domain(lb,ub,il,iu) + do iw = il, iu +#endif + tinyarea = puny*dxt(iw)*dyt(iw) + dxhy = p5*(hte(iw) - htem1(iw)) + dyhx = p5*(htn(iw) - htnm1(iw)) + cxp = c1p5*htn(iw) - p5*htnm1(iw) + cyp = c1p5*hte(iw) - p5*htem1(iw) + cxm = -(c1p5*htnm1(iw) - p5*htn(iw)) + cym = -(c1p5*htem1(iw) - p5*hte(iw)) + + !----------------------------------------------------------------- + ! strain rates + ! NOTE these are actually strain rates * area (m^2/s) + !----------------------------------------------------------------- + ! divergence = e_11 + e_22 + tmp_uvel_ee = uvel(ee(iw)) + tmp_vvel_se = vvel(se(iw)) + tmp_vvel_ee = vvel(ee(iw)) + tmp_vvel_ne = vvel(ne(iw)) + tmp_uvel_ne = uvel(ne(iw)) + tmp_uvel_se = uvel(se(iw)) + + divune = cyp*uvel(iw) - dyt(iw)*tmp_uvel_ee & + + cxp*vvel(iw) - dxt(iw)*tmp_vvel_se + divunw = cym*tmp_uvel_ee + dyt(iw)*uvel(iw) & + + cxp*tmp_vvel_ee - dxt(iw)*tmp_vvel_ne + divusw = cym*tmp_uvel_ne + dyt(iw)*tmp_uvel_se & + + cxm*tmp_vvel_ne + dxt(iw)*tmp_vvel_ee + divuse = cyp*tmp_uvel_se - dyt(iw)*tmp_uvel_ne & + + cxm*tmp_vvel_se + dxt(iw)*vvel(iw) + + ! tension strain rate = e_11 - e_22 + tensionne = -cym*uvel(iw) - dyt(iw)*tmp_uvel_ee & + + cxm*vvel(iw) + dxt(iw)*tmp_vvel_se + tensionnw = -cyp*tmp_uvel_ee + dyt(iw)*uvel(iw) & + + cxm*tmp_vvel_ee + dxt(iw)*tmp_vvel_ne + tensionsw = -cyp*tmp_uvel_ne + dyt(iw)*tmp_uvel_se & + + cxp*tmp_vvel_ne - dxt(iw)*tmp_vvel_ee + tensionse = -cym*tmp_uvel_se - dyt(iw)*tmp_uvel_ne & + + cxp*tmp_vvel_se - dxt(iw)*vvel(iw) + + ! shearing strain rate = 2*e_12 + shearne = -cym*vvel(iw) - dyt(iw)*tmp_vvel_ee & + - cxm*uvel(iw) - dxt(iw)*tmp_uvel_se + shearnw = -cyp*tmp_vvel_ee + dyt(iw)*vvel(iw) & + - cxm*tmp_uvel_ee - dxt(iw)*tmp_uvel_ne + shearsw = -cyp*tmp_vvel_ne + dyt(iw)*tmp_vvel_se & + - cxp*tmp_uvel_ne + dxt(iw)*tmp_uvel_ee + shearse = -cym*tmp_vvel_se - dyt(iw)*tmp_vvel_ne & + - cxp*tmp_uvel_se + dxt(iw)*uvel(iw) + + ! Delta (in the denominator of zeta, eta) + Deltane = sqrt(divune**2 + ecci*(tensionne**2 + shearne**2)) + Deltanw = sqrt(divunw**2 + ecci*(tensionnw**2 + shearnw**2)) + Deltase = sqrt(divuse**2 + ecci*(tensionse**2 + shearse**2)) + Deltasw = sqrt(divusw**2 + ecci*(tensionsw**2 + shearsw**2)) + + !----------------------------------------------------------------- + ! on last subcycle, save quantities for mechanical redistribution + !----------------------------------------------------------------- + divu(iw) = p25*(divune + divunw + divuse + divusw) * tarear(iw) + rdg_conv(iw) = -min(divu(iw),c0) ! Could move outside the entire "kernel" + rdg_shear(iw) = p5*( p25*(Deltane + Deltanw + Deltase + Deltasw) * tarear(iw) -abs(divu(iw)) ) + + ! diagnostic only + ! shear = sqrt(tension**2 + shearing**2) + shear(iw) = p25*tarear(iw)*sqrt( & + (tensionne + tensionnw + tensionse + tensionsw)**2 & + + (shearne + shearnw + shearse + shearsw)**2) + + !----------------------------------------------------------------- + ! replacement pressure/Delta ! kg/s + ! save replacement pressure for principal stress calculation + !----------------------------------------------------------------- + c0ne = strength(iw)/max(Deltane,tinyarea) + c0nw = strength(iw)/max(Deltanw,tinyarea) + c0sw = strength(iw)/max(Deltasw,tinyarea) + c0se = strength(iw)/max(Deltase,tinyarea) + + c1ne = c0ne*arlx1i + c1nw = c0nw*arlx1i + c1sw = c0sw*arlx1i + c1se = c0se*arlx1i + + c0ne = c1ne*ecci + c0nw = c1nw*ecci + c0sw = c1sw*ecci + c0se = c1se*ecci + + !----------------------------------------------------------------- + ! the stresses ! kg/s^2 + ! (1) northeast, (2) northwest, (3) southwest, (4) southeast + !----------------------------------------------------------------- + + stressp_1(iw) = (stressp_1(iw)*(c1-arlx1i*revp) + c1ne*(divune*(c1+Ktens) - Deltane*(c1-Ktens))) * denom1 + stressp_2(iw) = (stressp_2(iw)*(c1-arlx1i*revp) + c1nw*(divunw*(c1+Ktens) - Deltanw*(c1-Ktens))) * denom1 + stressp_3(iw) = (stressp_3(iw)*(c1-arlx1i*revp) + c1sw*(divusw*(c1+Ktens) - Deltasw*(c1-Ktens))) * denom1 + stressp_4(iw) = (stressp_4(iw)*(c1-arlx1i*revp) + c1se*(divuse*(c1+Ktens) - Deltase*(c1-Ktens))) * denom1 + + stressm_1(iw) = (stressm_1(iw)*(c1-arlx1i*revp) + c0ne*tensionne*(c1+Ktens)) * denom1 + stressm_2(iw) = (stressm_2(iw)*(c1-arlx1i*revp) + c0nw*tensionnw*(c1+Ktens)) * denom1 + stressm_3(iw) = (stressm_3(iw)*(c1-arlx1i*revp) + c0sw*tensionsw*(c1+Ktens)) * denom1 + stressm_4(iw) = (stressm_4(iw)*(c1-arlx1i*revp) + c0se*tensionse*(c1+Ktens)) * denom1 + + stress12_1(iw) = (stress12_1(iw)*(c1-arlx1i*revp) + c0ne*shearne*p5*(c1+Ktens)) * denom1 + stress12_2(iw) = (stress12_2(iw)*(c1-arlx1i*revp) + c0nw*shearnw*p5*(c1+Ktens)) * denom1 + stress12_3(iw) = (stress12_3(iw)*(c1-arlx1i*revp) + c0sw*shearsw*p5*(c1+Ktens)) * denom1 + stress12_4(iw) = (stress12_4(iw)*(c1-arlx1i*revp) + c0se*shearse*p5*(c1+Ktens)) * denom1 + + !----------------------------------------------------------------- + ! combinations of the stresses for the momentum equation ! kg/s^2 + !----------------------------------------------------------------- + + ssigpn = stressp_1(iw) + stressp_2(iw) + ssigps = stressp_3(iw) + stressp_4(iw) + ssigpe = stressp_1(iw) + stressp_4(iw) + ssigpw = stressp_2(iw) + stressp_3(iw) + ssigp1 =(stressp_1(iw) + stressp_3(iw))*p055 + ssigp2 =(stressp_2(iw) + stressp_4(iw))*p055 + + ssigmn = stressm_1(iw) + stressm_2(iw) + ssigms = stressm_3(iw) + stressm_4(iw) + ssigme = stressm_1(iw) + stressm_4(iw) + ssigmw = stressm_2(iw) + stressm_3(iw) + ssigm1 =(stressm_1(iw) + stressm_3(iw))*p055 + ssigm2 =(stressm_2(iw) + stressm_4(iw))*p055 + + ssig12n = stress12_1(iw) + stress12_2(iw) + ssig12s = stress12_3(iw) + stress12_4(iw) + ssig12e = stress12_1(iw) + stress12_4(iw) + ssig12w = stress12_2(iw) + stress12_3(iw) + ssig121 =(stress12_1(iw) + stress12_3(iw))*p111 + ssig122 =(stress12_2(iw) + stress12_4(iw))*p111 + + csigpne = p111*stressp_1(iw) + ssigp2 + p027*stressp_3(iw) + csigpnw = p111*stressp_2(iw) + ssigp1 + p027*stressp_4(iw) + csigpsw = p111*stressp_3(iw) + ssigp2 + p027*stressp_1(iw) + csigpse = p111*stressp_4(iw) + ssigp1 + p027*stressp_2(iw) + + csigmne = p111*stressm_1(iw) + ssigm2 + p027*stressm_3(iw) + csigmnw = p111*stressm_2(iw) + ssigm1 + p027*stressm_4(iw) + csigmsw = p111*stressm_3(iw) + ssigm2 + p027*stressm_1(iw) + csigmse = p111*stressm_4(iw) + ssigm1 + p027*stressm_2(iw) + + csig12ne = p222*stress12_1(iw) + ssig122 + p055*stress12_3(iw) + csig12nw = p222*stress12_2(iw) + ssig121 + p055*stress12_4(iw) + csig12sw = p222*stress12_3(iw) + ssig122 + p055*stress12_1(iw) + csig12se = p222*stress12_4(iw) + ssig121 + p055*stress12_2(iw) + + str12ew = p5*dxt(iw)*(p333*ssig12e + p166*ssig12w) + str12we = p5*dxt(iw)*(p333*ssig12w + p166*ssig12e) + str12ns = p5*dyt(iw)*(p333*ssig12n + p166*ssig12s) + str12sn = p5*dyt(iw)*(p333*ssig12s + p166*ssig12n) + + !----------------------------------------------------------------- + ! for dF/dx (u momentum) + !----------------------------------------------------------------- + strp_tmp = p25*dyt(iw)*(p333*ssigpn + p166*ssigps) + strm_tmp = p25*dyt(iw)*(p333*ssigmn + p166*ssigms) + + ! northeast (iw) + str1(iw) = -strp_tmp - strm_tmp - str12ew & + + dxhy*(-csigpne + csigmne) + dyhx*csig12ne + + ! northwest (i+1,j) + str2(iw) = strp_tmp + strm_tmp - str12we & + + dxhy*(-csigpnw + csigmnw) + dyhx*csig12nw + + strp_tmp = p25*dyt(iw)*(p333*ssigps + p166*ssigpn) + strm_tmp = p25*dyt(iw)*(p333*ssigms + p166*ssigmn) + + ! southeast (i,j+1) + str3(iw) = -strp_tmp - strm_tmp + str12ew & + + dxhy*(-csigpse + csigmse) + dyhx*csig12se + + ! southwest (i+1,j+1) + str4(iw) = strp_tmp + strm_tmp + str12we & + + dxhy*(-csigpsw + csigmsw) + dyhx*csig12sw + + !----------------------------------------------------------------- + ! for dF/dy (v momentum) + !----------------------------------------------------------------- + strp_tmp = p25*dxt(iw)*(p333*ssigpe + p166*ssigpw) + strm_tmp = p25*dxt(iw)*(p333*ssigme + p166*ssigmw) + + ! northeast (i,j) + str5(iw) = -strp_tmp + strm_tmp - str12ns & + - dyhx*(csigpne + csigmne) + dxhy*csig12ne + + ! southeast (i,j+1) + str6(iw) = strp_tmp - strm_tmp - str12sn & + - dyhx*(csigpse + csigmse) + dxhy*csig12se + + strp_tmp = p25*dxt(iw)*(p333*ssigpw + p166*ssigpe) + strm_tmp = p25*dxt(iw)*(p333*ssigmw + p166*ssigme) + + ! northwest (i+1,j) + str7(iw) = -strp_tmp + strm_tmp + str12ns & + - dyhx*(csigpnw + csigmnw) + dxhy*csig12nw + + ! southwest (i+1,j+1) + str8(iw) = strp_tmp - strm_tmp + str12sn & + - dyhx*(csigpsw + csigmsw) + dxhy*csig12sw + enddo +#ifdef _OPENACC + !$acc end parallel +#endif + end subroutine stress_l + +!---------------------------------------------------------------------------- + + subroutine stepu_iter(NA_len,rhow, & + lb,ub,Cw,aiu,uocn,vocn,forcex,forcey,umassdti,fm,uarear,Tbu, & + uvel_init,vvel_init,uvel,vvel, & + str1,str2,str3,str4,str5,str6,str7,str8, nw,sw,se,skipme) + + use ice_kinds_mod + use ice_dyn_shared, only: brlx, revp + use ice_constants, only: c0, c1 + + implicit none + + integer (kind=int_kind), intent(in) :: NA_len + real (kind=dbl_kind), intent(in) :: rhow + integer(kind=int_kind),intent(in) :: lb,ub + logical(kind=log_kind),intent(in), dimension(:) :: skipme + integer(kind=int_kind),dimension(:), intent(in), contiguous :: nw,sw,se + real(kind=dbl_kind),dimension(:), intent(in), contiguous :: & + uvel_init, vvel_init, aiu, forcex, forcey, umassdti, Tbu, & + uocn, vocn, fm, uarear,Cw + real(kind=DBL_KIND),dimension(:), intent(in), contiguous :: & + str1,str2,str3,str4,str5,str6,str7,str8 + real(kind=dbl_kind),dimension(:), intent(inout), contiguous :: & + uvel,vvel + real (kind=dbl_kind), parameter :: & + cosw = c1 , & ! cos(ocean turning angle) ! turning angle = 0 + sinw = c0 + + !-- local variables + + integer (kind=int_kind) :: iw,il,iu + real (kind=dbl_kind) :: uold, vold, vrel,cca,ccb,ab2,cc1,cc2,taux,tauy,Cb + real (kind=dbl_kind) :: tmp_str2_nw,tmp_str3_se,tmp_str4_sw, tmp_strintx + real (kind=dbl_kind) :: tmp_str6_se,tmp_str7_nw,tmp_str8_sw, tmp_strinty + real (kind=dbl_kind) :: waterx,watery + real (kind=dbl_kind) :: u0 = 5.e-5_dbl_kind ! residual velocity for basal stress (m/s) + + character(len=*), parameter :: subname = '(stepu_iter)' + !--------------------------------------- + +#ifdef _OPENACC + !$acc parallel & + !$acc present(Cw,aiu,uocn,vocn,forcex,forcey,umassdti,fm,uarear,Tbu, & + !$acc uvel_init,vvel_init,nw,sw,se,skipme, & + !$acc str1,str2,str3,str4,str5,str6,str7,str8,uvel,vvel) + !$acc loop + do iw = 1,NA_len +#else + call domp_get_domain(lb,ub,il,iu) + do iw = il, iu +#endif + if (skipme(iw)) cycle + uold = uvel(iw) + vold = vvel(iw) + vrel = aiu(iw)*rhow*Cw(iw)*sqrt((uocn(iw)-uold)**2+(vocn(iw)-vold)**2) + waterx = uocn(iw)*cosw - vocn(iw)*sinw*sign(c1,fm(iw)) + watery = vocn(iw)*cosw + uocn(iw)*sinw*sign(c1,fm(iw)) + taux = vrel*waterx + tauy = vrel*watery + Cb = Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) + cca = (brlx + revp)*umassdti(iw) + vrel * cosw + Cb + ccb = fm(iw) + sign(c1,fm(iw)) * vrel * sinw + ab2 = cca**2 + ccb**2 + ! southeast(i,j+1) = se + ! northwest(i+1,j) = nw + ! southwest(i+1,j+1) = sw + tmp_str2_nw = str2(nw(iw)) + tmp_str3_se = str3(se(iw)) + tmp_str4_sw = str4(sw(iw)) + tmp_str6_se = str6(se(iw)) + tmp_str7_nw = str7(nw(iw)) + tmp_str8_sw = str8(sw(iw)) + + tmp_strintx = uarear(iw)*(str1(iw)+tmp_str2_nw+tmp_str3_se+tmp_str4_sw) + tmp_strinty = uarear(iw)*(str5(iw)+tmp_str6_se+tmp_str7_nw+tmp_str8_sw) + cc1 = tmp_strintx + forcex(iw) + taux & + + umassdti(iw)*(brlx*uold + revp*uvel_init(iw)) + cc2 = tmp_strinty + forcey(iw) + tauy & + + umassdti(iw)*(brlx*vold + revp*vvel_init(iw)) + uvel(iw) = (cca*cc1 + ccb*cc2) / ab2 + vvel(iw) = (cca*cc2 - ccb*cc1) / ab2 + enddo +#ifdef _OPENACC + !$acc end parallel +#endif + + end subroutine stepu_iter + +!---------------------------------------------------------------------------- + + subroutine stepu_last(NA_len, rhow, & + lb,ub,Cw,aiu,uocn,vocn,forcex,forcey,umassdti,fm,uarear,Tbu, & + strintx,strinty,taubx,tauby, & + uvel_init,vvel_init,uvel,vvel, & + str1,str2,str3,str4,str5,str6,str7,str8, nw,sw,se,skipme) + + use ice_kinds_mod + use ice_constants, only: c0, c1 + use ice_dyn_shared, only: brlx, revp, basalstress + + implicit none + + integer (kind=int_kind), intent(in) :: NA_len + real (kind=dbl_kind), intent(in) :: rhow + logical(kind=log_kind),intent(in), dimension(:) :: skipme + integer(kind=int_kind),intent(in) :: lb,ub + integer(kind=int_kind),dimension(:), intent(in), contiguous :: nw,sw,se + real(kind=dbl_kind),dimension(:), intent(in), contiguous :: & + uvel_init, vvel_init, aiu, forcex, forcey, umassdti, Tbu, & + uocn, vocn, fm, uarear,Cw + real(kind=DBL_KIND),dimension(:), intent(in), contiguous :: & + str1,str2,str3,str4,str5,str6,str7,str8 + real(kind=dbl_kind),dimension(:), intent(inout), contiguous :: & + uvel,vvel, strintx,strinty, taubx,tauby + real (kind=dbl_kind), parameter :: & + cosw = c1 , & ! cos(ocean turning angle) ! turning angle = 0 + sinw = c0 + + !-- local variables + + integer (kind=int_kind) :: iw,il,iu + real (kind=dbl_kind) :: uold, vold, vrel,cca,ccb,ab2,cc1,cc2,taux,tauy,Cb + real (kind=dbl_kind) :: tmp_str2_nw,tmp_str3_se,tmp_str4_sw + real (kind=dbl_kind) :: tmp_str6_se,tmp_str7_nw,tmp_str8_sw + real (kind=dbl_kind) :: waterx,watery + real (kind=dbl_kind) :: u0 = 5.e-5_dbl_kind ! residual velocity for basal stress (m/s) + + character(len=*), parameter :: subname = '(stepu_last)' + !--------------------------------------- + +#ifdef _OPENACC + !$acc parallel & + !$acc present(Cw,aiu,uocn,vocn,forcex,forcey,umassdti,fm,uarear,Tbu, & + !$acc strintx,strinty,taubx,tauby,uvel_init,vvel_init,nw,sw,se,skipme, & + !$acc str1,str2,str3,str4,str5,str6,str7,str8,uvel,vvel ) + !$acc loop + do iw = 1,NA_len +#else + call domp_get_domain(lb,ub,il,iu) + do iw = il, iu +#endif + if (skipme(iw)) cycle + uold = uvel(iw) + vold = vvel(iw) + vrel = aiu(iw)*rhow*Cw(iw)*sqrt((uocn(iw)-uold)**2+(vocn(iw)-vold)**2) + waterx = uocn(iw)*cosw - vocn(iw)*sinw*sign(c1,fm(iw)) + watery = vocn(iw)*cosw + uocn(iw)*sinw*sign(c1,fm(iw)) + taux = vrel*waterx + tauy = vrel*watery + Cb = Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) + cca = (brlx + revp)*umassdti(iw) + vrel * cosw + Cb + ccb = fm(iw) + sign(c1,fm(iw)) * vrel * sinw + ab2 = cca**2 + ccb**2 + ! southeast(i,j+1) = se + ! northwest(i+1,j) = nw + ! southwest(i+1,j+1) = sw + tmp_str2_nw = str2(nw(iw)) + tmp_str3_se = str3(se(iw)) + tmp_str4_sw = str4(sw(iw)) + tmp_str6_se = str6(se(iw)) + tmp_str7_nw = str7(nw(iw)) + tmp_str8_sw = str8(sw(iw)) + + strintx(iw) = uarear(iw)*(str1(iw)+tmp_str2_nw+tmp_str3_se+tmp_str4_sw) + strinty(iw) = uarear(iw)*(str5(iw)+tmp_str6_se+tmp_str7_nw+tmp_str8_sw) + cc1 = strintx(iw) + forcex(iw) + taux & + + umassdti(iw)*(brlx*uold + revp*uvel_init(iw)) + cc2 = strinty(iw) + forcey(iw) + tauy & + + umassdti(iw)*(brlx*vold + revp*vvel_init(iw)) + uvel(iw) = (cca*cc1 + ccb*cc2) / ab2 + vvel(iw) = (cca*cc2 - ccb*cc1) / ab2 + ! calculate basal stress component for outputs + if ( basalstress ) then + taubx(iw) = -uvel(iw)*Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) + tauby(iw) = -vvel(iw)*Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) + endif + enddo +#ifdef _OPENACC + !$acc end parallel +#endif + + end subroutine stepu_last + +!---------------------------------------------------------------------------- + + subroutine evp1d_halo_update(NAVEL_len,lb,ub,uvel,vvel, halo_parent) + + use ice_kinds_mod + + implicit none + + integer (kind=int_kind), intent(in) :: NAVEL_len + integer(kind=int_kind),intent(in) :: lb,ub + integer(kind=int_kind),dimension(:), intent(in), contiguous :: halo_parent + real(kind=dbl_kind),dimension(:), intent(inout), contiguous :: uvel,vvel + + !-- local variables + + integer (kind=int_kind) :: iw,il,iu + + character(len=*), parameter :: subname = '(evp1d_halo_update)' + !--------------------------------------- + +#ifdef _OPENACC + !$acc parallel & + !$acc present(uvel,vvel) & + !$acc loop + do iw = 1,NAVEL_len +#else + call domp_get_domain(lb,ub,il,iu) + do iw = il, iu +#endif + if (halo_parent(iw)==0) cycle + uvel(iw) = uvel(halo_parent(iw)) + vvel(iw) = vvel(halo_parent(iw)) + enddo +#ifdef _OPENACC + !$acc end parallel +#endif + + end subroutine evp1d_halo_update + +!---------------------------------------------------------------------------- + +!former end module bench_v2 + +!=============================================================================== +!---------------------------------------------------------------------------- + + subroutine alloc1d(na) + + implicit none + + integer(kind=int_kind),intent(in) :: na + integer(kind=int_kind) :: ierr,nb + + character(len=*), parameter :: subname = '(alloc1d)' + !--------------------------------------- + + nb=na + allocate( & + ! U+T cells + ! Helper index for neighbours + indj(1:na),indi(1:na), & + ee(1:na),ne(1:na),se(1:na), & + nw(1:nb),sw(1:nb),sse(1:nb), & + skipucell(1:na), & + ! Grid distances: HTE,HTN + "-1 neighbours" + HTE(1:na),HTN(1:na), & + HTEm1(1:na),HTNm1(1:na), & + ! T cells +!v1 dxhy(1:na),dyhx(1:na),cyp(1:na),cxp(1:na),cym(1:na),cxm(1:na),tinyarea(1:na),& + strength(1:na),dxt(1:na),dyt(1:na), tarear(1:na), & + stressp_1(1:na), stressp_2(1:na), stressp_3(1:na), stressp_4(1:na), & + stressm_1(1:na), stressm_2(1:na), stressm_3(1:na), stressm_4(1:na), & + stress12_1(1:na),stress12_2(1:na),stress12_3(1:na),stress12_4(1:na),& + divu(1:na),rdg_conv(1:na),rdg_shear(1:na),shear(1:na), & + ! U cells +!v1 waterx(1:nb),watery(1:nb), & + cdn_ocn(1:nb),aiu(1:nb),uocn(1:nb),vocn(1:nb), & + forcex(1:nb),forcey(1:nb),Tbu(1:nb), & + umassdti(1:nb),fm(1:nb),uarear(1:nb), & + strintx(1:nb),strinty(1:nb), & + uvel_init(1:nb),vvel_init(1:nb), & + taubx(1:nb),tauby(1:nb), & + stat=ierr) + + if (ierr/=0) call abort_ice(subname//': ERROR allocating 1D') + + end subroutine alloc1d + +!---------------------------------------------------------------------------- + + subroutine alloc1d_navel(navel) + + implicit none + + integer(kind=int_kind),intent(in) :: navel + integer(kind=int_kind) :: ierr + + character(len=*), parameter :: subname = '(alloc1d_navel)' + !--------------------------------------- + + allocate( & + uvel(1:navel),vvel(1:navel), indij(1:navel), halo_parent(1:navel), & + str1(1:navel),str2(1:navel),str3(1:navel),str4(1:navel), & + str5(1:navel),str6(1:navel),str7(1:navel),str8(1:navel), & + stat=ierr) + if (ierr/=0) call abort_ice(subname// ': Error allocating 1D navel') + + end subroutine alloc1d_navel + +!---------------------------------------------------------------------------- + + subroutine dealloc1d + + implicit none + + integer(kind=int_kind) :: ierr + + character(len=*), parameter :: subname = '(dealloc1d)' + !--------------------------------------- + + deallocate( & + ! U+T cells + ! Helper index for neighbours + indj,indi, & + ee,ne,se, & + nw,sw,sse, & + skipucell, & + ! T cells + strength,dxt,dyt,tarear, & + stressp_1, stressp_2, stressp_3, stressp_4, & + stressm_1, stressm_2, stressm_3, stressm_4, & + stress12_1,stress12_2,stress12_3,stress12_4,& + str1, str2,str3,str4, & + str5, str6,str7,str8, & + divu,rdg_conv,rdg_shear,shear, & + ! U cells + cdn_ocn,aiu,uocn,vocn, & + forcex,forcey,Tbu, & + umassdti,fm,uarear, & + strintx,strinty, & + uvel_init,vvel_init, & + taubx,tauby, & + ! NAVEL + uvel,vvel, indij, halo_parent, & + stat=ierr) + + if (ierr/=0) call abort_ice(subname//': Error de-allocating 1D') + +!v1 if (allocated(tinyarea)) then +!v1 deallocate( & +!v1 dxhy,dyhx,cyp,cxp,cym,cxm,tinyarea, & +!v1 waterx,watery, & +!v1 stat=ierr) +!v1 if (ierr/=0) call abort_ice(subname//': Error de-allocating 1D, v1') +!v1 endif + + if (allocated(HTE)) then + deallocate( & + ! Grid distances: HTE,HTN + "-1 neighbours" + HTE,HTN, HTEm1,HTNm1, & + stat=ierr) + if (ierr/=0) call abort_ice(subname//': Error de-allocating 1D, v2') + endif + + end subroutine dealloc1d + +!---------------------------------------------------------------------------- + + subroutine evp_copyin_v2(nx,ny,nblk,nx_glob,ny_glob, & + I_HTE,I_HTN, & +!v1 I_dxhy,I_dyhx,I_cyp,I_cxp,I_cym,I_cxm,I_tinyarea, & +!v1 I_waterx,I_watery, & + I_icetmask,I_iceumask, & + I_cdn_ocn,I_aiu,I_uocn,I_vocn,I_forcex,I_forcey,I_Tbu, & + I_umassdti,I_fm,I_uarear,I_tarear,I_strintx,I_strinty,I_uvel_init,I_vvel_init, & + I_strength,I_uvel,I_vvel,I_dxt,I_dyt, & + I_stressp_1 ,I_stressp_2, I_stressp_3, I_stressp_4, & + I_stressm_1 ,I_stressm_2, I_stressm_3, I_stressm_4, & + I_stress12_1,I_stress12_2,I_stress12_3,I_stress12_4 ) + + use ice_gather_scatter, only: gather_global_ext + use ice_domain, only: distrb_info + use ice_communicate, only: my_task, master_task + + implicit none + + integer(int_kind), intent(in) :: nx, ny, nblk, nx_glob, ny_glob + integer (kind=int_kind),dimension (nx,ny,nblk), intent(in) :: I_icetmask + logical (kind=log_kind),dimension (nx,ny,nblk), intent(in) :: I_iceumask + real (kind=dbl_kind), dimension(nx,ny,nblk), intent(in) :: & + I_HTE,I_HTN, & +!v1 I_dxhy,I_dyhx,I_cyp,I_cxp,I_cym,I_cxm,I_tinyarea, & +!v1 I_waterx,I_watery, & + I_cdn_ocn,I_aiu,I_uocn,I_vocn,I_forcex,I_forcey,I_Tbu, & + I_umassdti,I_fm,I_uarear,I_tarear,I_strintx,I_strinty,I_uvel_init,I_vvel_init, & + I_strength,I_uvel,I_vvel,I_dxt,I_dyt, & + I_stressp_1, I_stressp_2, I_stressp_3, I_stressp_4, & + I_stressm_1, I_stressm_2, I_stressm_3, I_stressm_4, & + I_stress12_1,I_stress12_2,I_stress12_3,I_stress12_4 + + !-- local variables + + integer (kind=int_kind),dimension (nx_glob,ny_glob) :: G_icetmask + logical (kind=log_kind),dimension (nx_glob,ny_glob) :: G_iceumask + real (kind=dbl_kind), dimension(nx_glob,ny_glob) :: & + G_HTE,G_HTN, & +!v1 G_dxhy,G_dyhx,G_cyp,G_cxp,G_cym,G_cxm,G_tinyarea, & +!v1 G_waterx,G_watery, & + G_cdn_ocn,G_aiu,G_uocn,G_vocn,G_forcex,G_forcey,G_Tbu, & + G_umassdti,G_fm,G_uarear,G_tarear,G_strintx,G_strinty,G_uvel_init,G_vvel_init, & + G_strength,G_uvel,G_vvel,G_dxt,G_dyt, & + G_stressp_1, G_stressp_2, G_stressp_3, G_stressp_4, & + G_stressm_1, G_stressm_2, G_stressm_3, G_stressm_4, & + G_stress12_1,G_stress12_2,G_stress12_3,G_stress12_4 + integer(kind=int_kind) :: na, navel + + character(len=*), parameter :: subname = '(evp_copyin_v2)' + !--------------------------------------- + !-- Gather data into one single block -- + + call gather_global_ext(G_icetmask, I_icetmask, master_task, distrb_info) + call gather_global_ext(G_iceumask, I_iceumask, master_task, distrb_info) + call gather_global_ext(G_HTE, I_HTE, master_task, distrb_info) + call gather_global_ext(G_HTN, I_HTN, 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) + call gather_global_ext(G_vvel, I_vvel, master_task, distrb_info) + 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 -- + + if (my_task == master_task) then + !-- Find number of active points and allocate vectors -- + call calc_na(nx_glob,ny_glob,na,G_icetmask) + call alloc1d(na) + call calc_2d_indices(nx_glob,ny_glob,na, G_icetmask, G_iceumask) + call calc_navel(nx_glob,ny_glob,na,navel) + call alloc1d_navel(navel) +!MHRI !$OMP PARALLEL DEFAULT(shared) + call numainit(1,na,navel) +!MHRI !$OMP END PARALLEL + ! Remap 2d to 1d and fill in + call convert_2d_1d(nx_glob,ny_glob,na,navel, & + G_HTE,G_HTN, & +!v1 G_dxhy,G_dyhx,G_cyp,G_cxp,G_cym,G_cxm,G_tinyarea, & +!v1 G_waterx,G_watery, & + G_cdn_ocn,G_aiu,G_uocn,G_vocn,G_forcex,G_forcey,G_Tbu, & + G_umassdti,G_fm,G_uarear,G_tarear,G_strintx,G_strinty,G_uvel_init,G_vvel_init, & + G_strength,G_uvel,G_vvel,G_dxt,G_dyt, & + G_stressp_1, G_stressp_2, G_stressp_3, G_stressp_4, & + G_stressm_1, G_stressm_2, G_stressm_3, G_stressm_4, & + G_stress12_1,G_stress12_2,G_stress12_3,G_stress12_4 ) + call calc_halo_parent(nx_glob,ny_glob,na,navel, G_icetmask) + NA_len=na + NAVEL_len=navel + endif + + !-- write check +!if (1 == 1) then +! write(nu_diag,*) subname,' MHRI: INDICES start:' +! write(nu_diag,*) 'na,navel ', na,navel +! write(nu_diag,*) 'Min/max ee', minval(ee(1:na)), maxval(ee(1:na)) +! write(nu_diag,*) 'Min/max ne', minval(ne(1:na)), maxval(ne(1:na)) +! write(nu_diag,*) 'Min/max se', minval(se(1:na)), maxval(se(1:na)) +! write(nu_diag,*) 'Min/max nw', minval(nw(1:na)), maxval(nw(1:na)) +! write(nu_diag,*) 'Min/max sw', minval(sw(1:na)), maxval(sw(1:na)) +! write(nu_diag,*) 'Min/max sse', minval(sse(1:na)), maxval(sse(1:na)) +! write(nu_diag,*) subname,' MHRI: INDICES end:' +!endif + + end subroutine evp_copyin_v2 + +!---------------------------------------------------------------------------- + + subroutine evp_copyout(nx,ny,nblk,nx_glob,ny_glob, & + I_uvel,I_vvel, I_strintx,I_strinty, & + I_stressp_1, I_stressp_2, I_stressp_3, I_stressp_4, & + I_stressm_1, I_stressm_2, I_stressm_3, I_stressm_4, & + I_stress12_1,I_stress12_2,I_stress12_3,I_stress12_4, & + I_divu,I_rdg_conv,I_rdg_shear,I_shear,I_taubx,I_tauby ) + + use ice_constants, only : c0 + use ice_gather_scatter, only: scatter_global_ext + use ice_domain, only: distrb_info + use ice_communicate, only: my_task, master_task + + implicit none + + integer(int_kind), intent(in) :: nx,ny,nblk, nx_glob,ny_glob + real(dbl_kind), dimension(nx,ny,nblk), intent(out) :: & + I_uvel,I_vvel, I_strintx,I_strinty, & + I_stressp_1, I_stressp_2, I_stressp_3, I_stressp_4, & + I_stressm_1, I_stressm_2, I_stressm_3, I_stressm_4, & + I_stress12_1,I_stress12_2,I_stress12_3,I_stress12_4, & + I_divu,I_rdg_conv, I_rdg_shear,I_shear, I_taubx,I_tauby + + !-- local variables + + real(dbl_kind), dimension(nx_glob,ny_glob) :: & + G_uvel,G_vvel, G_strintx,G_strinty, & + G_stressp_1, G_stressp_2, G_stressp_3, G_stressp_4, & + G_stressm_1, G_stressm_2, G_stressm_3, G_stressm_4, & + G_stress12_1,G_stress12_2,G_stress12_3,G_stress12_4, & + G_divu,G_rdg_conv, G_rdg_shear,G_shear, G_taubx,G_tauby + integer(int_kind) :: i,j,iw, nx_block + + character(len=*), parameter :: subname = '(evp_copyout)' + !--------------------------------------- + ! Remap 1d to 2d and fill in + nx_block=nx_glob ! Total block size in x-dir + + if (my_task == master_task) then + G_uvel = c0 + G_vvel = c0 + G_strintx = c0 + G_strinty = c0 + G_stressp_1 = c0 + G_stressp_2 = c0 + G_stressp_3 = c0 + G_stressp_4 = c0 + G_stressm_1 = c0 + G_stressm_2 = c0 + G_stressm_3 = c0 + G_stressm_4 = c0 + G_stress12_1 = c0 + G_stress12_2 = c0 + G_stress12_3 = c0 + G_stress12_4 = c0 + G_divu = c0 + G_rdg_conv = c0 + G_rdg_shear = c0 + G_shear = c0 + G_taubx = c0 + G_tauby = c0 + !$OMP PARALLEL PRIVATE(iw,i,j) + do iw=1,NAVEL_len + j=int((indij(iw)-1)/(nx_block))+1 + i=indij(iw)-(j-1)*nx_block + G_uvel(i,j) = uvel(iw) + G_vvel(i,j) = vvel(iw) + enddo + !$OMP END PARALLEL + !$OMP PARALLEL PRIVATE(iw,i,j) + do iw=1,NA_len + i=indi(iw) + j=indj(iw) +! G_uvel(i,j) = uvel(iw) ! done above +! G_vvel(i,j) = vvel(iw) ! done above + G_strintx(i,j) = strintx(iw) + G_strinty(i,j) = strinty(iw) + G_stressp_1(i,j) = stressp_1(iw) + G_stressp_2(i,j) = stressp_2(iw) + G_stressp_3(i,j) = stressp_3(iw) + G_stressp_4(i,j) = stressp_4(iw) + G_stressm_1(i,j) = stressm_1(iw) + G_stressm_2(i,j) = stressm_2(iw) + G_stressm_3(i,j) = stressm_3(iw) + G_stressm_4(i,j) = stressm_4(iw) + G_stress12_1(i,j) = stress12_1(iw) + G_stress12_2(i,j) = stress12_2(iw) + G_stress12_3(i,j) = stress12_3(iw) + G_stress12_4(i,j) = stress12_4(iw) + G_divu(i,j) = divu(iw) + G_rdg_conv(i,j) = rdg_conv(iw) + G_rdg_shear(i,j) = rdg_shear(iw) + G_shear(i,j) = shear(iw) + G_taubx(i,j) = taubx(iw) + G_tauby(i,j) = tauby(iw) + enddo + !$OMP END PARALLEL + call dealloc1d() + endif + + !-- Scatter data into blocks -- + !-- has to be done on all tasks -- + + call scatter_global_ext(I_uvel, G_uvel, master_task, distrb_info) + call scatter_global_ext(I_vvel, G_vvel, master_task, distrb_info) + call scatter_global_ext(I_strintx, G_strintx, master_task, distrb_info) + call scatter_global_ext(I_strinty, G_strinty, master_task, distrb_info) + call scatter_global_ext(I_stressp_1, G_stressp_1, master_task, distrb_info) + call scatter_global_ext(I_stressp_2, G_stressp_2, master_task, distrb_info) + call scatter_global_ext(I_stressp_3, G_stressp_3, master_task, distrb_info) + call scatter_global_ext(I_stressp_4, G_stressp_4, master_task, distrb_info) + call scatter_global_ext(I_stressm_1, G_stressm_1, master_task, distrb_info) + call scatter_global_ext(I_stressm_2, G_stressm_2, master_task, distrb_info) + call scatter_global_ext(I_stressm_3, G_stressm_3, master_task, distrb_info) + call scatter_global_ext(I_stressm_4, G_stressm_4, master_task, distrb_info) + call scatter_global_ext(I_stress12_1, G_stress12_1, master_task, distrb_info) + call scatter_global_ext(I_stress12_2, G_stress12_2, master_task, distrb_info) + call scatter_global_ext(I_stress12_3, G_stress12_3, master_task, distrb_info) + call scatter_global_ext(I_stress12_4, G_stress12_4, master_task, distrb_info) + call scatter_global_ext(I_divu, G_divu, master_task, distrb_info) + call scatter_global_ext(I_rdg_conv, G_rdg_conv, master_task, distrb_info) + call scatter_global_ext(I_rdg_shear, G_rdg_shear, master_task, distrb_info) + call scatter_global_ext(I_shear, G_shear, master_task, distrb_info) + call scatter_global_ext(I_taubx, G_taubx, master_task, distrb_info) + call scatter_global_ext(I_tauby, G_tauby, master_task, distrb_info) + + end subroutine evp_copyout + +!---------------------------------------------------------------------------- + + subroutine evp_kernel_v2 + + use ice_constants, only : c0 + use ice_dyn_shared, only: ndte + use ice_communicate, only: my_task, master_task + implicit none + + real(kind=dbl_kind) :: rhow + integer (kind=int_kind) :: i, nthreads + integer (kind=int_kind) :: na,nb,navel + + character(len=*), parameter :: subname = '(evp_kernel_v2)' + !--------------------------------------- + !-- All calculations has to be done on one single node (choose master-task) -- + + if (my_task == master_task) then + + !- Read constants... + call icepack_query_parameters(rhow_out=rhow) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + na=NA_len + nb=NA_len + navel=NAVEL_len + + !- Initialize openmp --------------------------------------------------------- + call domp_init(nthreads) ! ought to be called from main + + !- Initialize timers --------------------------------------------------------- + str1=c0 + str2=c0 + str3=c0 + str4=c0 + str5=c0 + str6=c0 + str7=c0 + str8=c0 + + if (ndte<2) call abort_ice(subname//' ERROR: ndte must be 2 or higher for this kernel') + + !$OMP PARALLEL PRIVATE(i) + do i = 1, ndte-1 + call evp1d_stress(NA_len, & + ee,ne,se,1,na,uvel,vvel,dxt,dyt, & + hte,htn,htem1,htnm1, & + strength,stressp_1,stressp_2,stressp_3,stressp_4, & + stressm_1,stressm_2,stressm_3,stressm_4,stress12_1, & + stress12_2,stress12_3,stress12_4,str1,str2,str3, & + str4,str5,str6,str7,str8) + !$OMP BARRIER + call evp1d_stepu(NA_len, rhow, & + 1,nb,cdn_ocn,aiu,uocn,vocn,forcex,forcey,umassdti,fm,uarear,Tbu,& + uvel_init,vvel_init,uvel,vvel, & + str1,str2,str3,str4,str5,str6,str7,str8, nw,sw,sse,skipucell) + !$OMP BARRIER + call evp1d_halo_update(NA_len,1,navel,uvel,vvel, halo_parent) + !$OMP BARRIER + enddo + + call evp1d_stress(NA_len, tarear, & + ee,ne,se,1,na,uvel,vvel,dxt,dyt, & + hte,htn,htem1,htnm1, & + strength,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, & + str1,str2,str3,str4,str5,str6,str7,str8) + !$OMP BARRIER + call evp1d_stepu(NA_len, rhow, & + 1,nb,cdn_ocn,aiu,uocn,vocn,forcex,forcey,umassdti,fm,uarear,Tbu,& + strintx,strinty,taubx,tauby, & + uvel_init,vvel_init,uvel,vvel, & + str1,str2,str3,str4,str5,str6,str7,str8, nw,sw,sse,skipucell) + !$OMP BARRIER + call evp1d_halo_update(NA_len,1,navel,uvel,vvel, halo_parent) + !$OMP END PARALLEL + + endif + + end subroutine evp_kernel_v2 + +!---------------------------------------------------------------------------- + + subroutine calc_na(nx,ny,na,icetmask) + ! Calculate number of active points (na) + use ice_blocks, only: nghost + + implicit none + + integer(int_kind),intent(in) :: nx,ny + integer(int_kind),intent(out) :: na + integer (kind=int_kind),dimension (nx,ny), intent(in) :: icetmask + integer(int_kind) :: i,j + + character(len=*), parameter :: subname = '(calc_na)' + !--------------------------------------- + + na = 0 +! Note: The icellt mask includes north and east ghost cells. (ice_dyn_shared.F90) + do j = 1+nghost, ny ! -nghost + do i = 1+nghost, nx ! -nghost + if (icetmask(i,j)==1) then + na=na+1 + endif + enddo + enddo + + end subroutine calc_na + +!---------------------------------------------------------------------------- + + subroutine calc_2d_indices(nx,ny,na,icetmask,iceumask) + + use ice_blocks, only: nghost + + implicit none + + integer(int_kind),intent(in) :: nx,ny,na + integer (kind=int_kind),dimension (nx,ny), intent(in) :: icetmask + logical (kind=log_kind),dimension (nx,ny), intent(in) :: iceumask + integer(int_kind) :: i,j,Nmaskt + + character(len=*), parameter :: subname = '(calc_2d_indices)' + !--------------------------------------- + + skipucell(:)=.false. + indi=0 + indj=0 + Nmaskt=0 +! Note: The icellt mask includes north and east ghost cells. (ice_dyn_shared.F90) + do j = 1+nghost, ny ! -nghost + do i = 1+nghost, nx ! -nghost + if (icetmask(i,j)==1) then + Nmaskt=Nmaskt+1 + indi(Nmaskt) = i + indj(Nmaskt) = j + ! Umask do NOT include north/east ghost cells ... skip these as well + if (iceumask(i,j) .eqv. .false. ) skipucell(Nmaskt) = .true. + if (i==nx) skipucell(Nmaskt) = .true. + if (j==ny) skipucell(Nmaskt) = .true. + endif + enddo + enddo + if (Nmaskt.ne.na) then + write(nu_diag,*) subname,' Nmaskt,na: ',Nmaskt,na + call abort_ice(subname//': ERROR Problem Nmaskt != na') + endif + if (Nmaskt==0) then + write(nu_diag,*) subname,' WARNING: NO ICE' + endif + + end subroutine calc_2d_indices + +!---------------------------------------------------------------------------- + + subroutine calc_navel(nx_block,ny_block,na,navel) + ! Calculate number of active points including needed halo points (navel) + + implicit none + + integer(int_kind),intent(in) :: nx_block,ny_block,na + integer(int_kind),intent(out) :: navel + + integer(int_kind) :: iw,i,j + integer(int_kind),dimension(1:na) :: Iin,Iee,Ine,Ise,Inw,Isw,Isse + integer(int_kind),dimension(1:7*na) :: util1,util2 + + character(len=*), parameter :: subname = '(calc_navel)' + + !--------------------------------------- + ! Additional indices used for finite differences (FD) + do iw=1,na + i=indi(iw) + j=indj(iw) + Iin(iw) = i + (j-1)*nx_block ! ( 0, 0) Target point + Iee(iw) = i-1 + (j-1)*nx_block ! (-1, 0) + Ine(iw) = i-1 + (j-2)*nx_block ! (-1,-1) + Ise(iw) = i + (j-2)*nx_block ! ( 0,-1) + Inw(iw) = i+1 + (j-1)*nx_block ! (+1, 0) + Isw(iw) = i+1 + (j-0)*nx_block ! (+1,+1) + Isse(iw)= i + (j-0)*nx_block ! ( 0,+1) + enddo + + !-- Find number of points needed for finite difference calculations + call union(Iin, Iee,na,na,util1,i) + call union(util1,Ine, i,na,util2,j) + call union(util2,Ise, j,na,util1,i) + call union(util1,Inw, i,na,util2,j) + call union(util2,Isw, j,na,util1,i) + call union(util1,Isse,i,na,util2,navel) + + !-- Check bounds + do iw=1,navel + if (util2(iw)>nx_block*ny_block .or. util2(iw)<1) then + write(nu_diag,*) subname,' nx_block,ny_block,nx_block*ny_block: ',nx_block,ny_block,nx_block*ny_block + write(nu_diag,*) subname,' na,navel,iw,util2(iw): ',na,navel,iw,util2(iw) + call abort_ice(subname//': Problem with boundary. Check halo zone values') + endif + enddo + + end subroutine calc_navel + +!---------------------------------------------------------------------------- + + subroutine convert_2d_1d_v2(nx,ny, na,navel, & + I_HTE,I_HTN, & +!v1 I_dxhy,I_dyhx,I_cyp,I_cxp,I_cym,I_cxm,I_tinyarea, & +!v1 I_waterx,I_watery, & + I_cdn_ocn,I_aiu,I_uocn,I_vocn,I_forcex,I_forcey,I_Tbu, & + I_umassdti,I_fm,I_uarear,I_tarear,I_strintx,I_strinty, & + I_uvel_init,I_vvel_init, & + I_strength,I_uvel,I_vvel,I_dxt,I_dyt, & + I_stressp_1 ,I_stressp_2, I_stressp_3, I_stressp_4, & + I_stressm_1 ,I_stressm_2, I_stressm_3, I_stressm_4, & + I_stress12_1,I_stress12_2,I_stress12_3,I_stress12_4 ) + + implicit none + + integer(int_kind),intent(in) :: nx,ny,na,navel + real (kind=dbl_kind), dimension(nx,ny), intent(in) :: & + I_HTE,I_HTN, & +!v1 I_dxhy,I_dyhx,I_cyp,I_cxp,I_cym,I_cxm,I_tinyarea, & +!v1 I_waterx,I_watery, & + I_cdn_ocn,I_aiu,I_uocn,I_vocn,I_forcex,I_forcey,I_Tbu, & + I_umassdti,I_fm,I_uarear,I_tarear,I_strintx,I_strinty, & + I_uvel_init,I_vvel_init, & + I_strength,I_uvel,I_vvel,I_dxt,I_dyt, & + I_stressp_1 ,I_stressp_2, I_stressp_3, I_stressp_4, & + I_stressm_1 ,I_stressm_2, I_stressm_3, I_stressm_4, & + I_stress12_1,I_stress12_2,I_stress12_3,I_stress12_4 + + integer(int_kind) :: iw,i,j, nx_block + integer(int_kind),dimension(1:na) :: Iin,Iee,Ine,Ise,Inw,Isw,Isse + integer(int_kind),dimension(1:7*na) :: util1,util2 + integer(int_kind) :: nachk + + character(len=*), parameter :: subname = '(convert_2d_1d_v2)' + + !--------------------------------------- + ! Additional indices used for finite differences (FD) + nx_block=nx ! Total block size in x-dir + do iw=1,na + i=indi(iw) + j=indj(iw) + Iin(iw) = i + (j-1)*nx_block ! ( 0, 0) Target point + Iee(iw) = i-1 + (j-1)*nx_block ! (-1, 0) + Ine(iw) = i-1 + (j-2)*nx_block ! (-1,-1) + Ise(iw) = i + (j-2)*nx_block ! ( 0,-1) + Inw(iw) = i+1 + (j-1)*nx_block ! (+1, 0) + Isw(iw) = i+1 + (j-0)*nx_block ! (+1,+1) + Isse(iw)= i + (j-0)*nx_block ! ( 0,+1) + enddo + + !-- Find number of points needed for finite difference calculations + call union(Iin, Iee,na,na,util1,i) + call union(util1,Ine, i,na,util2,j) + call union(util2,Ise, j,na,util1,i) + call union(util1,Inw, i,na,util2,j) + call union(util2,Isw, j,na,util1,i) + call union(util1,Isse,i,na,util2,nachk) + + if (nachk .ne. navel) then + write(nu_diag,*) subname,' ERROR: navel badly chosen: na,navel,nachk = ',na,navel,nachk + call abort_ice(subname//': ERROR: navel badly chosen') + endif + + ! indij: vector with target points (sorted) ... + do iw=1,na + indij(iw)=Iin(iw) + enddo + + ! indij: ... followed by extra points (sorted) + call setdiff(util2,Iin,navel,na,util1,j) + do iw=na+1,navel + indij(iw)=util1(iw-na) + enddo + + !-- Create indices for additional points needed for uvel,vvel: + call findXinY(Iee ,indij,na,navel, ee) + call findXinY(Ine ,indij,na,navel, ne) + call findXinY(Ise ,indij,na,navel, se) + call findXinY(Inw ,indij,na,navel, nw) + call findXinY(Isw ,indij,na,navel, sw) + call findXinY(Isse,indij,na,navel,sse) + + !-- write check +!if (1 == 2) then +! write(nu_diag,*) subname,' MHRI: INDICES start:' +! write(nu_diag,*) 'Min/max ee', minval(ee), maxval(ee) +! write(nu_diag,*) 'Min/max ne', minval(ne), maxval(ne) +! write(nu_diag,*) 'Min/max se', minval(se), maxval(se) +! write(nu_diag,*) 'Min/max nw', minval(nw), maxval(nw) +! write(nu_diag,*) 'Min/max sw', minval(sw), maxval(sw) +! write(nu_diag,*) 'Min/max sse',minval(sse),maxval(sse) +! write(nu_diag,*) subname,' MHRI: INDICES end:' +!endif + + ! Write 1D data from 2D: Here only extra FD part, the rest follows... + !$OMP PARALLEL DO PRIVATE(iw,i,j) + do iw=na+1,navel + j=int((indij(iw)-1)/(nx_block))+1 + i=indij(iw)-(j-1)*nx_block + uvel(iw)= I_uvel(i,j) + vvel(iw)= I_vvel(i,j) + enddo + !$OMP END PARALLEL DO + + ! Write 1D data from 2D + !$OMP PARALLEL DO PRIVATE(iw,i,j) + do iw=1,na + i=indi(iw) + j=indj(iw) + uvel(iw)= I_uvel(i,j) + vvel(iw)= I_vvel(i,j) + cdn_ocn(iw)= I_cdn_ocn(i,j) + aiu(iw)= I_aiu(i,j) + uocn(iw)= I_uocn(i,j) + vocn(iw)= I_vocn(i,j) + forcex(iw)= I_forcex(i,j) + forcey(iw)= I_forcey(i,j) + Tbu(iw)= I_Tbu(i,j) + umassdti(iw)= I_umassdti(i,j) + fm(iw)= I_fm(i,j) + tarear(iw)= I_tarear(i,j) + uarear(iw)= I_uarear(i,j) + strintx(iw)= I_strintx(i,j) + strinty(iw)= I_strinty(i,j) + uvel_init(iw)= I_uvel_init(i,j) + vvel_init(iw)= I_vvel_init(i,j) + strength(iw)= I_strength(i,j) + dxt(iw)= I_dxt(i,j) + dyt(iw)= I_dyt(i,j) + stressp_1(iw)= I_stressp_1(i,j) + stressp_2(iw)= I_stressp_2(i,j) + stressp_3(iw)= I_stressp_3(i,j) + stressp_4(iw)= I_stressp_4(i,j) + stressm_1(iw)= I_stressm_1(i,j) + stressm_2(iw)= I_stressm_2(i,j) + stressm_3(iw)= I_stressm_3(i,j) + stressm_4(iw)= I_stressm_4(i,j) + stress12_1(iw)=I_stress12_1(i,j) + stress12_2(iw)=I_stress12_2(i,j) + stress12_3(iw)=I_stress12_3(i,j) + stress12_4(iw)=I_stress12_4(i,j) +!v1 dxhy(iw)= I_dxhy(i,j) +!v1 dyhx(iw)= I_dyhx(i,j) +!v1 cyp(iw)= I_cyp(i,j) +!v1 cxp(iw)= I_cxp(i,j) +!v1 cym(iw)= I_cym(i,j) +!v1 cxm(iw)= I_cxm(i,j) +!v1 tinyarea(iw)= I_tinyarea(i,j) +!v1 waterx(iw)= I_waterx(i,j) +!v1 watery(iw)= I_watery(i,j) + HTE(iw) = I_HTE(i,j) + HTN(iw) = I_HTN(i,j) + HTEm1(iw) = I_HTE(i-1,j) + HTNm1(iw) = I_HTN(i,j-1) + enddo + !$OMP END PARALLEL DO + + end subroutine convert_2d_1d_v2 + +!---------------------------------------------------------------------------- + + subroutine calc_halo_parent(nx,ny,na,navel, I_icetmask) + + implicit none + + integer(kind=int_kind),intent(in) :: nx,ny,na,navel + integer(kind=int_kind), dimension(nx,ny), intent(in) :: I_icetmask + + integer(kind=int_kind) :: iw,i,j !,masku,maskt + integer(kind=int_kind),dimension(1:navel) :: Ihalo + + character(len=*), parameter :: subname = '(calc_halo_parent)' + + !--------------------------------------- + ! Indices for halo update: + ! 0: no halo point + ! >0: index for halo point parent. Finally related to indij vector + ! TODO: ONLY for nghost==1 + ! TODO: ONLY for circular grids - NOT tripole grids + + Ihalo(:)=0 + halo_parent(:)=0 + + !$OMP PARALLEL DO PRIVATE(iw,i,j) + do iw=1,navel + j=int((indij(iw)-1)/(nx))+1 + i=indij(iw)-(j-1)*nx + ! If within ghost-zone: + if (i==nx .and. I_icetmask( 2,j)==1) Ihalo(iw)= 2+ (j-1)*nx + if (i==1 .and. I_icetmask(nx-1,j)==1) Ihalo(iw)=(nx-1)+ (j-1)*nx + if (j==ny .and. I_icetmask(i, 2)==1) Ihalo(iw)= i+ nx + if (j==1 .and. I_icetmask(i,ny-1)==1) Ihalo(iw)= i+(ny-2)*nx + enddo + !$OMP END PARALLEL DO + + ! Relate halo indices to indij vector + call findXinY_halo(Ihalo,indij,navel,navel,halo_parent) + + !-- write check +!if (1 == 1) then +! integer(kind=int_kind) :: iiw,ii,jj !,masku,maskt MHRI +! write(nu_diag,*) subname,' MHRI: halo boundary start:' +! do iw=1,navel +! if (halo_parent(iw)>0) then +! iiw=halo_parent(iw) +! j=int((indij(iiw)-1)/(nx))+1 +! i=indij(iiw)-(j-1)*nx +! ii=i +! jj=j +! j=int((indij(iw)-1)/(nx))+1 +! i=indij(iw)-(j-1)*nx +! write(nu_diag,*)iw,i,j,iiw,ii,jj +! endif +! enddo +! write(nu_diag,*) subname,' MHRI: halo boundary end:' +!endif + + end subroutine calc_halo_parent + +!---------------------------------------------------------------------------- + + subroutine union(x,y,nx,ny,xy,nxy) + ! Find union (xy) of two sorted integer vectors (x and y) + ! ie. Combined values of the two vectors with no repetitions. + !use ice_kinds_mod + + implicit none + + integer (int_kind) :: i,j,k + integer (int_kind),intent(in) :: nx,ny + integer (int_kind),intent(in) :: x(1:nx),y(1:ny) + integer (int_kind),intent(out) :: xy(1:nx+ny) + integer (int_kind),intent(out) :: nxy + + character(len=*), parameter :: subname = '(union)' + + !--------------------------------------- + + i=1 + j=1 + k=1 + do while (i<=nx .and. j<=ny) + if (x(i)y(j)) then + xy(k)=y(j) + j=j+1 + else !if (x(i)==y(j)) then + xy(k)=x(i) + i=i+1 + j=j+1 + endif + k=k+1 + enddo + + ! The rest + do while (i<=nx) + xy(k)=x(i) + i=i+1 + k=k+1 + enddo + do while (j<=ny) + xy(k)=y(j) + j=j+1 + k=k+1 + enddo + nxy=k-1 + + end subroutine union + +!---------------------------------------------------------------------------- + + subroutine setdiff(x,y,nx,ny,xy,nxy) + ! Find element (xy) of two sorted integer vectors (x and y) + ! that are in x, but not in y ... or in y, but not in x + !use ice_kinds_mod + + implicit none + + integer (int_kind) :: i,j,k + integer (int_kind),intent(in) :: nx,ny + integer (int_kind),intent(in) :: x(1:nx),y(1:ny) + integer (int_kind),intent(out) :: xy(1:nx+ny) + integer (int_kind),intent(out) :: nxy + + character(len=*), parameter :: subname = '(setdiff)' + !--------------------------------------- + + i=1 + j=1 + k=1 + do while (i<=nx .and. j<=ny) + if (x(i)y(j)) then + xy(k)=y(j) + j=j+1 + k=k+1 + else !if (x(i)==y(j)) then + i=i+1 + j=j+1 + endif + enddo + + ! The rest + do while (i<=nx) + xy(k)=x(i) + i=i+1 + k=k+1 + enddo + do while (j<=ny) + xy(k)=y(j) + j=j+1 + k=k+1 + enddo + nxy=k-1 + + end subroutine setdiff + +!---------------------------------------------------------------------------- + + subroutine findXinY(x,y,nx,ny,indx) + ! Find indx vector so that x(1:na)=y(indx(1:na)) + ! + ! Conditions: + ! * EVERY item in x is found in y. + ! * x(1:nx) is a sorted integer vector. + ! * y(1:ny) consists of two sorted integer vectors: + ! [y(1:nx) ; y(nx+1:ny)] + ! * ny>=nx + ! Return: indx(1:na) + ! + !use ice_kinds_mod + + implicit none + + integer (int_kind),intent(in) :: nx,ny + integer (int_kind),intent(in) :: x(1:nx),y(1:ny) + integer (int_kind),intent(out) :: indx(1:nx) + integer (int_kind) :: i,j1,j2 + + character(len=*), parameter :: subname = '(findXinY)' + !--------------------------------------- + + i=1 + j1=1 + j2=nx+1 + do while (i<=nx) + if (x(i)==y(j1)) then + indx(i)=j1 + i=i+1 + j1=j1+1 + else if (x(i)==y(j2)) then + indx(i)=j2 + i=i+1 + j2=j2+1 + else if (x(i)>y(j1) ) then !.and. j1y(j2) ) then !.and. j2=nx + ! Return: indx(1:na) + ! + !use ice_kinds_mod + + implicit none + + integer (int_kind),intent(in) :: nx,ny + integer (int_kind),intent(in) :: x(1:nx),y(1:ny) + integer (int_kind),intent(out) :: indx(1:nx) + integer (int_kind) :: i,j1,nloop + + character(len=*), parameter :: subname = '(findXinY_halo)' + !--------------------------------------- + + nloop=1 + i=1 + j1=int((ny+1)/2) ! initial guess in the middle + do while (i<=nx) + if (x(i)==0) then + indx(i)=0 + i=i+1 + nloop=1 + else if (x(i)==y(j1)) then + indx(i)=j1 + i=i+1 + j1=j1+1 + if (j1>ny) j1=int((ny+1)/2) ! initial guess in the middle + nloop=1 + else if (x(i)y(j1) ) then + j1=j1+1 + if (j1>ny) then + j1=1 + nloop=nloop+1 + if (nloop>2) then + ! Stop for inf. loop. This check should not be necessary for halo + write(nu_diag,*) subname,' nx,ny: ',nx,ny + write(nu_diag,*) subname,' i,j1: ',i,j1 + write(nu_diag,*) subname,' x(i),y(j1): ',x(i),y(j1) + call abort_ice(subname//': ERROR too many loops') + endif + endif + endif + end do + + end subroutine findXinY_halo + +!---------------------------------------------------------------------------- + + subroutine numainit(l,u,uu) + + use ice_constants, only: c0 + + implicit none + + integer(kind=int_kind),intent(in) :: l,u,uu + + integer(kind=int_kind) :: lo,up + + character(len=*), parameter :: subname = '(numainit)' + !--------------------------------------- + + call domp_get_domain(l,u,lo,up) + ee(lo:up)=0 + ne(lo:up)=0 + se(lo:up)=0 + sse(lo:up)=0 + nw(lo:up)=0 + sw(lo:up)=0 + halo_parent(lo:up)=0 + strength(lo:up)=c0 + uvel(lo:up)=c0 + vvel(lo:up)=c0 + uvel_init(lo:up)=c0 + vvel_init(lo:up)=c0 + uocn(lo:up)=c0 + vocn(lo:up)=c0 + dxt(lo:up)=c0 + dyt(lo:up)=c0 + HTE(lo:up)=c0 + HTN(lo:up)=c0 + HTEm1(lo:up)=c0 + HTNm1(lo:up)=c0 +!v1 dxhy(lo:up)=c0 +!v1 dyhx(lo:up)=c0 +!v1 cyp(lo:up)=c0 +!v1 cxp(lo:up)=c0 +!v1 cym(lo:up)=c0 +!v1 cxm(lo:up)=c0 +!v1 tinyarea(lo:up)=c0 + stressp_1(lo:up)=c0 + stressp_2(lo:up)=c0 + stressp_3(lo:up)=c0 + stressp_4(lo:up)=c0 + stressm_1(lo:up)=c0 + stressm_2(lo:up)=c0 + stressm_3(lo:up)=c0 + stressm_4(lo:up)=c0 + stress12_1(lo:up)=c0 + stress12_2(lo:up)=c0 + stress12_3(lo:up)=c0 + stress12_4(lo:up)=c0 + tarear(lo:up)=c0 + Tbu(lo:up)=c0 + taubx(lo:up)=c0 + tauby(lo:up)=c0 + divu(lo:up)=c0 + rdg_conv(lo:up)=c0 + rdg_shear(lo:up)=c0 + shear(lo:up)=c0 + str1(lo:up)=c0 + str2(lo:up)=c0 + str3(lo:up)=c0 + str4(lo:up)=c0 + str5(lo:up)=c0 + str6(lo:up)=c0 + str7(lo:up)=c0 + str8(lo:up)=c0 + call domp_get_domain(u+1,uu,lo,up) + halo_parent(lo:up)=0 + uvel(lo:up)=c0 + vvel(lo:up)=c0 + str1(lo:up)=c0 + str2(lo:up)=c0 + str3(lo:up)=c0 + str4(lo:up)=c0 + str5(lo:up)=c0 + str6(lo:up)=c0 + str7(lo:up)=c0 + str8(lo:up)=c0 + + end subroutine numainit + +!---------------------------------------------------------------------------- +!=============================================================================== + +end module ice_dyn_evp_1d + diff --git a/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 b/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 index c3dc83a24..d9a0919e6 100644 --- a/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 +++ b/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 @@ -22,9 +22,10 @@ module ice_dyn_shared implicit none private - public :: init_evp, set_evp_parameters, stepu, principal_stress, & + public :: init_dyn, set_evp_parameters, stepu, principal_stress, & dyn_prep1, dyn_prep2, dyn_finish, basal_stress_coeff, & - alloc_dyn_shared + alloc_dyn_shared, deformations, strain_rates, & + stack_velocity_field, unstack_velocity_field ! namelist parameters @@ -78,7 +79,7 @@ module ice_dyn_shared real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & uvel_init, & ! x-component of velocity (m/s), beginning of timestep vvel_init ! y-component of velocity (m/s), beginning of timestep - + ! ice isotropic tensile strength parameter real (kind=dbl_kind), public :: & Ktens ! T=Ktens*P (tensile strength: see Konig and Holland, 2010) @@ -91,9 +92,9 @@ module ice_dyn_shared k1, & ! 1st free parameter for landfast parameterization k2, & ! second free parameter (N/m^3) for landfast parametrization alphab, & ! alphab=Cb factor in Lemieux et al 2015 - threshold_hw ! max water depth for grounding - ! see keel data from Amundrud et al. 2004 (JGR) - + threshold_hw, & ! max water depth for grounding + ! see keel data from Amundrud et al. 2004 (JGR) + u0 = 5e-5_dbl_kind ! residual velocity for basal stress (m/s) !======================================================================= @@ -117,10 +118,10 @@ end subroutine alloc_dyn_shared !======================================================================= -! Initialize parameters and variables needed for the evp dynamics +! Initialize parameters and variables needed for the dynamics ! author: Elizabeth C. Hunke, LANL - subroutine init_evp (dt) + subroutine init_dyn (dt) use ice_blocks, only: nx_block, ny_block use ice_domain, only: nblocks @@ -141,7 +142,7 @@ subroutine init_evp (dt) i, j, & iblk ! block index - character(len=*), parameter :: subname = '(init_evp)' + character(len=*), parameter :: subname = '(init_dyn)' call set_evp_parameters (dt) @@ -199,7 +200,7 @@ subroutine init_evp (dt) enddo ! iblk !$OMP END PARALLEL DO - end subroutine init_evp + end subroutine init_dyn !======================================================================= @@ -690,9 +691,6 @@ subroutine stepu (nx_block, ny_block, & Cb , & ! complete basal stress coeff rhow ! - real (kind=dbl_kind) :: & - u0 = 5e-5_dbl_kind ! residual velocity for basal stress (m/s) - character(len=*), parameter :: subname = '(stepu)' !----------------------------------------------------------------- @@ -993,6 +991,262 @@ end subroutine principal_stress !======================================================================= +! Compute deformations for mechanical redistribution +! +! author: Elizabeth C. Hunke, LANL +! +! 2019: subroutine created by Philippe Blain, ECCC + + subroutine deformations (nx_block, ny_block, & + icellt, & + indxti, indxtj, & + uvel, vvel, & + dxt, dyt, & + cxp, cyp, & + cxm, cym, & + tarear, & + shear, divu, & + rdg_conv, rdg_shear ) + + use ice_constants, only: p25, p5 + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellt ! no. of cells where icetmask = 1 + + integer (kind=int_kind), dimension (nx_block*ny_block), & + intent(in) :: & + indxti , & ! compressed index in i-direction + indxtj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + uvel , & ! x-component of velocity (m/s) + vvel , & ! y-component of velocity (m/s) + dxt , & ! width of T-cell through the middle (m) + dyt , & ! height of T-cell through the middle (m) + cyp , & ! 1.5*HTE - 0.5*HTE + cxp , & ! 1.5*HTN - 0.5*HTN + cym , & ! 0.5*HTE - 1.5*HTE + cxm , & ! 0.5*HTN - 1.5*HTN + tarear ! 1/tarea + + real (kind=dbl_kind), dimension (nx_block,ny_block), & + intent(inout) :: & + shear , & ! strain rate II component (1/s) + divu , & ! strain rate I component, velocity divergence (1/s) + rdg_conv , & ! convergence term for ridging (1/s) + rdg_shear ! shear term for ridging (1/s) + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij + + real (kind=dbl_kind) :: & ! at each corner : + divune, divunw, divuse, divusw , & ! divergence + tensionne, tensionnw, tensionse, tensionsw, & ! tension + shearne, shearnw, shearse, shearsw , & ! shearing + Deltane, Deltanw, Deltase, Deltasw , & ! Delta + tmp ! useful combination + + character(len=*), parameter :: subname = '(deformations)' + + do ij = 1, icellt + i = indxti(ij) + j = indxtj(ij) + + !----------------------------------------------------------------- + ! strain rates + ! NOTE these are actually strain rates * area (m^2/s) + !----------------------------------------------------------------- + call strain_rates (nx_block, ny_block, & + i, j, & + uvel, vvel, & + dxt, dyt, & + cxp, cyp, & + cxm, cym, & + divune, divunw, & + divuse, divusw, & + tensionne, tensionnw, & + tensionse, tensionsw, & + shearne, shearnw, & + shearse, shearsw, & + Deltane, Deltanw, & + Deltase, Deltasw ) + !----------------------------------------------------------------- + ! deformations for mechanical redistribution + !----------------------------------------------------------------- + divu(i,j) = p25*(divune + divunw + divuse + divusw) * tarear(i,j) + tmp = p25*(Deltane + Deltanw + Deltase + Deltasw) * tarear(i,j) + rdg_conv(i,j) = -min(divu(i,j),c0) + rdg_shear(i,j) = p5*(tmp-abs(divu(i,j))) + + ! diagnostic only + ! shear = sqrt(tension**2 + shearing**2) + shear(i,j) = p25*tarear(i,j)*sqrt( & + (tensionne + tensionnw + tensionse + tensionsw)**2 + & + (shearne + shearnw + shearse + shearsw )**2) + + enddo ! ij + + end subroutine deformations + +!======================================================================= + +! Compute strain rates +! +! author: Elizabeth C. Hunke, LANL +! +! 2019: subroutine created by Philippe Blain, ECCC + + subroutine strain_rates (nx_block, ny_block, & + i, j, & + uvel, vvel, & + dxt, dyt, & + cxp, cyp, & + cxm, cym, & + divune, divunw, & + divuse, divusw, & + tensionne, tensionnw, & + tensionse, tensionsw, & + shearne, shearnw, & + shearse, shearsw, & + Deltane, Deltanw, & + Deltase, Deltasw ) + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block ! block dimensions + + integer (kind=int_kind) :: & + i, j ! indices + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + uvel , & ! x-component of velocity (m/s) + vvel , & ! y-component of velocity (m/s) + dxt , & ! width of T-cell through the middle (m) + dyt , & ! height of T-cell through the middle (m) + cyp , & ! 1.5*HTE - 0.5*HTE + cxp , & ! 1.5*HTN - 0.5*HTN + cym , & ! 0.5*HTE - 1.5*HTE + cxm ! 0.5*HTN - 1.5*HTN + + real (kind=dbl_kind), intent(out):: & ! at each corner : + divune, divunw, divuse, divusw , & ! divergence + tensionne, tensionnw, tensionse, tensionsw, & ! tension + shearne, shearnw, shearse, shearsw , & ! shearing + Deltane, Deltanw, Deltase, Deltasw ! Delta + + character(len=*), parameter :: subname = '(strain_rates)' + + !----------------------------------------------------------------- + ! strain rates + ! NOTE these are actually strain rates * area (m^2/s) + !----------------------------------------------------------------- + + ! divergence = e_11 + e_22 + divune = cyp(i,j)*uvel(i ,j ) - dyt(i,j)*uvel(i-1,j ) & + + cxp(i,j)*vvel(i ,j ) - dxt(i,j)*vvel(i ,j-1) + divunw = cym(i,j)*uvel(i-1,j ) + dyt(i,j)*uvel(i ,j ) & + + cxp(i,j)*vvel(i-1,j ) - dxt(i,j)*vvel(i-1,j-1) + divusw = cym(i,j)*uvel(i-1,j-1) + dyt(i,j)*uvel(i ,j-1) & + + cxm(i,j)*vvel(i-1,j-1) + dxt(i,j)*vvel(i-1,j ) + divuse = cyp(i,j)*uvel(i ,j-1) - dyt(i,j)*uvel(i-1,j-1) & + + cxm(i,j)*vvel(i ,j-1) + dxt(i,j)*vvel(i ,j ) + + ! tension strain rate = e_11 - e_22 + tensionne = -cym(i,j)*uvel(i ,j ) - dyt(i,j)*uvel(i-1,j ) & + + cxm(i,j)*vvel(i ,j ) + dxt(i,j)*vvel(i ,j-1) + tensionnw = -cyp(i,j)*uvel(i-1,j ) + dyt(i,j)*uvel(i ,j ) & + + cxm(i,j)*vvel(i-1,j ) + dxt(i,j)*vvel(i-1,j-1) + tensionsw = -cyp(i,j)*uvel(i-1,j-1) + dyt(i,j)*uvel(i ,j-1) & + + cxp(i,j)*vvel(i-1,j-1) - dxt(i,j)*vvel(i-1,j ) + tensionse = -cym(i,j)*uvel(i ,j-1) - dyt(i,j)*uvel(i-1,j-1) & + + cxp(i,j)*vvel(i ,j-1) - dxt(i,j)*vvel(i ,j ) + + ! shearing strain rate = 2*e_12 + shearne = -cym(i,j)*vvel(i ,j ) - dyt(i,j)*vvel(i-1,j ) & + - cxm(i,j)*uvel(i ,j ) - dxt(i,j)*uvel(i ,j-1) + shearnw = -cyp(i,j)*vvel(i-1,j ) + dyt(i,j)*vvel(i ,j ) & + - cxm(i,j)*uvel(i-1,j ) - dxt(i,j)*uvel(i-1,j-1) + shearsw = -cyp(i,j)*vvel(i-1,j-1) + dyt(i,j)*vvel(i ,j-1) & + - cxp(i,j)*uvel(i-1,j-1) + dxt(i,j)*uvel(i-1,j ) + shearse = -cym(i,j)*vvel(i ,j-1) - dyt(i,j)*vvel(i-1,j-1) & + - cxp(i,j)*uvel(i ,j-1) + dxt(i,j)*uvel(i ,j ) + + ! Delta (in the denominator of zeta, eta) + Deltane = sqrt(divune**2 + ecci*(tensionne**2 + shearne**2)) + Deltanw = sqrt(divunw**2 + ecci*(tensionnw**2 + shearnw**2)) + Deltasw = sqrt(divusw**2 + ecci*(tensionsw**2 + shearsw**2)) + Deltase = sqrt(divuse**2 + ecci*(tensionse**2 + shearse**2)) + + end subroutine strain_rates + +!======================================================================= + +! Load velocity components into array for boundary updates + + subroutine stack_velocity_field(uvel, vvel, fld2) + + use ice_domain, only: nblocks + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), intent(in) :: & + uvel , & ! u components of velocity vector + vvel ! v components of velocity vector + + real (kind=dbl_kind), dimension (nx_block,ny_block,2,max_blocks), intent(out) :: & + fld2 ! work array for boundary updates + + ! local variables + + integer (kind=int_kind) :: & + iblk ! block index + + character(len=*), parameter :: subname = '(stack_velocity_field)' + + ! load velocity into array for boundary updates + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + fld2(:,:,1,iblk) = uvel(:,:,iblk) + fld2(:,:,2,iblk) = vvel(:,:,iblk) + enddo + !$OMP END PARALLEL DO + + end subroutine stack_velocity_field + +!======================================================================= + +! Unload velocity components from array after boundary updates + + subroutine unstack_velocity_field(fld2, uvel, vvel) + + use ice_domain, only: nblocks + + real (kind=dbl_kind), dimension (nx_block,ny_block,2,max_blocks), intent(in) :: & + fld2 ! work array for boundary updates + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), intent(out) :: & + uvel , & ! u components of velocity vector + vvel ! v components of velocity vector + + ! local variables + + integer (kind=int_kind) :: & + iblk ! block index + + character(len=*), parameter :: subname = '(unstack_velocity_field)' + + ! Unload velocity from array after boundary updates + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + uvel(:,:,iblk) = fld2(:,:,1,iblk) + vvel(:,:,iblk) = fld2(:,:,2,iblk) + enddo + !$OMP END PARALLEL DO + + end subroutine unstack_velocity_field + +!======================================================================= + end module ice_dyn_shared !======================================================================= diff --git a/cicecore/cicedynB/dynamics/ice_dyn_vp.F90 b/cicecore/cicedynB/dynamics/ice_dyn_vp.F90 new file mode 100644 index 000000000..570e202c2 --- /dev/null +++ b/cicecore/cicedynB/dynamics/ice_dyn_vp.F90 @@ -0,0 +1,3689 @@ +!======================================================================= +! +! Viscous-plastic sea ice dynamics model +! Computes ice velocity and deformation +! +! See: +! +! Lemieux, J.‐F., Tremblay, B., Thomas, S., Sedláček, J., and Mysak, L. A. (2008), +! Using the preconditioned Generalized Minimum RESidual (GMRES) method to solve +! the sea‐ice momentum equation, J. Geophys. Res., 113, C10004, doi:10.1029/2007JC004680. +! +! Hibler, W. D., and Ackley, S. F. (1983), Numerical simulation of the Weddell Sea pack ice, +! J. Geophys. Res., 88( C5), 2873– 2887, doi:10.1029/JC088iC05p02873. +! +! Y. Saad. A Flexible Inner-Outer Preconditioned GMRES Algorithm. SIAM J. Sci. Comput., +! 14(2):461–469, 1993. URL: https://doi.org/10.1137/0914028, doi:10.1137/0914028. +! +! C. T. Kelley, Iterative Methods for Linear and Nonlinear Equations, SIAM, 1995. +! (https://www.siam.org/books/textbooks/fr16_book.pdf) +! +! Y. Saad, Iterative Methods for Sparse Linear Systems. SIAM, 2003. +! (http://www-users.cs.umn.edu/~saad/IterMethBook_2ndEd.pdf) +! +! Walker, H. F., & Ni, P. (2011). Anderson Acceleration for Fixed-Point Iterations. +! SIAM Journal on Numerical Analysis, 49(4), 1715–1735. https://doi.org/10.1137/10078356X +! +! Fang, H., & Saad, Y. (2009). Two classes of multisecant methods for nonlinear acceleration. +! Numerical Linear Algebra with Applications, 16(3), 197–221. https://doi.org/10.1002/nla.617 +! +! Birken, P. (2015) Termination criteria for inexact fixed‐point schemes. +! Numer. Linear Algebra Appl., 22: 702– 716. doi: 10.1002/nla.1982. +! +! authors: JF Lemieux, ECCC, Philppe Blain, ECCC +! + + module ice_dyn_vp + + use ice_kinds_mod + use ice_blocks, only: nx_block, ny_block + use ice_boundary, only: ice_halo + use ice_communicate, only: my_task, master_task, get_num_procs + 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, & + p222, p25, p333, p5, c1 + use ice_domain, only: nblocks, distrb_info + use ice_domain_size, only: max_blocks + use ice_dyn_shared, only: dyn_prep1, dyn_prep2, dyn_finish, & + ecci, cosw, sinw, fcor_blk, uvel_init, & + vvel_init, basal_stress_coeff, basalstress, Ktens, & + stack_velocity_field, unstack_velocity_field + use ice_fileunits, only: nu_diag + use ice_flux, only: fm + use ice_global_reductions, only: global_sum, global_allreduce_sum + use ice_grid, only: dxt, dyt, dxhy, dyhx, cxp, cyp, cxm, cym, uarear + use ice_exit, only: abort_ice + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + use icepack_intfc, only: icepack_ice_strength, icepack_query_parameters + + implicit none + private + public :: implicit_solver, init_vp + + ! namelist parameters + + integer (kind=int_kind), public :: & + maxits_nonlin , & ! max nb of iteration for nonlinear solver + dim_fgmres , & ! size of fgmres Krylov subspace + dim_pgmres , & ! size of pgmres Krylov subspace + maxits_fgmres , & ! max nb of iteration for fgmres + maxits_pgmres , & ! max nb of iteration for pgmres + fpfunc_andacc , & ! fixed point function for Anderson acceleration: 1: g(x) = FMGRES(A(x),b(x)), 2: g(x) = x - A(x)x + b(x) + dim_andacc , & ! size of Anderson minimization matrix (number of saved previous residuals) + start_andacc ! acceleration delay factor (acceleration starts at this iteration) + + logical (kind=log_kind), public :: & + monitor_nonlin , & ! print nonlinear residual norm + monitor_fgmres , & ! print fgmres residual norm + monitor_pgmres , & ! print pgmres residual norm + use_mean_vrel ! use mean of previous 2 iterates to compute vrel (see Hibler and Ackley 1983) + + real (kind=dbl_kind), public :: & + reltol_nonlin , & ! nonlinear stopping criterion: reltol_nonlin*res(k=0) + reltol_fgmres , & ! fgmres stopping criterion: reltol_fgmres*res(k) + reltol_pgmres , & ! pgmres stopping criterion: reltol_pgmres*res(k) + damping_andacc , & ! damping factor for Anderson acceleration + reltol_andacc ! relative tolerance for Anderson acceleration + + character (len=char_len), public :: & + precond , & ! preconditioner for fgmres: 'ident' (identity), 'diag' (diagonal), 'pgmres' (Jacobi-preconditioned GMRES) + algo_nonlin , & ! nonlinear algorithm: 'picard' (Picard iteration), 'anderson' (Anderson acceleration) + ortho_type ! type of orthogonalization for FGMRES ('cgs' or 'mgs') + + ! module variables + + integer (kind=int_kind), allocatable :: & + icellt(:) , & ! no. of cells where icetmask = 1 + icellu(:) ! no. of cells where iceumask = 1 + + integer (kind=int_kind), allocatable :: & + indxti(:,:) , & ! compressed index in i-direction + indxtj(:,:) , & ! compressed index in j-direction + indxui(:,:) , & ! compressed index in i-direction + indxuj(:,:) ! compressed index in j-direction + + real (kind=dbl_kind), allocatable :: & + fld2(:,:,:,:) ! work array for boundary updates + +!======================================================================= + + contains + +!======================================================================= + +! Initialize parameters and variables needed for the vp dynamics +! author: Philippe Blain, ECCC + + subroutine init_vp + + use ice_blocks, only: get_block, block + use ice_boundary, only: ice_HaloUpdate + use ice_constants, only: c1, & + field_loc_center, field_type_scalar + use ice_domain, only: blocks_ice, halo_info + use ice_grid, only: tarea, tinyarea + + ! local variables + + integer (kind=int_kind) :: & + i, j, iblk, & + ilo,ihi,jlo,jhi ! beginning and end of physical domain + + type (block) :: & + this_block ! block information for current block + + real (kind=dbl_kind) :: & + min_strain_rate = 2e-09_dbl_kind ! used for recomputing tinyarea + + ! Initialize module variables + allocate(icellt(max_blocks), icellu(max_blocks)) + allocate(indxti(nx_block*ny_block, max_blocks), & + indxtj(nx_block*ny_block, max_blocks), & + indxui(nx_block*ny_block, max_blocks), & + indxuj(nx_block*ny_block, max_blocks)) + allocate(fld2(nx_block,ny_block,2,max_blocks)) + + ! Redefine tinyarea using min_strain_rate + + !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + tinyarea(i,j,iblk) = min_strain_rate*tarea(i,j,iblk) + enddo + enddo + enddo ! iblk + !$OMP END PARALLEL DO + + call ice_HaloUpdate (tinyarea, halo_info, & + field_loc_center, field_type_scalar, & + fillValue=c1) + + end subroutine init_vp + +!======================================================================= + +! Viscous-plastic dynamics driver +! +#ifdef CICE_IN_NEMO +! Wind stress is set during this routine from the values supplied +! via NEMO (unless calc_strair is true). These values are supplied +! rotated on u grid and multiplied by aice. strairxT = 0 in this +! case so operations in dyn_prep1 are pointless but carried out to +! minimise code changes. +#endif +! +! author: JF Lemieux, A. Qaddouri and F. Dupont ECCC + + subroutine implicit_solver (dt) + + use ice_arrays_column, only: Cdn_ocn + use ice_boundary, only: ice_HaloMask, ice_HaloUpdate, & + ice_HaloDestroy, ice_HaloUpdate_stress + use ice_blocks, only: block, get_block, nx_block, ny_block + use ice_domain, only: blocks_ice, halo_info, maskhalo_dyn + use ice_domain_size, only: max_blocks, ncat + use ice_dyn_shared, only: deformations + use ice_flux, only: rdg_conv, rdg_shear, strairxT, strairyT, & + strairx, strairy, uocn, vocn, ss_tltx, ss_tlty, iceumask, fm, & + strtltx, strtlty, strocnx, strocny, strintx, strinty, taubx, tauby, & + strocnxT, strocnyT, strax, stray, & + Tbu, hwater, & + stressp_1, stressp_2, stressp_3, stressp_4, & + stressm_1, stressm_2, stressm_3, stressm_4, & + stress12_1, stress12_2, stress12_3, stress12_4 + use ice_grid, only: tmask, umask, dxt, dyt, cxp, cyp, cxm, cym, & + tarear, to_ugrid, t2ugrid_vector, u2tgrid_vector, & + grid_type + use ice_state, only: aice, vice, vsno, uvel, vvel, divu, shear, & + aice_init, aice0, aicen, vicen, strength + use ice_timers, only: timer_dynamics, timer_bound, & + ice_timer_start, ice_timer_stop + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + ! local variables + + integer (kind=int_kind) :: & + ntot , & ! size of problem for Anderson + iblk , & ! block index + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + i, j, ij + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & + tmass , & ! total mass of ice and snow (kg/m^2) + waterx , & ! for ocean stress calculation, x (m/s) + watery , & ! for ocean stress calculation, y (m/s) + forcex , & ! work array: combined atm stress and ocn tilt, x + forcey , & ! work array: combined atm stress and ocn tilt, y + bxfix , & ! part of bx that is constant during Picard + byfix , & ! part of by that is constant during Picard + Cb , & ! seabed stress coefficient + fpresx , & ! fixed point residual vector, x components: fx = uvel - uprev_k + fpresy , & ! fixed point residual vector, y components: fy = vvel - vprev_k + aiu , & ! ice fraction on u-grid + umass , & ! total mass of ice and snow (u grid) + umassdti ! mass of U-cell/dte (kg/m^2 s) + + real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks,4):: & + zetaD ! zetaD = 2zeta (viscous coeff) + + logical (kind=log_kind) :: calc_strair + + integer (kind=int_kind), dimension (nx_block,ny_block,max_blocks) :: & + icetmask, & ! ice extent mask (T-cell) + halomask ! generic halo mask + + type (ice_halo) :: & + halo_info_mask ! ghost cell update info for masked halo + + type (block) :: & + this_block ! block information for current block + + real (kind=dbl_kind), allocatable :: & + sol(:) ! solution vector + + character(len=*), parameter :: subname = '(implicit_solver)' + + call ice_timer_start(timer_dynamics) ! dynamics + + !----------------------------------------------------------------- + ! Initialize + !----------------------------------------------------------------- + + ! This call is needed only if dt changes during runtime. +! call set_evp_parameters (dt) + + !----------------------------------------------------------------- + ! boundary updates + ! commented out because the ghost cells are freshly + ! updated after cleanup_itd + !----------------------------------------------------------------- + +! call ice_timer_start(timer_bound) +! call ice_HaloUpdate (aice, halo_info, & +! field_loc_center, field_type_scalar) +! call ice_HaloUpdate (vice, halo_info, & +! field_loc_center, field_type_scalar) +! call ice_HaloUpdate (vsno, halo_info, & +! field_loc_center, field_type_scalar) +! call ice_timer_stop(timer_bound) + + !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) + do iblk = 1, nblocks + + do j = 1, ny_block + do i = 1, nx_block + rdg_conv (i,j,iblk) = c0 + rdg_shear(i,j,iblk) = c0 + divu (i,j,iblk) = c0 + shear(i,j,iblk) = c0 + enddo + enddo + + !----------------------------------------------------------------- + ! preparation for dynamics + !----------------------------------------------------------------- + + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + call dyn_prep1 (nx_block, ny_block, & + ilo, ihi, jlo, jhi, & + aice (:,:,iblk), vice (:,:,iblk), & + vsno (:,:,iblk), tmask (:,:,iblk), & + strairxT(:,:,iblk), strairyT(:,:,iblk), & + strairx (:,:,iblk), strairy (:,:,iblk), & + tmass (:,:,iblk), icetmask(:,:,iblk)) + + enddo ! iblk + !$OMP END PARALLEL DO + + call ice_timer_start(timer_bound) + call ice_HaloUpdate (icetmask, halo_info, & + field_loc_center, field_type_scalar) + call ice_timer_stop(timer_bound) + + !----------------------------------------------------------------- + ! convert fields from T to U grid + !----------------------------------------------------------------- + + call to_ugrid(tmass,umass) + call to_ugrid(aice_init, aiu) + + !---------------------------------------------------------------- + ! Set wind stress to values supplied via NEMO or other forcing + ! This wind stress is rotated on u grid and multiplied by aice + !---------------------------------------------------------------- + call icepack_query_parameters(calc_strair_out=calc_strair) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + if (.not. calc_strair) then + strairx(:,:,:) = strax(:,:,:) + strairy(:,:,:) = stray(:,:,:) + else + call t2ugrid_vector(strairx) + call t2ugrid_vector(strairy) + endif + +! tcraig, tcx, threading here leads to some non-reproducbile results and failures in icepack_ice_strength +! need to do more debugging + !$TCXOMP PARALLEL DO PRIVATE(iblk,ilo,ihi,jlo,jhi,this_block) + do iblk = 1, nblocks + + !----------------------------------------------------------------- + ! more preparation for dynamics + !----------------------------------------------------------------- + + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + call dyn_prep2 (nx_block, ny_block, & + ilo, ihi, jlo, jhi, & + icellt(iblk), icellu(iblk), & + indxti (:,iblk), indxtj (:,iblk), & + indxui (:,iblk), indxuj (:,iblk), & + aiu (:,:,iblk), umass (:,:,iblk), & + umassdti (:,:,iblk), fcor_blk (:,:,iblk), & + umask (:,:,iblk), & + uocn (:,:,iblk), vocn (:,:,iblk), & + strairx (:,:,iblk), strairy (:,:,iblk), & + ss_tltx (:,:,iblk), ss_tlty (:,:,iblk), & + icetmask (:,:,iblk), iceumask (:,:,iblk), & + fm (:,:,iblk), dt, & + strtltx (:,:,iblk), strtlty (:,:,iblk), & + strocnx (:,:,iblk), strocny (:,:,iblk), & + strintx (:,:,iblk), strinty (:,:,iblk), & + taubx (:,:,iblk), tauby (:,:,iblk), & + waterx (:,:,iblk), watery (:,:,iblk), & + forcex (:,:,iblk), forcey (:,:,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), & + uvel_init (:,:,iblk), vvel_init (:,:,iblk), & + uvel (:,:,iblk), vvel (:,:,iblk), & + Tbu (:,:,iblk)) + + call calc_bfix (nx_block , ny_block , & + icellu(iblk) , & + indxui (:,iblk), indxuj (:,iblk), & + umassdti (:,:,iblk), & + forcex (:,:,iblk), forcey (:,:,iblk), & + uvel_init (:,:,iblk), vvel_init (:,:,iblk), & + bxfix (:,:,iblk), byfix (:,:,iblk)) + + !----------------------------------------------------------------- + ! ice strength + !----------------------------------------------------------------- + + strength(:,:,iblk) = c0 ! initialize + do ij = 1, icellt(iblk) + i = indxti(ij, iblk) + j = indxtj(ij, iblk) + call icepack_ice_strength (ncat, & + aice (i,j, iblk), & + vice (i,j, iblk), & + aice0 (i,j, iblk), & + aicen (i,j,:,iblk), & + vicen (i,j,:,iblk), & + strength(i,j, iblk)) + enddo ! ij + + enddo ! iblk + !$TCXOMP END PARALLEL DO + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call ice_timer_start(timer_bound) + call ice_HaloUpdate (strength, halo_info, & + field_loc_center, field_type_scalar) + ! velocities may have changed in dyn_prep2 + call stack_velocity_field(uvel, vvel, fld2) + call ice_HaloUpdate (fld2, halo_info, & + field_loc_NEcorner, field_type_vector) + call unstack_velocity_field(fld2, uvel, vvel) + call ice_timer_stop(timer_bound) + + if (maskhalo_dyn) then + call ice_timer_start(timer_bound) + halomask = 0 + where (iceumask) halomask = 1 + call ice_HaloUpdate (halomask, halo_info, & + field_loc_center, field_type_scalar) + call ice_timer_stop(timer_bound) + call ice_HaloMask(halo_info_mask, halo_info, halomask) + endif + + !----------------------------------------------------------------- + ! basal stress coefficients (landfast ice) + !----------------------------------------------------------------- + + if (basalstress) then + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call basal_stress_coeff (nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj(:,iblk), & + vice (:,:,iblk), aice(:,:,iblk), & + hwater(:,:,iblk), Tbu (:,:,iblk)) + enddo + !$OMP END PARALLEL DO + endif + + !----------------------------------------------------------------- + ! calc size of problem (ntot) and allocate solution vector + !----------------------------------------------------------------- + + ntot = 0 + do iblk = 1, nblocks + ntot = ntot + icellu(iblk) + enddo + ntot = 2 * ntot ! times 2 because of u and v + + allocate(sol(ntot)) + + !----------------------------------------------------------------- + ! Start of nonlinear iteration + !----------------------------------------------------------------- + call anderson_solver (icellt , icellu, & + indxti , indxtj, & + indxui , indxuj, & + aiu , ntot , & + waterx , watery, & + bxfix , byfix , & + umassdti, sol , & + fpresx , fpresy, & + zetaD , Cb , & + halo_info_mask) + !----------------------------------------------------------------- + ! End of nonlinear iteration + !----------------------------------------------------------------- + + deallocate(sol) + + if (maskhalo_dyn) call ice_HaloDestroy(halo_info_mask) + + !----------------------------------------------------------------- + ! Compute stresses + !----------------------------------------------------------------- + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call stress_vp (nx_block , ny_block , & + icellt(iblk) , & + indxti (:,iblk), indxtj (:,iblk), & + uvel (:,:,iblk), vvel (:,:,iblk), & + dxt (:,:,iblk), dyt (:,:,iblk), & + cxp (:,:,iblk), cyp (:,:,iblk), & + cxm (:,:,iblk), cym (:,:,iblk), & + zetaD (:,:,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)) + enddo ! iblk + !$OMP END PARALLEL DO + + !----------------------------------------------------------------- + ! Compute deformations + !----------------------------------------------------------------- + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call deformations (nx_block , ny_block , & + icellt(iblk) , & + indxti (:,iblk), indxtj (:,iblk), & + uvel (:,:,iblk), vvel (:,:,iblk), & + dxt (:,:,iblk), dyt (:,:,iblk), & + cxp (:,:,iblk), cyp (:,:,iblk), & + cxm (:,:,iblk), cym (:,:,iblk), & + tarear (:,:,iblk), & + shear (:,:,iblk), divu (:,:,iblk), & + rdg_conv (:,:,iblk), rdg_shear (:,:,iblk)) + enddo + !$OMP END PARALLEL DO + + !----------------------------------------------------------------- + ! Compute seabed stress (diagnostic) + !----------------------------------------------------------------- + if (basalstress) then + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call calc_seabed_stress (nx_block , ny_block , & + icellu(iblk) , & + indxui (:,iblk), indxuj (:,iblk), & + uvel (:,:,iblk), vvel (:,:,iblk), & + Cb (:,:,iblk), & + taubx (:,:,iblk), tauby (:,:,iblk)) + enddo + !$OMP END PARALLEL DO + endif + + ! Force symmetry across the tripole seam + if (trim(grid_type) == 'tripole') then + if (maskhalo_dyn) then + !------------------------------------------------------- + ! set halomask to zero because ice_HaloMask always keeps + ! local copies AND tripole zipper communication + !------------------------------------------------------- + halomask = 0 + call ice_HaloMask(halo_info_mask, halo_info, halomask) + + call ice_HaloUpdate_stress(stressp_1, stressp_3, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressp_3, stressp_1, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressp_2, stressp_4, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressp_4, stressp_2, halo_info_mask, & + field_loc_center, field_type_scalar) + + call ice_HaloUpdate_stress(stressm_1, stressm_3, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressm_3, stressm_1, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressm_2, stressm_4, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressm_4, stressm_2, halo_info_mask, & + field_loc_center, field_type_scalar) + + call ice_HaloUpdate_stress(stress12_1, stress12_3, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stress12_3, stress12_1, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stress12_2, stress12_4, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stress12_4, stress12_2, halo_info_mask, & + field_loc_center, field_type_scalar) + + call ice_HaloDestroy(halo_info_mask) + else + call ice_HaloUpdate_stress(stressp_1, stressp_3, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressp_3, stressp_1, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressp_2, stressp_4, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressp_4, stressp_2, halo_info, & + field_loc_center, field_type_scalar) + + call ice_HaloUpdate_stress(stressm_1, stressm_3, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressm_3, stressm_1, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressm_2, stressm_4, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressm_4, stressm_2, halo_info, & + field_loc_center, field_type_scalar) + + call ice_HaloUpdate_stress(stress12_1, stress12_3, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stress12_3, stress12_1, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stress12_2, stress12_4, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stress12_4, stress12_2, halo_info, & + field_loc_center, field_type_scalar) + endif ! maskhalo + endif ! tripole + + !----------------------------------------------------------------- + ! ice-ocean stress + !----------------------------------------------------------------- + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + + call dyn_finish & + (nx_block, ny_block, & + icellu (iblk), Cdn_ocn (:,:,iblk), & + indxui (:,iblk), indxuj (:,iblk), & + uvel (:,:,iblk), vvel (:,:,iblk), & + uocn (:,:,iblk), vocn (:,:,iblk), & + aiu (:,:,iblk), fm (:,:,iblk), & + strintx (:,:,iblk), strinty (:,:,iblk), & + strairx (:,:,iblk), strairy (:,:,iblk), & + strocnx (:,:,iblk), strocny (:,:,iblk), & + strocnxT(:,:,iblk), strocnyT(:,:,iblk)) + + enddo + !$OMP END PARALLEL DO + + call u2tgrid_vector(strocnxT) ! shift + call u2tgrid_vector(strocnyT) + + call ice_timer_stop(timer_dynamics) ! dynamics + + end subroutine implicit_solver + +!======================================================================= + +! Solve the nonlinear equation F(u,v) = 0, where +! F(u,v) := A(u,v) * (u,v) - b(u,v) +! using Anderson acceleration (accelerated fixed point (Picard) iteration) +! +! author: JF Lemieux, A. Qaddouri, F. Dupont and P. Blain ECCC +! +! Anderson algorithm adadpted from: +! H. F. Walker, “Anderson Acceleration: Algorithms and Implementations” +! [Online]. Available: https://users.wpi.edu/~walker/Papers/anderson_accn_algs_imps.pdf + + subroutine anderson_solver (icellt , icellu, & + indxti , indxtj, & + indxui , indxuj, & + aiu , ntot , & + waterx , watery, & + bxfix , byfix , & + umassdti, sol , & + fpresx , fpresy, & + zetaD , Cb , & + halo_info_mask) + + use ice_arrays_column, only: Cdn_ocn + use ice_blocks, only: nx_block, ny_block + use ice_boundary, only: ice_HaloUpdate + use ice_constants, only: c1 + use ice_domain, only: maskhalo_dyn, halo_info + use ice_domain_size, only: max_blocks + use ice_flux, only: uocn, vocn, fm, Tbu + use ice_grid, only: dxt, dyt, dxhy, dyhx, cxp, cyp, cxm, cym, & + uarear, tinyarea + use ice_state, only: uvel, vvel, strength + use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound + + integer (kind=int_kind), intent(in) :: & + ntot ! size of problem for Anderson + + integer (kind=int_kind), dimension(max_blocks), intent(in) :: & + icellt , & ! no. of cells where icetmask = 1 + icellu ! no. of cells where iceumask = 1 + + integer (kind=int_kind), dimension (nx_block*ny_block, max_blocks), intent(in) :: & + indxti , & ! compressed index in i-direction + indxtj , & ! compressed index in j-direction + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), intent(in) :: & + aiu , & ! ice fraction on u-grid + waterx , & ! for ocean stress calculation, x (m/s) + watery , & ! for ocean stress calculation, y (m/s) + bxfix , & ! part of bx that is constant during Picard + byfix , & ! part of by that is constant during Picard + umassdti ! mass of U-cell/dte (kg/m^2 s) + + real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks,4), intent(out) :: & + zetaD ! zetaD = 2zeta (viscous coeff) + + type (ice_halo), intent(in) :: & + halo_info_mask ! ghost cell update info for masked halo + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), intent(inout) :: & + fpresx , & ! fixed point residual vector, x components: fx = uvel - uprev_k + fpresy , & ! fixed point residual vector, y components: fy = vvel - vprev_k + Cb ! seabed stress coefficient + + real (kind=dbl_kind), dimension (ntot), intent(inout) :: & + sol ! current approximate solution + + ! local variables + + integer (kind=int_kind) :: & + it_nl , & ! nonlinear loop iteration index + res_num , & ! current number of stored residuals + j , & ! iteration index for QR update + iblk , & ! block index + nbiter ! number of FGMRES iterations performed + + integer (kind=int_kind), parameter :: & + inc = 1 ! increment value for BLAS calls + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & + uprev_k , & ! uvel at previous Picard iteration + vprev_k , & ! vvel at previous Picard iteration + ulin , & ! uvel to linearize vrel + vlin , & ! vvel to linearize vrel + vrel , & ! coeff for tauw + bx , & ! b vector + by , & ! b vector + diagx , & ! Diagonal (x component) of the matrix A + diagy , & ! Diagonal (y component) of the matrix A + Au , & ! matvec, Fx = bx - Au + Av , & ! matvec, Fy = by - Av + Fx , & ! x residual vector, Fx = bx - Au + Fy , & ! y residual vector, Fy = by - Av + solx , & ! solution of FGMRES (x components) + soly ! solution of FGMRES (y components) + + real (kind=dbl_kind), dimension(nx_block,ny_block,8):: & + stress_Pr, & ! x,y-derivatives of the replacement pressure + diag_rheo ! contributions of the rhelogy term to the diagonal + + real (kind=dbl_kind), dimension (max_blocks) :: & + L2norm ! array used to compute l^2 norm of grid function + + real (kind=dbl_kind), dimension (ntot) :: & + res , & ! current residual + res_old , & ! previous residual + res_diff , & ! difference between current and previous residuals + fpfunc , & ! current value of fixed point function + fpfunc_old , & ! previous value of fixed point function + tmp ! temporary vector for BLAS calls + + real (kind=dbl_kind), dimension(ntot,dim_andacc) :: & + Q , & ! Q factor for QR factorization of F (residuals) matrix + G_diff ! Matrix containing the differences of g(x) (fixed point function) evaluations + + real (kind=dbl_kind), dimension(dim_andacc,dim_andacc) :: & + R ! R factor for QR factorization of F (residuals) matrix + + real (kind=dbl_kind), dimension(dim_andacc) :: & + rhs_tri , & ! right hand side vector for matrix-vector product + coeffs ! coeffs used to combine previous solutions + + real (kind=dbl_kind) :: & + ! tol , & ! tolerance for fixed point convergence: reltol_andacc * (initial fixed point residual norm) [unused for now] + tol_nl , & ! tolerance for nonlinear convergence: reltol_nonlin * (initial nonlinear residual norm) + fpres_norm , & ! norm of current fixed point residual : f(x) = g(x) - x + prog_norm , & ! norm of difference between current and previous solution + nlres_norm ! norm of current nonlinear residual : F(x) = A(x)x -b(x) + +#ifdef USE_LAPACK + real (kind=dbl_kind) :: & + ddot, dnrm2 ! external BLAS functions +#endif + + character(len=*), parameter :: subname = '(anderson_solver)' + + ! Initialization + res_num = 0 + L2norm = c0 + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + uprev_k(:,:,iblk) = uvel(:,:,iblk) + vprev_k(:,:,iblk) = vvel(:,:,iblk) + enddo + !$OMP END PARALLEL DO + + ! Start iterations + do it_nl = 0, maxits_nonlin ! nonlinear iteration loop + ! Compute quantities needed for computing PDE residual and g(x) (fixed point map) + !----------------------------------------------------------------- + ! Calc zetaD, dPr/dx, dPr/dy, Cb and vrel = f(uprev_k, vprev_k) + !----------------------------------------------------------------- + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + + if (use_mean_vrel) then + ulin(:,:,iblk) = p5*uprev_k(:,:,iblk) + p5*uvel(:,:,iblk) + vlin(:,:,iblk) = p5*vprev_k(:,:,iblk) + p5*vvel(:,:,iblk) + else + ulin(:,:,iblk) = uvel(:,:,iblk) + vlin(:,:,iblk) = vvel(:,:,iblk) + endif + uprev_k(:,:,iblk) = uvel(:,:,iblk) + vprev_k(:,:,iblk) = vvel(:,:,iblk) + + call calc_zeta_dPr (nx_block , ny_block , & + icellt (iblk), & + indxti (:,iblk), indxtj (:,iblk), & + uprev_k (:,:,iblk), vprev_k (:,:,iblk), & + dxt (:,:,iblk), dyt (:,:,iblk), & + dxhy (:,:,iblk), dyhx (:,:,iblk), & + cxp (:,:,iblk), cyp (:,:,iblk), & + cxm (:,:,iblk), cym (:,:,iblk), & + tinyarea (:,:,iblk), & + strength (:,:,iblk), zetaD (:,:,iblk,:), & + stress_Pr (:,:,:)) + + call calc_vrel_Cb (nx_block , ny_block , & + icellu (iblk), Cdn_ocn (:,:,iblk), & + indxui (:,iblk), indxuj (:,iblk), & + aiu (:,:,iblk), Tbu (:,:,iblk), & + uocn (:,:,iblk), vocn (:,:,iblk), & + ulin (:,:,iblk), vlin (:,:,iblk), & + vrel (:,:,iblk), Cb (:,:,iblk)) + + ! prepare b vector (RHS) + call calc_bvec (nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj (:,iblk), & + stress_Pr (:,:,:), uarear (:,:,iblk), & + waterx (:,:,iblk), watery (:,:,iblk), & + bxfix (:,:,iblk), byfix (:,:,iblk), & + bx (:,:,iblk), by (:,:,iblk), & + vrel (:,:,iblk)) + + ! Compute nonlinear residual norm (PDE residual) + call matvec (nx_block , ny_block , & + icellu (iblk) , icellt (iblk), & + indxui (:,iblk) , indxuj (:,iblk), & + indxti (:,iblk) , indxtj (:,iblk), & + dxt (:,:,iblk) , dyt (:,:,iblk), & + dxhy (:,:,iblk) , dyhx (:,:,iblk), & + cxp (:,:,iblk) , cyp (:,:,iblk), & + cxm (:,:,iblk) , cym (:,:,iblk), & + uprev_k (:,:,iblk) , vprev_k (:,:,iblk), & + vrel (:,:,iblk) , Cb (:,:,iblk), & + zetaD (:,:,iblk,:), & + umassdti (:,:,iblk) , fm (:,:,iblk), & + uarear (:,:,iblk) , & + Au (:,:,iblk) , Av (:,:,iblk)) + call residual_vec (nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj (:,iblk), & + bx (:,:,iblk), by (:,:,iblk), & + Au (:,:,iblk), Av (:,:,iblk), & + Fx (:,:,iblk), Fy (:,:,iblk), & + L2norm (iblk)) + enddo + !$OMP END PARALLEL DO + nlres_norm = sqrt(global_sum(sum(L2norm), distrb_info)) + if (my_task == master_task .and. monitor_nonlin) then + write(nu_diag, '(a,i4,a,d26.16)') "monitor_nonlin: iter_nonlin= ", it_nl, & + " nonlin_res_L2norm= ", nlres_norm + endif + ! Compute relative tolerance at first iteration + if (it_nl == 0) then + tol_nl = reltol_nonlin*nlres_norm + endif + + ! Check for nonlinear convergence + if (nlres_norm < tol_nl) then + exit + endif + + ! Put initial guess for FGMRES in solx,soly and sol (needed for anderson) + solx = uprev_k + soly = vprev_k + call arrays_to_vec (nx_block , ny_block , & + nblocks , max_blocks , & + icellu (:), ntot , & + indxui (:,:), indxuj (:,:), & + uprev_k (:,:,:), vprev_k (:,:,:), & + sol (:)) + + ! Compute fixed point map g(x) + if (fpfunc_andacc == 1) then + ! g_1(x) = FGMRES(A(x), b(x)) + + ! Prepare diagonal for preconditioner + if (precond == 'diag' .or. precond == 'pgmres') then + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + ! first compute diagonal contributions due to rheology term + call formDiag_step1 (nx_block , ny_block , & + icellu (iblk) , & + indxui (:,iblk) , indxuj(:,iblk), & + dxt (:,:,iblk) , dyt (:,:,iblk), & + dxhy (:,:,iblk) , dyhx(:,:,iblk), & + cxp (:,:,iblk) , cyp (:,:,iblk), & + cxm (:,:,iblk) , cym (:,:,iblk), & + zetaD (:,:,iblk,:), diag_rheo(:,:,:)) + ! second compute the full diagonal + call formDiag_step2 (nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj (:,iblk), & + diag_rheo (:,:,:), vrel (:,:,iblk), & + umassdti (:,:,iblk), & + uarear (:,:,iblk), Cb (:,:,iblk), & + diagx (:,:,iblk), diagy (:,:,iblk)) + enddo + !$OMP END PARALLEL DO + endif + + ! FGMRES linear solver + call fgmres (zetaD , & + Cb , vrel , & + umassdti , & + halo_info_mask, & + bx , by , & + diagx , diagy , & + reltol_fgmres , dim_fgmres, & + maxits_fgmres , & + solx , soly , & + nbiter) + ! Put FGMRES solution solx,soly in fpfunc vector (needed for Anderson) + call arrays_to_vec (nx_block , ny_block , & + nblocks , max_blocks , & + icellu (:), ntot , & + indxui (:,:), indxuj (:,:), & + solx (:,:,:), soly (:,:,:), & + fpfunc (:)) + elseif (fpfunc_andacc == 2) then + ! g_2(x) = x - A(x)x + b(x) = x - F(x) + call abort_ice(error_message=subname // " Fixed point function g_2(x) not yet implemented (fpfunc_andacc = 2)" , & + file=__FILE__, line=__LINE__) + endif + + ! Compute fixed point residual f(x) = g(x) - x + res = fpfunc - sol +#ifdef USE_LAPACK + fpres_norm = global_sum(dnrm2(size(res), res, inc)**2, distrb_info) +#else + call vec_to_arrays (nx_block , ny_block , & + nblocks , max_blocks , & + icellu (:), ntot , & + indxui (:,:), indxuj(:,:) , & + res (:), & + fpresx (:,:,:), fpresy (:,:,:)) + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call calc_L2norm_squared (nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj (:,iblk), & + fpresx(:,:,iblk), fpresy(:,:,iblk), & + L2norm (iblk)) + enddo + !$OMP END PARALLEL DO + fpres_norm = sqrt(global_sum(sum(L2norm), distrb_info)) +#endif + if (my_task == master_task .and. monitor_nonlin) then + write(nu_diag, '(a,i4,a,d26.16)') "monitor_nonlin: iter_nonlin= ", it_nl, & + " fixed_point_res_L2norm= ", fpres_norm + endif + + ! Not used for now (only nonlinear residual is checked) + ! ! Store initial residual norm + ! if (it_nl == 0) then + ! tol = reltol_andacc*fpres_norm + ! endif + ! + ! ! Check residual + ! if (fpres_norm < tol) then + ! exit + ! endif + + if (dim_andacc == 0 .or. it_nl < start_andacc) then + ! Simple fixed point (Picard) iteration in this case + sol = fpfunc + else +#ifdef USE_LAPACK + ! Begin Anderson acceleration + if (get_num_procs() > 1) then + ! Anderson solver is not yet parallelized; abort + if (my_task == master_task) then + call abort_ice(error_message=subname // " Anderson solver (algo_nonlin = 'anderson') is not yet parallelized, and nprocs > 1 " , & + file=__FILE__, line=__LINE__) + endif + endif + if (it_nl > start_andacc) then + ! Update residual difference vector + res_diff = res - res_old + ! Update fixed point function difference matrix + if (res_num < dim_andacc) then + ! Add column + G_diff(:,res_num+1) = fpfunc - fpfunc_old + else + ! Delete first column and add column + G_diff(:,1:res_num-1) = G_diff(:,2:res_num) + G_diff(:,res_num) = fpfunc - fpfunc_old + endif + res_num = res_num + 1 + endif + res_old = res + fpfunc_old = fpfunc + if (res_num == 0) then + sol = fpfunc + else + if (res_num == 1) then + ! Initialize QR factorization + R(1,1) = dnrm2(size(res_diff), res_diff, inc) + Q(:,1) = res_diff/R(1,1) + else + if (res_num > dim_andacc) then + ! Update factorization since 1st column was deleted + call qr_delete(Q,R) + res_num = res_num - 1 + endif + ! Update QR factorization for new column + do j = 1, res_num - 1 + R(j,res_num) = ddot(ntot, Q(:,j), inc, res_diff, inc) + res_diff = res_diff - R(j,res_num) * Q(:,j) + enddo + R(res_num, res_num) = dnrm2(size(res_diff) ,res_diff, inc) + Q(:,res_num) = res_diff / R(res_num, res_num) + endif + ! TODO: here, drop more columns to improve conditioning + ! if (droptol) then + + ! endif + ! Solve least square problem for coefficients + ! 1. Compute rhs_tri = Q^T * res + call dgemv ('t', size(Q,1), res_num, c1, Q(:,1:res_num), size(Q,1), res, inc, c0, rhs_tri, inc) + ! 2. Solve R*coeffs = rhs_tri, put result in rhs_tri + call dtrsv ('u', 'n', 'n', res_num, R(1:res_num,1:res_num), res_num, rhs_tri, inc) + coeffs = rhs_tri + ! Update approximate solution: x = fpfunc - G_diff*coeffs, put result in fpfunc + call dgemv ('n', size(G_diff,1), res_num, -c1, G_diff(:,1:res_num), size(G_diff,1), coeffs, inc, c1, fpfunc, inc) + sol = fpfunc + ! Apply damping + if (damping_andacc > 0 .and. damping_andacc /= 1) then + ! x = x - (1-beta) (res - Q*R*coeffs) + + ! tmp = R*coeffs + call dgemv ('n', res_num, res_num, c1, R(1:res_num,1:res_num), res_num, coeffs, inc, c0, tmp, inc) + ! res = res - Q*tmp + call dgemv ('n', size(Q,1), res_num, -c1, Q(:,1:res_num), size(Q,1), tmp, inc, c1, res, inc) + ! x = x - (1-beta)*res + sol = sol - (1-damping_andacc)*res + endif + endif +#else + ! Anderson solver is not usable without LAPACK; abort + call abort_ice(error_message=subname // " CICE was not compiled with LAPACK, and Anderson solver was chosen (algo_nonlin = 'anderson')" , & + file=__FILE__, line=__LINE__) +#endif + endif + + !----------------------------------------------------------------------- + ! Put vector sol in uvel and vvel arrays + !----------------------------------------------------------------------- + call vec_to_arrays (nx_block , ny_block , & + nblocks , max_blocks , & + icellu (:), ntot , & + indxui (:,:), indxuj (:,:), & + sol (:), & + uvel (:,:,:), vvel (:,:,:)) + + ! Do halo update so that halo cells contain up to date info for advection + 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) + + ! Compute "progress" residual norm + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + fpresx(:,:,iblk) = uvel(:,:,iblk) - uprev_k(:,:,iblk) + fpresy(:,:,iblk) = vvel(:,:,iblk) - vprev_k(:,:,iblk) + call calc_L2norm_squared (nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj (:,iblk), & + fpresx(:,:,iblk), fpresy(:,:,iblk), & + L2norm (iblk)) + enddo + !$OMP END PARALLEL DO + prog_norm = sqrt(global_sum(sum(L2norm), distrb_info)) + if (my_task == master_task .and. monitor_nonlin) then + write(nu_diag, '(a,i4,a,d26.16)') "monitor_nonlin: iter_nonlin= ", it_nl, & + " progress_res_L2norm= ", prog_norm + endif + + enddo ! nonlinear iteration loop + + end subroutine anderson_solver + +!======================================================================= + +! Computes the viscous coefficients (in fact zetaD=2*zeta) and dPr/dx, dPr/dy + + subroutine calc_zeta_dPr (nx_block, ny_block, & + icellt , & + indxti , indxtj , & + uvel , vvel , & + dxt , dyt , & + dxhy , dyhx , & + cxp , cyp , & + cxm , cym , & + tinyarea, & + strength, zetaD , & + stPr) + + use ice_dyn_shared, only: strain_rates + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellt ! no. of cells where icetmask = 1 + + integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & + indxti , & ! compressed index in i-direction + indxtj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + strength , & ! ice strength (N/m) + uvel , & ! x-component of velocity (m/s) + vvel , & ! y-component of velocity (m/s) + dxt , & ! width of T-cell through the middle (m) + dyt , & ! height of T-cell through the middle (m) + dxhy , & ! 0.5*(HTE - HTE) + dyhx , & ! 0.5*(HTN - HTN) + cyp , & ! 1.5*HTE - 0.5*HTE + cxp , & ! 1.5*HTN - 0.5*HTN + cym , & ! 0.5*HTE - 1.5*HTE + cxm , & ! 0.5*HTN - 1.5*HTN + tinyarea ! min_strain_rate*tarea + + real (kind=dbl_kind), dimension(nx_block,ny_block,4), intent(out) :: & + zetaD ! 2*zeta + + real (kind=dbl_kind), dimension(nx_block,ny_block,8), intent(out) :: & + stPr ! stress combinations from replacement pressure + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij + + real (kind=dbl_kind) :: & + divune, divunw, divuse, divusw , & ! divergence + tensionne, tensionnw, tensionse, tensionsw , & ! tension + shearne, shearnw, shearse, shearsw , & ! shearing + Deltane, Deltanw, Deltase, Deltasw , & ! Delt + ssigpn, ssigps, ssigpe, ssigpw, ssigp1, ssigp2, & + csigpne, csigpnw, csigpsw, csigpse , & + stressp_1, stressp_2, stressp_3, stressp_4 , & + strp_tmp + + logical :: capping ! of the viscous coeff + + character(len=*), parameter :: subname = '(calc_zeta_dPr)' + + ! Initialize + + capping = .false. + + ! Initialize stPr and zetaD to zero (for cells where icetmask is false) + stPr = c0 + zetaD = c0 + + do ij = 1, icellt + i = indxti(ij) + j = indxtj(ij) + + !----------------------------------------------------------------- + ! strain rates + ! NOTE these are actually strain rates * area (m^2/s) + !----------------------------------------------------------------- + call strain_rates (nx_block , ny_block , & + i , j , & + uvel , vvel , & + dxt , dyt , & + cxp , cyp , & + cxm , cym , & + divune , divunw , & + divuse , divusw , & + tensionne, tensionnw, & + tensionse, tensionsw, & + shearne , shearnw , & + shearse , shearsw , & + Deltane , Deltanw , & + Deltase , Deltasw) + + if (capping) then + zetaD(i,j,1) = strength(i,j)/max(Deltane,tinyarea(i,j)) + zetaD(i,j,2) = strength(i,j)/max(Deltanw,tinyarea(i,j)) + zetaD(i,j,3) = strength(i,j)/max(Deltasw,tinyarea(i,j)) + zetaD(i,j,4) = strength(i,j)/max(Deltase,tinyarea(i,j)) + else + zetaD(i,j,1) = strength(i,j)/(Deltane + tinyarea(i,j)) + zetaD(i,j,2) = strength(i,j)/(Deltanw + tinyarea(i,j)) + zetaD(i,j,3) = strength(i,j)/(Deltasw + tinyarea(i,j)) + zetaD(i,j,4) = strength(i,j)/(Deltase + tinyarea(i,j)) + endif + + !----------------------------------------------------------------- + ! the stresses ! kg/s^2 + ! (1) northeast, (2) northwest, (3) southwest, (4) southeast + !----------------------------------------------------------------- + + stressp_1 = -zetaD(i,j,1)*(Deltane*(c1-Ktens)) + stressp_2 = -zetaD(i,j,2)*(Deltanw*(c1-Ktens)) + stressp_3 = -zetaD(i,j,3)*(Deltasw*(c1-Ktens)) + stressp_4 = -zetaD(i,j,4)*(Deltase*(c1-Ktens)) + + !----------------------------------------------------------------- + ! combinations of the Pr related stresses for the momentum equation ! kg/s^2 + !----------------------------------------------------------------- + + ssigpn = stressp_1 + stressp_2 + ssigps = stressp_3 + stressp_4 + ssigpe = stressp_1 + stressp_4 + ssigpw = stressp_2 + stressp_3 + ssigp1 =(stressp_1 + stressp_3)*p055 + ssigp2 =(stressp_2 + stressp_4)*p055 + + csigpne = p111*stressp_1 + ssigp2 + p027*stressp_3 + csigpnw = p111*stressp_2 + ssigp1 + p027*stressp_4 + csigpsw = p111*stressp_3 + ssigp2 + p027*stressp_1 + csigpse = p111*stressp_4 + ssigp1 + p027*stressp_2 + + !----------------------------------------------------------------- + ! for dF/dx (u momentum) + !----------------------------------------------------------------- + strp_tmp = p25*dyt(i,j)*(p333*ssigpn + p166*ssigps) + + ! northeast (i,j) + stPr(i,j,1) = -strp_tmp & + + dxhy(i,j)*(-csigpne) + + ! northwest (i+1,j) + stPr(i,j,2) = strp_tmp & + + dxhy(i,j)*(-csigpnw) + + strp_tmp = p25*dyt(i,j)*(p333*ssigps + p166*ssigpn) + + ! southeast (i,j+1) + stPr(i,j,3) = -strp_tmp & + + dxhy(i,j)*(-csigpse) + + ! southwest (i+1,j+1) + stPr(i,j,4) = strp_tmp & + + dxhy(i,j)*(-csigpsw) + + !----------------------------------------------------------------- + ! for dF/dy (v momentum) + !----------------------------------------------------------------- + strp_tmp = p25*dxt(i,j)*(p333*ssigpe + p166*ssigpw) + + ! northeast (i,j) + stPr(i,j,5) = -strp_tmp & + - dyhx(i,j)*(csigpne) + + ! southeast (i,j+1) + stPr(i,j,6) = strp_tmp & + - dyhx(i,j)*(csigpse) + + strp_tmp = p25*dxt(i,j)*(p333*ssigpw + p166*ssigpe) + + ! northwest (i+1,j) + stPr(i,j,7) = -strp_tmp & + - dyhx(i,j)*(csigpnw) + + ! southwest (i+1,j+1) + stPr(i,j,8) = strp_tmp & + - dyhx(i,j)*(csigpsw) + + enddo ! ij + + end subroutine calc_zeta_dPr + +!======================================================================= + +! Computes the VP stresses (as diagnostic) + + subroutine stress_vp (nx_block , ny_block , & + icellt , & + indxti , indxtj , & + uvel , vvel , & + dxt , dyt , & + cxp , cyp , & + cxm , cym , & + zetaD , & + stressp_1 , stressp_2 , & + stressp_3 , stressp_4 , & + stressm_1 , stressm_2 , & + stressm_3 , stressm_4 , & + stress12_1, stress12_2, & + stress12_3, stress12_4) + + use ice_dyn_shared, only: strain_rates + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellt ! no. of cells where icetmask = 1 + + integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & + indxti , & ! compressed index in i-direction + indxtj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + uvel , & ! x-component of velocity (m/s) + vvel , & ! y-component of velocity (m/s) + dxt , & ! width of T-cell through the middle (m) + dyt , & ! height of T-cell through the middle (m) + cyp , & ! 1.5*HTE - 0.5*HTE + cxp , & ! 1.5*HTN - 0.5*HTN + cym , & ! 0.5*HTE - 1.5*HTE + cxm ! 0.5*HTN - 1.5*HTN + + real (kind=dbl_kind), dimension(nx_block,ny_block,4), intent(in) :: & + zetaD ! 2*zeta + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & + stressp_1, stressp_2, stressp_3, stressp_4 , & ! sigma11+sigma22 + stressm_1, stressm_2, stressm_3, stressm_4 , & ! sigma11-sigma22 + stress12_1,stress12_2,stress12_3,stress12_4 ! sigma12 + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij + + real (kind=dbl_kind) :: & + divune, divunw, divuse, divusw , & ! divergence + tensionne, tensionnw, tensionse, tensionsw, & ! tension + shearne, shearnw, shearse, shearsw , & ! shearing + Deltane, Deltanw, Deltase, Deltasw ! Delt + + character(len=*), parameter :: subname = '(stress_vp)' + + do ij = 1, icellt + i = indxti(ij) + j = indxtj(ij) + + !----------------------------------------------------------------- + ! strain rates + ! NOTE these are actually strain rates * area (m^2/s) + !----------------------------------------------------------------- + call strain_rates (nx_block , ny_block , & + i , j , & + uvel , vvel , & + dxt , dyt , & + cxp , cyp , & + cxm , cym , & + divune , divunw , & + divuse , divusw , & + tensionne, tensionnw, & + tensionse, tensionsw, & + shearne , shearnw , & + shearse , shearsw , & + Deltane , Deltanw , & + Deltase , Deltasw) + + !----------------------------------------------------------------- + ! the stresses ! kg/s^2 + ! (1) northeast, (2) northwest, (3) southwest, (4) southeast + !----------------------------------------------------------------- + + stressp_1(i,j) = zetaD(i,j,1)*(divune*(c1+Ktens) - Deltane*(c1-Ktens)) + stressp_2(i,j) = zetaD(i,j,2)*(divunw*(c1+Ktens) - Deltanw*(c1-Ktens)) + stressp_3(i,j) = zetaD(i,j,3)*(divusw*(c1+Ktens) - Deltasw*(c1-Ktens)) + stressp_4(i,j) = zetaD(i,j,4)*(divuse*(c1+Ktens) - Deltase*(c1-Ktens)) + + stressm_1(i,j) = zetaD(i,j,1)*tensionne*(c1+Ktens)*ecci + stressm_2(i,j) = zetaD(i,j,2)*tensionnw*(c1+Ktens)*ecci + stressm_3(i,j) = zetaD(i,j,3)*tensionsw*(c1+Ktens)*ecci + stressm_4(i,j) = zetaD(i,j,4)*tensionse*(c1+Ktens)*ecci + + stress12_1(i,j) = zetaD(i,j,1)*shearne*p5*(c1+Ktens)*ecci + stress12_2(i,j) = zetaD(i,j,2)*shearnw*p5*(c1+Ktens)*ecci + stress12_3(i,j) = zetaD(i,j,3)*shearsw*p5*(c1+Ktens)*ecci + stress12_4(i,j) = zetaD(i,j,4)*shearse*p5*(c1+Ktens)*ecci + + enddo ! ij + + end subroutine stress_vp + +!======================================================================= + +! Compute vrel and seabed stress coefficients + + subroutine calc_vrel_Cb (nx_block, ny_block, & + icellu , Cw , & + indxui , indxuj , & + aiu , Tbu , & + uocn , vocn , & + uvel , vvel , & + vrel , Cb) + + use ice_dyn_shared, only: u0 ! residual velocity for basal stress (m/s) + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellu ! total count when iceumask is true + + integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + Tbu, & ! coefficient for basal stress (N/m^2) + aiu , & ! ice fraction on u-grid + uocn , & ! ocean current, x-direction (m/s) + vocn , & ! ocean current, y-direction (m/s) + Cw ! ocean-ice neutral drag coefficient + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + uvel , & ! x-component of velocity (m/s) + vvel ! y-component of velocity (m/s) + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & + vrel , & ! coeff for tauw + Cb ! seabed stress coeff + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij + + real (kind=dbl_kind) :: & + rhow ! + + character(len=*), parameter :: subname = '(calc_vrel_Cb)' + + call icepack_query_parameters(rhow_out=rhow) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + do ij = 1, icellu + i = indxui(ij) + j = indxuj(ij) + + ! (magnitude of relative ocean current)*rhow*drag*aice + vrel(i,j) = aiu(i,j)*rhow*Cw(i,j)*sqrt((uocn(i,j) - uvel(i,j))**2 + & + (vocn(i,j) - vvel(i,j))**2) ! m/s + + Cb(i,j) = Tbu(i,j) / (sqrt(uvel(i,j)**2 + vvel(i,j)**2) + u0) ! for seabed stress + enddo ! ij + + end subroutine calc_vrel_Cb + +!======================================================================= + +! Compute seabed stress (diagnostic) + + subroutine calc_seabed_stress (nx_block, ny_block, & + icellu , & + indxui , indxuj , & + uvel , vvel , & + Cb , & + taubx , tauby) + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellu ! total count when iceumask is true + + integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + uvel , & ! x-component of velocity (m/s) + vvel , & ! y-component of velocity (m/s) + Cb ! seabed stress coefficient + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out) :: & + taubx , & ! seabed stress, x-direction (N/m^2) + tauby ! seabed stress, y-direction (N/m^2) + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij + + character(len=*), parameter :: subname = '(calc_seabed_stress)' + + do ij = 1, icellu + i = indxui(ij) + j = indxuj(ij) + + taubx(i,j) = -uvel(i,j)*Cb(i,j) + tauby(i,j) = -vvel(i,j)*Cb(i,j) + enddo ! ij + + end subroutine calc_seabed_stress + +!======================================================================= + +! Computes the matrix vector product A(u,v) * (u,v) +! Au = A(u,v)_[x] * uvel (x components of A(u,v) * (u,v)) +! Av = A(u,v)_[y] * vvel (y components of A(u,v) * (u,v)) + + subroutine matvec (nx_block, ny_block, & + icellu , icellt , & + indxui , indxuj , & + indxti , indxtj , & + dxt , dyt , & + dxhy , dyhx , & + cxp , cyp , & + cxm , cym , & + uvel , vvel , & + vrel , Cb , & + zetaD , & + umassdti, fm , & + uarear , & + Au , Av) + + use ice_dyn_shared, only: strain_rates + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellu, & ! total count when iceumask is true + icellt ! no. of cells where icetmask = 1 + + integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & + indxui , & ! compressed index in i-direction + indxuj , & ! compressed index in j-direction + indxti , & ! compressed index in i-direction + indxtj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + dxt , & ! width of T-cell through the middle (m) + dyt , & ! height of T-cell through the middle (m) + dxhy , & ! 0.5*(HTE - HTE) + dyhx , & ! 0.5*(HTN - HTN) + cyp , & ! 1.5*HTE - 0.5*HTE + cxp , & ! 1.5*HTN - 0.5*HTN + cym , & ! 0.5*HTE - 1.5*HTE + cxm ! 0.5*HTN - 1.5*HTN + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + uvel , & ! x-component of velocity (m/s) + vvel , & ! y-component of velocity (m/s) + vrel , & ! coefficient for tauw + Cb , & ! coefficient for basal stress + umassdti, & ! mass of U-cell/dt (kg/m^2 s) + fm , & ! Coriolis param. * mass in U-cell (kg/s) + uarear ! 1/uarea + + real (kind=dbl_kind), dimension(nx_block,ny_block,4), intent(in) :: & + zetaD ! 2*zeta + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & + Au , & ! matvec, Fx = bx - Au (N/m^2) + Av ! matvec, Fy = by - Av (N/m^2) + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij + + real (kind=dbl_kind), dimension(nx_block,ny_block,8):: & + str + + real (kind=dbl_kind) :: & + ccaimp,ccb , & ! intermediate variables + strintx, strinty ! divergence of the internal stress tensor + + real (kind=dbl_kind) :: & + divune, divunw, divuse, divusw , & ! divergence + tensionne, tensionnw, tensionse, tensionsw, & ! tension + shearne, shearnw, shearse, shearsw , & ! shearing + Deltane, Deltanw, Deltase, Deltasw , & ! Delt + ssigpn, ssigps, ssigpe, ssigpw , & + ssigmn, ssigms, ssigme, ssigmw , & + ssig12n, ssig12s, ssig12e, ssig12w , & + ssigp1, ssigp2, ssigm1, ssigm2, ssig121, ssig122, & + csigpne, csigpnw, csigpse, csigpsw , & + csigmne, csigmnw, csigmse, csigmsw , & + csig12ne, csig12nw, csig12se, csig12sw , & + str12ew, str12we, str12ns, str12sn , & + strp_tmp, strm_tmp + + real (kind=dbl_kind) :: & + stressp_1, stressp_2, stressp_3, stressp_4 , & ! sigma11+sigma22 (without Pr) + stressm_1, stressm_2, stressm_3, stressm_4 , & ! sigma11-sigma22 + stress12_1,stress12_2,stress12_3,stress12_4 ! sigma12 + + character(len=*), parameter :: subname = '(matvec)' + + !----------------------------------------------------------------- + ! Initialize + !----------------------------------------------------------------- + + str(:,:,:) = c0 + + do ij = 1, icellt + i = indxti(ij) + j = indxtj(ij) + + !----------------------------------------------------------------- + ! strain rates + ! NOTE these are actually strain rates * area (m^2/s) + !----------------------------------------------------------------- + call strain_rates (nx_block , ny_block , & + i , j , & + uvel , vvel , & + dxt , dyt , & + cxp , cyp , & + cxm , cym , & + divune , divunw , & + divuse , divusw , & + tensionne, tensionnw, & + tensionse, tensionsw, & + shearne , shearnw , & + shearse , shearsw , & + Deltane , Deltanw , & + Deltase , Deltasw) + + !----------------------------------------------------------------- + ! the stresses ! kg/s^2 + ! (1) northeast, (2) northwest, (3) southwest, (4) southeast + ! NOTE: commented part of stressp is from the replacement pressure Pr + !----------------------------------------------------------------- + + stressp_1 = zetaD(i,j,1)*(divune*(c1+Ktens))! - Deltane*(c1-Ktens)) + stressp_2 = zetaD(i,j,2)*(divunw*(c1+Ktens))! - Deltanw*(c1-Ktens)) + stressp_3 = zetaD(i,j,3)*(divusw*(c1+Ktens))! - Deltasw*(c1-Ktens)) + stressp_4 = zetaD(i,j,4)*(divuse*(c1+Ktens))! - Deltase*(c1-Ktens)) + + stressm_1 = zetaD(i,j,1)*tensionne*(c1+Ktens)*ecci + stressm_2 = zetaD(i,j,2)*tensionnw*(c1+Ktens)*ecci + stressm_3 = zetaD(i,j,3)*tensionsw*(c1+Ktens)*ecci + stressm_4 = zetaD(i,j,4)*tensionse*(c1+Ktens)*ecci + + stress12_1 = zetaD(i,j,1)*shearne*p5*(c1+Ktens)*ecci + stress12_2 = zetaD(i,j,2)*shearnw*p5*(c1+Ktens)*ecci + stress12_3 = zetaD(i,j,3)*shearsw*p5*(c1+Ktens)*ecci + stress12_4 = zetaD(i,j,4)*shearse*p5*(c1+Ktens)*ecci + + !----------------------------------------------------------------- + ! combinations of the stresses for the momentum equation ! kg/s^2 + !----------------------------------------------------------------- + + ssigpn = stressp_1 + stressp_2 + ssigps = stressp_3 + stressp_4 + ssigpe = stressp_1 + stressp_4 + ssigpw = stressp_2 + stressp_3 + ssigp1 =(stressp_1 + stressp_3)*p055 + ssigp2 =(stressp_2 + stressp_4)*p055 + + ssigmn = stressm_1 + stressm_2 + ssigms = stressm_3 + stressm_4 + ssigme = stressm_1 + stressm_4 + ssigmw = stressm_2 + stressm_3 + ssigm1 =(stressm_1 + stressm_3)*p055 + ssigm2 =(stressm_2 + stressm_4)*p055 + + ssig12n = stress12_1 + stress12_2 + ssig12s = stress12_3 + stress12_4 + ssig12e = stress12_1 + stress12_4 + ssig12w = stress12_2 + stress12_3 + ssig121 =(stress12_1 + stress12_3)*p111 + ssig122 =(stress12_2 + stress12_4)*p111 + + csigpne = p111*stressp_1 + ssigp2 + p027*stressp_3 + csigpnw = p111*stressp_2 + ssigp1 + p027*stressp_4 + csigpsw = p111*stressp_3 + ssigp2 + p027*stressp_1 + csigpse = p111*stressp_4 + ssigp1 + p027*stressp_2 + + csigmne = p111*stressm_1 + ssigm2 + p027*stressm_3 + csigmnw = p111*stressm_2 + ssigm1 + p027*stressm_4 + csigmsw = p111*stressm_3 + ssigm2 + p027*stressm_1 + csigmse = p111*stressm_4 + ssigm1 + p027*stressm_2 + + csig12ne = p222*stress12_1 + ssig122 & + + p055*stress12_3 + csig12nw = p222*stress12_2 + ssig121 & + + p055*stress12_4 + csig12sw = p222*stress12_3 + ssig122 & + + p055*stress12_1 + csig12se = p222*stress12_4 + ssig121 & + + p055*stress12_2 + + str12ew = p5*dxt(i,j)*(p333*ssig12e + p166*ssig12w) + str12we = p5*dxt(i,j)*(p333*ssig12w + p166*ssig12e) + str12ns = p5*dyt(i,j)*(p333*ssig12n + p166*ssig12s) + str12sn = p5*dyt(i,j)*(p333*ssig12s + p166*ssig12n) + + !----------------------------------------------------------------- + ! for dF/dx (u momentum) + !----------------------------------------------------------------- + strp_tmp = p25*dyt(i,j)*(p333*ssigpn + p166*ssigps) + strm_tmp = p25*dyt(i,j)*(p333*ssigmn + p166*ssigms) + + ! northeast (i,j) + str(i,j,1) = -strp_tmp - strm_tmp - str12ew & + + dxhy(i,j)*(-csigpne + csigmne) + dyhx(i,j)*csig12ne + + ! northwest (i+1,j) + str(i,j,2) = strp_tmp + strm_tmp - str12we & + + dxhy(i,j)*(-csigpnw + csigmnw) + dyhx(i,j)*csig12nw + + strp_tmp = p25*dyt(i,j)*(p333*ssigps + p166*ssigpn) + strm_tmp = p25*dyt(i,j)*(p333*ssigms + p166*ssigmn) + + ! southeast (i,j+1) + str(i,j,3) = -strp_tmp - strm_tmp + str12ew & + + dxhy(i,j)*(-csigpse + csigmse) + dyhx(i,j)*csig12se + + ! southwest (i+1,j+1) + str(i,j,4) = strp_tmp + strm_tmp + str12we & + + dxhy(i,j)*(-csigpsw + csigmsw) + dyhx(i,j)*csig12sw + + !----------------------------------------------------------------- + ! for dF/dy (v momentum) + !----------------------------------------------------------------- + strp_tmp = p25*dxt(i,j)*(p333*ssigpe + p166*ssigpw) + strm_tmp = p25*dxt(i,j)*(p333*ssigme + p166*ssigmw) + + ! northeast (i,j) + str(i,j,5) = -strp_tmp + strm_tmp - str12ns & + - dyhx(i,j)*(csigpne + csigmne) + dxhy(i,j)*csig12ne + + ! southeast (i,j+1) + str(i,j,6) = strp_tmp - strm_tmp - str12sn & + - dyhx(i,j)*(csigpse + csigmse) + dxhy(i,j)*csig12se + + strp_tmp = p25*dxt(i,j)*(p333*ssigpw + p166*ssigpe) + strm_tmp = p25*dxt(i,j)*(p333*ssigmw + p166*ssigme) + + ! northwest (i+1,j) + str(i,j,7) = -strp_tmp + strm_tmp + str12ns & + - dyhx(i,j)*(csigpnw + csigmnw) + dxhy(i,j)*csig12nw + + ! southwest (i+1,j+1) + str(i,j,8) = strp_tmp - strm_tmp + str12sn & + - dyhx(i,j)*(csigpsw + csigmsw) + dxhy(i,j)*csig12sw + + enddo ! ij - icellt + + !----------------------------------------------------------------- + ! Form Au and Av + !----------------------------------------------------------------- + + do ij = 1, icellu + i = indxui(ij) + j = indxuj(ij) + + ccaimp = umassdti(i,j) + vrel(i,j) * cosw + Cb(i,j) ! kg/m^2 s + + ccb = fm(i,j) + sign(c1,fm(i,j)) * vrel(i,j) * sinw ! kg/m^2 s + + ! divergence of the internal stress tensor + strintx = uarear(i,j)* & + (str(i,j,1) + str(i+1,j,2) + str(i,j+1,3) + str(i+1,j+1,4)) + strinty = uarear(i,j)* & + (str(i,j,5) + str(i,j+1,6) + str(i+1,j,7) + str(i+1,j+1,8)) + + Au(i,j) = ccaimp*uvel(i,j) - ccb*vvel(i,j) - strintx + Av(i,j) = ccaimp*vvel(i,j) + ccb*uvel(i,j) - strinty + enddo ! ij - icellu + + end subroutine matvec + +!======================================================================= + +! Compute the constant component of b(u,v) i.e. the part of b(u,v) that +! does not depend on (u,v) and thus do not change during the nonlinear iteration + + subroutine calc_bfix (nx_block , ny_block , & + icellu , & + indxui , indxuj , & + umassdti , & + forcex , forcey , & + uvel_init, vvel_init, & + bxfix , byfix) + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellu ! no. of cells where iceumask = 1 + + integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + uvel_init,& ! x-component of velocity (m/s), beginning of time step + vvel_init,& ! y-component of velocity (m/s), beginning of time step + umassdti, & ! mass of U-cell/dt (kg/m^2 s) + forcex , & ! work array: combined atm stress and ocn tilt, x + forcey ! work array: combined atm stress and ocn tilt, y + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out) :: & + bxfix , & ! bx = taux + bxfix + byfix ! by = tauy + byfix + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij + + character(len=*), parameter :: subname = '(calc_bfix)' + + do ij = 1, icellu + i = indxui(ij) + j = indxuj(ij) + + bxfix(i,j) = umassdti(i,j)*uvel_init(i,j) + forcex(i,j) + byfix(i,j) = umassdti(i,j)*vvel_init(i,j) + forcey(i,j) + enddo + + end subroutine calc_bfix + +!======================================================================= + +! Compute the vector b(u,v), i.e. the part of the nonlinear function F(u,v) +! that cannot be written as A(u,v)*(u,v), where A(u,v) is a matrix with entries +! depending on (u,v) + + subroutine calc_bvec (nx_block, ny_block, & + icellu , & + indxui , indxuj , & + stPr , uarear , & + waterx , watery , & + bxfix , byfix , & + bx , by , & + vrel) + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellu ! total count when iceumask is true + + integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + uarear , & ! 1/uarea + waterx , & ! for ocean stress calculation, x (m/s) + watery , & ! for ocean stress calculation, y (m/s) + bxfix , & ! bx = taux + bxfix + byfix , & ! by = tauy + byfix + vrel ! relative ice-ocean velocity + + real (kind=dbl_kind), dimension(nx_block,ny_block,8), intent(in) :: & + stPr + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out) :: & + bx , & ! b vector, bx = taux + bxfix (N/m^2) + by ! b vector, by = tauy + byfix (N/m^2) + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij + + real (kind=dbl_kind) :: & + taux, tauy , & ! part of ocean stress term + strintx, strinty , & ! divergence of the internal stress tensor (only Pr contributions) + rhow ! + + character(len=*), parameter :: subname = '(calc_bvec)' + + !----------------------------------------------------------------- + ! calc b vector + !----------------------------------------------------------------- + + call icepack_query_parameters(rhow_out=rhow) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + do ij = 1, icellu + i = indxui(ij) + j = indxuj(ij) + + ! ice/ocean stress + taux = vrel(i,j)*waterx(i,j) ! NOTE this is not the entire + tauy = vrel(i,j)*watery(i,j) ! ocn stress term + + ! divergence of the internal stress tensor (only Pr part, i.e. dPr/dx, dPr/dy) + strintx = uarear(i,j)* & + (stPr(i,j,1) + stPr(i+1,j,2) + stPr(i,j+1,3) + stPr(i+1,j+1,4)) + strinty = uarear(i,j)* & + (stPr(i,j,5) + stPr(i,j+1,6) + stPr(i+1,j,7) + stPr(i+1,j+1,8)) + + bx(i,j) = bxfix(i,j) + taux + strintx + by(i,j) = byfix(i,j) + tauy + strinty + enddo ! ij + + end subroutine calc_bvec + +!======================================================================= + +! Compute the non linear residual F(u,v) = b(u,v) - A(u,v) * (u,v), +! with Au, Av precomputed as +! Au = A(u,v)_[x] * uvel (x components of A(u,v) * (u,v)) +! Av = A(u,v)_[y] * vvel (y components of A(u,v) * (u,v)) + + subroutine residual_vec (nx_block , ny_block, & + icellu , & + indxui , indxuj , & + bx , by , & + Au , Av , & + Fx , Fy , & + sum_squared) + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellu ! total count when iceumask is true + + integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + bx , & ! b vector, bx = taux + bxfix (N/m^2) + by , & ! b vector, by = tauy + byfix (N/m^2) + Au , & ! matvec, Fx = bx - Au (N/m^2) + Av ! matvec, Fy = by - Av (N/m^2) + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & + Fx , & ! x residual vector, Fx = bx - Au (N/m^2) + Fy ! y residual vector, Fy = by - Av (N/m^2) + + real (kind=dbl_kind), intent(out), optional :: & + sum_squared ! sum of squared residual vector components + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij + + character(len=*), parameter :: subname = '(residual_vec)' + + !----------------------------------------------------------------- + ! compute residual and sum its squared components + !----------------------------------------------------------------- + + if (present(sum_squared)) then + sum_squared = c0 + endif + + do ij = 1, icellu + i = indxui(ij) + j = indxuj(ij) + + Fx(i,j) = bx(i,j) - Au(i,j) + Fy(i,j) = by(i,j) - Av(i,j) + if (present(sum_squared)) then + sum_squared = sum_squared + Fx(i,j)**2 + Fy(i,j)**2 + endif + enddo ! ij + + end subroutine residual_vec + +!======================================================================= + +! Form the diagonal of the matrix A(u,v) (first part of the computation) +! Part 1: compute the contributions to the diagonal from the rheology term + + subroutine formDiag_step1 (nx_block, ny_block, & + icellu , & + indxui , indxuj , & + dxt , dyt , & + dxhy , dyhx , & + cxp , cyp , & + cxm , cym , & + zetaD , Drheo) + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellu ! no. of cells where icetmask = 1 + + integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + dxt , & ! width of T-cell through the middle (m) + dyt , & ! height of T-cell through the middle (m) + dxhy , & ! 0.5*(HTE - HTE) + dyhx , & ! 0.5*(HTN - HTN) + cyp , & ! 1.5*HTE - 0.5*HTE + cxp , & ! 1.5*HTN - 0.5*HTN + cym , & ! 0.5*HTE - 1.5*HTE + cxm ! 0.5*HTN - 1.5*HTN + + real (kind=dbl_kind), dimension(nx_block,ny_block,4), intent(in) :: & + zetaD ! 2*zeta + + real (kind=dbl_kind), dimension(nx_block,ny_block,8), intent(out) :: & + Drheo ! intermediate value for diagonal components of matrix A associated + ! with rheology term + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij, iu, ju, di, dj, cc + + real (kind=dbl_kind) :: & + divune, divunw, divuse, divusw , & ! divergence + tensionne, tensionnw, tensionse, tensionsw, & ! tension + shearne, shearnw, shearse, shearsw , & ! shearing + uij,ui1j,uij1,ui1j1,vij,vi1j,vij1,vi1j1 , & ! == c0 or c1 + stressp_1, stressp_2, stressp_3, stressp_4, & + stressm_1, stressm_2, stressm_3, stressm_4, & + stress12_1,stress12_2,stress12_3,stress12_4,& + ssigpn, ssigps, ssigpe, ssigpw , & + ssigmn, ssigms, ssigme, ssigmw , & + ssig12n, ssig12s, ssig12e, ssig12w , & + ssigp1, ssigp2, ssigm1, ssigm2, ssig121, ssig122, & + csigpne, csigpnw, csigpse, csigpsw , & + csigmne, csigmnw, csigmse, csigmsw , & + csig12ne, csig12nw, csig12se, csig12sw , & + str12ew, str12we, str12ns, str12sn , & + strp_tmp, strm_tmp + + character(len=*), parameter :: subname = '(formDiag_step1)' + + !----------------------------------------------------------------- + ! Initialize + !----------------------------------------------------------------- + + Drheo(:,:,:) = c0 + + ! Be careful: Drheo contains 4 terms for u and 4 terms for v. + ! These 8 terms come from the surrounding T cells but are all + ! refrerenced to the i,j (u point) : + + ! Drheo(i,j,1) corresponds to str(i,j,1) + ! Drheo(i,j,2) corresponds to str(i+1,j,2) + ! Drheo(i,j,3) corresponds to str(i,j+1,3) + ! Drheo(i,j,4) corresponds to str(i+1,j+1,4)) + ! Drheo(i,j,5) corresponds to str(i,j,5) + ! Drheo(i,j,6) corresponds to str(i,j+1,6) + ! Drheo(i,j,7) corresponds to str(i+1,j,7) + ! Drheo(i,j,8) corresponds to str(i+1,j+1,8)) + + do cc = 1, 8 ! 4 for u and 4 for v + + if (cc == 1) then ! u comp, T cell i,j + uij = c1 + ui1j = c0 + uij1 = c0 + ui1j1 = c0 + vij = c0 + vi1j = c0 + vij1 = c0 + vi1j1 = c0 + di = 0 + dj = 0 + elseif (cc == 2) then ! u comp, T cell i+1,j + uij = c0 + ui1j = c1 + uij1 = c0 + ui1j1 = c0 + vij = c0 + vi1j = c0 + vij1 = c0 + vi1j1 = c0 + di = 1 + dj = 0 + elseif (cc == 3) then ! u comp, T cell i,j+1 + uij = c0 + ui1j = c0 + uij1 = c1 + ui1j1 = c0 + vij = c0 + vi1j = c0 + vij1 = c0 + vi1j1 = c0 + di = 0 + dj = 1 + elseif (cc == 4) then ! u comp, T cell i+1,j+1 + uij = c0 + ui1j = c0 + uij1 = c0 + ui1j1 = c1 + vij = c0 + vi1j = c0 + vij1 = c0 + vi1j1 = c0 + di = 1 + dj = 1 + elseif (cc == 5) then ! v comp, T cell i,j + uij = c0 + ui1j = c0 + uij1 = c0 + ui1j1 = c0 + vij = c1 + vi1j = c0 + vij1 = c0 + vi1j1 = c0 + di = 0 + dj = 0 + elseif (cc == 6) then ! v comp, T cell i,j+1 + uij = c0 + ui1j = c0 + uij1 = c0 + ui1j1 = c0 + vij = c0 + vi1j = c0 + vij1 = c1 + vi1j1 = c0 + di = 0 + dj = 1 + elseif (cc == 7) then ! v comp, T cell i+1,j + uij = c0 + ui1j = c0 + uij1 = c0 + ui1j1 = c0 + vij = c0 + vi1j = c1 + vij1 = c0 + vi1j1 = c0 + di = 1 + dj = 0 + elseif (cc == 8) then ! v comp, T cell i+1,j+1 + uij = c0 + ui1j = c0 + uij1 = c0 + ui1j1 = c0 + vij = c0 + vi1j = c0 + vij1 = c0 + vi1j1 = c1 + di = 1 + dj = 1 + endif + + do ij = 1, icellu + + iu = indxui(ij) + ju = indxuj(ij) + i = iu + di + j = ju + dj + + !----------------------------------------------------------------- + ! strain rates + ! NOTE these are actually strain rates * area (m^2/s) + !----------------------------------------------------------------- + ! divergence = e_11 + e_22 + divune = cyp(i,j)*uij - dyt(i,j)*ui1j & + + cxp(i,j)*vij - dxt(i,j)*vij1 + divunw = cym(i,j)*ui1j + dyt(i,j)*uij & + + cxp(i,j)*vi1j - dxt(i,j)*vi1j1 + divusw = cym(i,j)*ui1j1 + dyt(i,j)*uij1 & + + cxm(i,j)*vi1j1 + dxt(i,j)*vi1j + divuse = cyp(i,j)*uij1 - dyt(i,j)*ui1j1 & + + cxm(i,j)*vij1 + dxt(i,j)*vij + + ! tension strain rate = e_11 - e_22 + tensionne = -cym(i,j)*uij - dyt(i,j)*ui1j & + + cxm(i,j)*vij + dxt(i,j)*vij1 + tensionnw = -cyp(i,j)*ui1j + dyt(i,j)*uij & + + cxm(i,j)*vi1j + dxt(i,j)*vi1j1 + tensionsw = -cyp(i,j)*ui1j1 + dyt(i,j)*uij1 & + + cxp(i,j)*vi1j1 - dxt(i,j)*vi1j + tensionse = -cym(i,j)*uij1 - dyt(i,j)*ui1j1 & + + cxp(i,j)*vij1 - dxt(i,j)*vij + + ! shearing strain rate = 2*e_12 + shearne = -cym(i,j)*vij - dyt(i,j)*vi1j & + - cxm(i,j)*uij - dxt(i,j)*uij1 + shearnw = -cyp(i,j)*vi1j + dyt(i,j)*vij & + - cxm(i,j)*ui1j - dxt(i,j)*ui1j1 + shearsw = -cyp(i,j)*vi1j1 + dyt(i,j)*vij1 & + - cxp(i,j)*ui1j1 + dxt(i,j)*ui1j + shearse = -cym(i,j)*vij1 - dyt(i,j)*vi1j1 & + - cxp(i,j)*uij1 + dxt(i,j)*uij + + !----------------------------------------------------------------- + ! the stresses ! kg/s^2 + ! (1) northeast, (2) northwest, (3) southwest, (4) southeast + !----------------------------------------------------------------- + + stressp_1 = zetaD(i,j,1)*divune*(c1+Ktens) + stressp_2 = zetaD(i,j,2)*divunw*(c1+Ktens) + stressp_3 = zetaD(i,j,3)*divusw*(c1+Ktens) + stressp_4 = zetaD(i,j,4)*divuse*(c1+Ktens) + + stressm_1 = zetaD(i,j,1)*tensionne*(c1+Ktens)*ecci + stressm_2 = zetaD(i,j,2)*tensionnw*(c1+Ktens)*ecci + stressm_3 = zetaD(i,j,3)*tensionsw*(c1+Ktens)*ecci + stressm_4 = zetaD(i,j,4)*tensionse*(c1+Ktens)*ecci + + stress12_1 = zetaD(i,j,1)*shearne*p5*(c1+Ktens)*ecci + stress12_2 = zetaD(i,j,2)*shearnw*p5*(c1+Ktens)*ecci + stress12_3 = zetaD(i,j,3)*shearsw*p5*(c1+Ktens)*ecci + stress12_4 = zetaD(i,j,4)*shearse*p5*(c1+Ktens)*ecci + + !----------------------------------------------------------------- + ! combinations of the stresses for the momentum equation ! kg/s^2 + !----------------------------------------------------------------- + + ssigpn = stressp_1 + stressp_2 + ssigps = stressp_3 + stressp_4 + ssigpe = stressp_1 + stressp_4 + ssigpw = stressp_2 + stressp_3 + ssigp1 =(stressp_1 + stressp_3)*p055 + ssigp2 =(stressp_2 + stressp_4)*p055 + + ssigmn = stressm_1 + stressm_2 + ssigms = stressm_3 + stressm_4 + ssigme = stressm_1 + stressm_4 + ssigmw = stressm_2 + stressm_3 + ssigm1 =(stressm_1 + stressm_3)*p055 + ssigm2 =(stressm_2 + stressm_4)*p055 + + ssig12n = stress12_1 + stress12_2 + ssig12s = stress12_3 + stress12_4 + ssig12e = stress12_1 + stress12_4 + ssig12w = stress12_2 + stress12_3 + ssig121 =(stress12_1 + stress12_3)*p111 + ssig122 =(stress12_2 + stress12_4)*p111 + + csigpne = p111*stressp_1 + ssigp2 + p027*stressp_3 + csigpnw = p111*stressp_2 + ssigp1 + p027*stressp_4 + csigpsw = p111*stressp_3 + ssigp2 + p027*stressp_1 + csigpse = p111*stressp_4 + ssigp1 + p027*stressp_2 + + csigmne = p111*stressm_1 + ssigm2 + p027*stressm_3 + csigmnw = p111*stressm_2 + ssigm1 + p027*stressm_4 + csigmsw = p111*stressm_3 + ssigm2 + p027*stressm_1 + csigmse = p111*stressm_4 + ssigm1 + p027*stressm_2 + + csig12ne = p222*stress12_1 + ssig122 & + + p055*stress12_3 + csig12nw = p222*stress12_2 + ssig121 & + + p055*stress12_4 + csig12sw = p222*stress12_3 + ssig122 & + + p055*stress12_1 + csig12se = p222*stress12_4 + ssig121 & + + p055*stress12_2 + + str12ew = p5*dxt(i,j)*(p333*ssig12e + p166*ssig12w) + str12we = p5*dxt(i,j)*(p333*ssig12w + p166*ssig12e) + str12ns = p5*dyt(i,j)*(p333*ssig12n + p166*ssig12s) + str12sn = p5*dyt(i,j)*(p333*ssig12s + p166*ssig12n) + + !----------------------------------------------------------------- + ! for dF/dx (u momentum) + !----------------------------------------------------------------- + + if (cc == 1) then ! T cell i,j + + strp_tmp = p25*dyt(i,j)*(p333*ssigpn + p166*ssigps) + strm_tmp = p25*dyt(i,j)*(p333*ssigmn + p166*ssigms) + + ! northeast (i,j) + Drheo(iu,ju,1) = -strp_tmp - strm_tmp - str12ew & + + dxhy(i,j)*(-csigpne + csigmne) + dyhx(i,j)*csig12ne + + elseif (cc == 2) then ! T cell i+1,j + + strp_tmp = p25*dyt(i,j)*(p333*ssigpn + p166*ssigps) + strm_tmp = p25*dyt(i,j)*(p333*ssigmn + p166*ssigms) + + ! northwest (i+1,j) + Drheo(iu,ju,2) = strp_tmp + strm_tmp - str12we & + + dxhy(i,j)*(-csigpnw + csigmnw) + dyhx(i,j)*csig12nw + + elseif (cc == 3) then ! T cell i,j+1 + + strp_tmp = p25*dyt(i,j)*(p333*ssigps + p166*ssigpn) + strm_tmp = p25*dyt(i,j)*(p333*ssigms + p166*ssigmn) + + ! southeast (i,j+1) + Drheo(iu,ju,3) = -strp_tmp - strm_tmp + str12ew & + + dxhy(i,j)*(-csigpse + csigmse) + dyhx(i,j)*csig12se + + elseif (cc == 4) then ! T cell i+1,j+1 + + strp_tmp = p25*dyt(i,j)*(p333*ssigps + p166*ssigpn) + strm_tmp = p25*dyt(i,j)*(p333*ssigms + p166*ssigmn) + + ! southwest (i+1,j+1) + Drheo(iu,ju,4) = strp_tmp + strm_tmp + str12we & + + dxhy(i,j)*(-csigpsw + csigmsw) + dyhx(i,j)*csig12sw + + !----------------------------------------------------------------- + ! for dF/dy (v momentum) + !----------------------------------------------------------------- + + elseif (cc == 5) then ! T cell i,j + + strp_tmp = p25*dxt(i,j)*(p333*ssigpe + p166*ssigpw) + strm_tmp = p25*dxt(i,j)*(p333*ssigme + p166*ssigmw) + + ! northeast (i,j) + Drheo(iu,ju,5) = -strp_tmp + strm_tmp - str12ns & + - dyhx(i,j)*(csigpne + csigmne) + dxhy(i,j)*csig12ne + + elseif (cc == 6) then ! T cell i,j+1 + + strp_tmp = p25*dxt(i,j)*(p333*ssigpe + p166*ssigpw) + strm_tmp = p25*dxt(i,j)*(p333*ssigme + p166*ssigmw) + + ! southeast (i,j+1) + Drheo(iu,ju,6) = strp_tmp - strm_tmp - str12sn & + - dyhx(i,j)*(csigpse + csigmse) + dxhy(i,j)*csig12se + + elseif (cc == 7) then ! T cell i,j+1 + + strp_tmp = p25*dxt(i,j)*(p333*ssigpw + p166*ssigpe) + strm_tmp = p25*dxt(i,j)*(p333*ssigmw + p166*ssigme) + + ! northwest (i+1,j) + Drheo(iu,ju,7) = -strp_tmp + strm_tmp + str12ns & + - dyhx(i,j)*(csigpnw + csigmnw) + dxhy(i,j)*csig12nw + + elseif (cc == 8) then ! T cell i+1,j+1 + + strp_tmp = p25*dxt(i,j)*(p333*ssigpw + p166*ssigpe) + strm_tmp = p25*dxt(i,j)*(p333*ssigmw + p166*ssigme) + + ! southwest (i+1,j+1) + Drheo(iu,ju,8) = strp_tmp - strm_tmp + str12sn & + - dyhx(i,j)*(csigpsw + csigmsw) + dxhy(i,j)*csig12sw + + endif + + enddo ! ij + + enddo ! cc + + end subroutine formDiag_step1 + +!======================================================================= + +! Form the diagonal of the matrix A(u,v) (second part of the computation) +! Part 2: compute diagonal + + subroutine formDiag_step2 (nx_block, ny_block, & + icellu , & + indxui , indxuj , & + Drheo , vrel , & + umassdti, & + uarear , Cb , & + diagx , diagy) + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellu ! total count when iceumask is true + + integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + vrel, & ! coefficient for tauw + Cb, & ! coefficient for basal stress + umassdti, & ! mass of U-cell/dt (kg/m^2 s) + uarear ! 1/uarea + + real (kind=dbl_kind), dimension(nx_block,ny_block,8), intent(in) :: & + Drheo + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out) :: & + diagx , & ! Diagonal (x component) of the matrix A + diagy ! Diagonal (y component) of the matrix A + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij + + real (kind=dbl_kind) :: & + ccaimp , & ! intermediate variables + strintx, strinty ! diagonal contributions to the divergence + + character(len=*), parameter :: subname = '(formDiag_step2)' + + !----------------------------------------------------------------- + ! integrate the momentum equation + !----------------------------------------------------------------- + + strintx = c0 + strinty = c0 + + ! Be careful: Drheo contains 4 terms for u and 4 terms for v. + ! These 8 terms come from the surrounding T cells but are all + ! refrerenced to the i,j (u point) : + + ! Drheo(i,j,1) corresponds to str(i,j,1) + ! Drheo(i,j,2) corresponds to str(i+1,j,2) + ! Drheo(i,j,3) corresponds to str(i,j+1,3) + ! Drheo(i,j,4) corresponds to str(i+1,j+1,4)) + ! Drheo(i,j,5) corresponds to str(i,j,5) + ! Drheo(i,j,6) corresponds to str(i,j+1,6) + ! Drheo(i,j,7) corresponds to str(i+1,j,7) + ! Drheo(i,j,8) corresponds to str(i+1,j+1,8)) + + do ij = 1, icellu + i = indxui(ij) + j = indxuj(ij) + + ccaimp = umassdti(i,j) + vrel(i,j) * cosw + Cb(i,j) ! kg/m^2 s + + strintx = uarear(i,j)* & + (Drheo(i,j,1) + Drheo(i,j,2) + Drheo(i,j,3) + Drheo(i,j,4)) + strinty = uarear(i,j)* & + (Drheo(i,j,5) + Drheo(i,j,6) + Drheo(i,j,7) + Drheo(i,j,8)) + + diagx(i,j) = ccaimp - strintx + diagy(i,j) = ccaimp - strinty + enddo ! ij + + end subroutine formDiag_step2 + +!======================================================================= + +! Compute squared l^2 norm of a grid function (tpu,tpv) + + subroutine calc_L2norm_squared (nx_block, ny_block, & + icellu , & + indxui , indxuj , & + tpu , tpv , & + L2norm) + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellu ! total count when iceumask is true + + integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + tpu , & ! x-component of vector grid function + tpv ! y-component of vector grid function + + real (kind=dbl_kind), intent(out) :: & + L2norm ! squared l^2 norm of vector grid function (tpu,tpv) + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij + + character(len=*), parameter :: subname = '(calc_L2norm_squared)' + + !----------------------------------------------------------------- + ! compute squared l^2 norm of vector grid function (tpu,tpv) + !----------------------------------------------------------------- + + L2norm = c0 + + do ij = 1, icellu + i = indxui(ij) + j = indxuj(ij) + + L2norm = L2norm + tpu(i,j)**2 + tpv(i,j)**2 + enddo ! ij + + end subroutine calc_L2norm_squared + +!======================================================================= + +! Convert a grid function (tpu,tpv) to a one dimensional vector + + subroutine arrays_to_vec (nx_block, ny_block , & + nblocks , max_blocks, & + icellu , ntot , & + indxui , indxuj , & + tpu , tpv , & + outvec) + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + nblocks, & ! nb of blocks + max_blocks, & ! max nb of blocks + ntot ! size of problem for Anderson + + integer (kind=int_kind), dimension (max_blocks), intent(in) :: & + icellu + + integer (kind=int_kind), dimension (nx_block*ny_block, max_blocks), intent(in) :: & + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block, max_blocks), intent(in) :: & + tpu , & ! x-component of vector + tpv ! y-component of vector + + real (kind=dbl_kind), dimension (ntot), intent(out) :: & + outvec ! output 1D vector + + ! local variables + + integer (kind=int_kind) :: & + i, j, iblk, tot, ij + + character(len=*), parameter :: subname = '(arrays_to_vec)' + + !----------------------------------------------------------------- + ! form vector (converts from max_blocks arrays to single vector) + !----------------------------------------------------------------- + + outvec(:) = c0 + tot = 0 + + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + tot = tot + 1 + outvec(tot) = tpu(i, j, iblk) + tot = tot + 1 + outvec(tot) = tpv(i, j, iblk) + enddo + enddo ! ij + + end subroutine arrays_to_vec + +!======================================================================= + +! Convert one dimensional vector to a grid function (tpu,tpv) + + subroutine vec_to_arrays (nx_block, ny_block , & + nblocks , max_blocks, & + icellu , ntot , & + indxui , indxuj , & + invec , & + tpu , tpv) + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + nblocks, & ! nb of blocks + max_blocks, & ! max nb of blocks + ntot ! size of problem for Anderson + + integer (kind=int_kind), dimension (max_blocks), intent(in) :: & + icellu + + integer (kind=int_kind), dimension (nx_block*ny_block, max_blocks), intent(in) :: & + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (ntot), intent(in) :: & + invec ! input 1D vector + + real (kind=dbl_kind), dimension (nx_block,ny_block, max_blocks), intent(out) :: & + tpu , & ! x-component of vector + tpv ! y-component of vector + + ! local variables + + integer (kind=int_kind) :: & + i, j, iblk, tot, ij + + character(len=*), parameter :: subname = '(vec_to_arrays)' + + !----------------------------------------------------------------- + ! form arrays (converts from vector to the max_blocks arrays) + !----------------------------------------------------------------- + + tpu(:,:,:) = c0 + tpv(:,:,:) = c0 + tot = 0 + + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + tot = tot + 1 + tpu(i, j, iblk) = invec(tot) + tot = tot + 1 + tpv(i, j, iblk) = invec(tot) + enddo + enddo! ij + + end subroutine vec_to_arrays + +!======================================================================= + +! Update Q and R factors after deletion of the 1st column of G_diff +! +! author: P. Blain ECCC +! +! adapted from : +! H. F. Walker, “Anderson Acceleration: Algorithms and Implementations” +! [Online]. Available: https://users.wpi.edu/~walker/Papers/anderson_accn_algs_imps.pdf + + subroutine qr_delete(Q, R) + + real (kind=dbl_kind), intent(inout) :: & + Q(:,:), & ! Q factor + R(:,:) ! R factor + + ! local variables + + integer (kind=int_kind) :: & + i, j, k, & ! loop indices + m, n ! size of Q matrix + + real (kind=dbl_kind) :: & + temp, c, s + + character(len=*), parameter :: subname = '(qr_delete)' + + n = size(Q, 1) + m = size(Q, 2) + do i = 1, m-1 + temp = sqrt(R(i, i+1)**2 + R(i+1, i+1)**2) + c = R(i , i+1) / temp + s = R(i+1, i+1) / temp + R(i , i+1) = temp + R(i+1, i+1) = 0 + if (i < m-1) then + do j = i+2, m + temp = c*R(i, j) + s*R(i+1, j) + R(i+1, j) = -s*R(i, j) + c*R(i+1, j) + R(i , j) = temp + enddo + endif + do k = 1, n + temp = c*Q(k, i) + s*Q(k, i+1); + Q(k, i+1) = -s*Q(k, i) + c*Q(k, i+1); + Q(k, i) = temp + enddo + enddo + R(:, 1:m-1) = R(:, 2:m) + + end subroutine qr_delete + +!======================================================================= + +! FGMRES: Flexible generalized minimum residual method (with restarts). +! Solves the linear system A x = b using GMRES with a varying (right) preconditioner +! +! authors: Stéphane Gaudreault, Abdessamad Qaddouri, Philippe Blain, ECCC + + subroutine fgmres (zetaD , & + Cb , vrel , & + umassdti , & + halo_info_mask , & + bx , by , & + diagx , diagy , & + tolerance, maxinner, & + maxouter , & + solx , soly , & + nbiter) + + use ice_boundary, only: ice_HaloUpdate + use ice_domain, only: maskhalo_dyn, halo_info + use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound + + real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks,4), intent(in) :: & + zetaD ! zetaD = 2*zeta (viscous coefficient) + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks), intent(in) :: & + vrel , & ! coefficient for tauw + Cb , & ! seabed stress coefficient + umassdti ! mass of U-cell/dte (kg/m^2 s) + + type (ice_halo), intent(in) :: & + halo_info_mask ! ghost cell update info for masked halo + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks), intent(in) :: & + bx , & ! Right hand side of the linear system (x components) + by , & ! Right hand side of the linear system (y components) + diagx , & ! Diagonal of the system matrix (x components) + diagy ! Diagonal of the system matrix (y components) + + real (kind=dbl_kind), intent(in) :: & + tolerance ! Tolerance to achieve. The algorithm terminates when the relative + ! residual is below tolerance + + integer (kind=int_kind), intent(in) :: & + maxinner, & ! Restart the method every maxinner inner (Arnoldi) iterations + maxouter ! Maximum number of outer (restarts) iterations + ! Iteration will stop after maxinner*maxouter Arnoldi steps + ! even if the specified tolerance has not been achieved + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks), intent(inout) :: & + solx , & ! Initial guess on input, approximate solution on output (x components) + soly ! Initial guess on input, approximate solution on output (y components) + + integer (kind=int_kind), intent(out) :: & + nbiter ! Total number of Arnoldi iterations performed + + ! local variables + + integer (kind=int_kind) :: & + iblk , & ! block index + ij , & ! index for indx[t|u][i|j] + i, j ! grid indices + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & + workspace_x , & ! work vector (x components) + workspace_y ! work vector (y components) + + real (kind=dbl_kind), dimension (max_blocks) :: & + norm_squared ! array to accumulate squared norm of grid function over blocks + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks, maxinner+1) :: & + arnoldi_basis_x , & ! Arnoldi basis (x components) + arnoldi_basis_y ! Arnoldi basis (y components) + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks, maxinner) :: & + orig_basis_x , & ! original basis (x components) + orig_basis_y ! original basis (y components) + + real (kind=dbl_kind) :: & + norm_residual , & ! current L^2 norm of residual vector + inverse_norm , & ! inverse of the norm of a vector + nu, t ! local temporary values + + integer (kind=int_kind) :: & + initer , & ! inner (Arnoldi) loop counter + outiter , & ! outer (restarts) loop counter + nextit , & ! nextit == initer+1 + it, k, ii, jj ! reusable loop counters + + real (kind=dbl_kind), dimension(maxinner+1) :: & + rot_cos , & ! cosine elements of Givens rotations + rot_sin , & ! sine elements of Givens rotations + rhs_hess ! right hand side vector of the Hessenberg (least squares) system + + real (kind=dbl_kind), dimension(maxinner+1, maxinner) :: & + hessenberg ! system matrix of the Hessenberg (least squares) system + + character (len=char_len) :: & + precond_type ! type of preconditioner + + real (kind=dbl_kind) :: & + relative_tolerance ! relative_tolerance, i.e. tolerance*norm(initial residual) + + character(len=*), parameter :: subname = '(fgmres)' + + ! Here we go ! + + ! Initialize + outiter = 0 + nbiter = 0 + + norm_squared = c0 + precond_type = precond + + ! Cells with no ice should be zero-initialized + workspace_x = c0 + workspace_y = c0 + arnoldi_basis_x = c0 + arnoldi_basis_y = c0 + + ! Residual of the initial iterate + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call matvec (nx_block , ny_block , & + icellu (iblk) , icellt (iblk), & + indxui (:,iblk) , indxuj (:,iblk), & + indxti (:,iblk) , indxtj (:,iblk), & + dxt (:,:,iblk) , dyt (:,:,iblk), & + dxhy (:,:,iblk) , dyhx (:,:,iblk), & + cxp (:,:,iblk) , cyp (:,:,iblk), & + cxm (:,:,iblk) , cym (:,:,iblk), & + solx (:,:,iblk) , soly (:,:,iblk), & + vrel (:,:,iblk) , Cb (:,:,iblk), & + zetaD (:,:,iblk,:), & + umassdti (:,:,iblk) , fm (:,:,iblk), & + uarear (:,:,iblk) , & + workspace_x(:,:,iblk) , workspace_y(:,:,iblk)) + call residual_vec (nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj (:,iblk), & + bx (:,:,iblk), by (:,:,iblk), & + workspace_x(:,:,iblk), workspace_y(:,:,iblk), & + arnoldi_basis_x (:,:,iblk, 1), & + arnoldi_basis_y (:,:,iblk, 1)) + enddo + !$OMP END PARALLEL DO + + ! Start outer (restarts) loop + do + ! Compute norm of initial residual + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call calc_L2norm_squared(nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj(:,iblk), & + arnoldi_basis_x(:,:,iblk, 1) , & + arnoldi_basis_y(:,:,iblk, 1) , & + norm_squared(iblk)) + + enddo + !$OMP END PARALLEL DO + norm_residual = sqrt(global_sum(sum(norm_squared), distrb_info)) + + if (my_task == master_task .and. monitor_fgmres) then + write(nu_diag, '(a,i4,a,d26.16)') "monitor_fgmres: iter_fgmres= ", nbiter, & + " fgmres_L2norm= ", norm_residual + endif + + ! Current guess is a good enough solution TODO: reactivate and test this + ! if (norm_residual < tolerance) then + ! return + ! end if + + ! Normalize the first Arnoldi vector + inverse_norm = c1 / norm_residual + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + arnoldi_basis_x(i, j, iblk, 1) = arnoldi_basis_x(i, j, iblk, 1) * inverse_norm + arnoldi_basis_y(i, j, iblk, 1) = arnoldi_basis_y(i, j, iblk, 1) * inverse_norm + enddo ! ij + enddo + !$OMP END PARALLEL DO + + if (outiter == 0) then + relative_tolerance = tolerance * norm_residual + end if + + ! Initialize 1-st term of RHS of Hessenberg system + rhs_hess(1) = norm_residual + rhs_hess(2:) = c0 + + initer = 0 + + ! Start of inner (Arnoldi) loop + do + + nbiter = nbiter + 1 + initer = initer + 1 + nextit = initer + 1 + ! precondition the current Arnoldi vector + call precondition(zetaD , & + Cb , vrel , & + umassdti , & + arnoldi_basis_x(:,:,:,initer), & + arnoldi_basis_y(:,:,:,initer), & + diagx , diagy , & + precond_type, & + workspace_x , workspace_y) + orig_basis_x(:,:,:,initer) = workspace_x + orig_basis_y(:,:,:,initer) = workspace_y + + ! Update workspace with boundary values + call stack_velocity_field(workspace_x, workspace_y, 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, workspace_x, workspace_y) + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call matvec (nx_block , ny_block , & + icellu (iblk) , icellt (iblk), & + indxui (:,iblk) , indxuj (:,iblk), & + indxti (:,iblk) , indxtj (:,iblk), & + dxt (:,:,iblk) , dyt (:,:,iblk), & + dxhy (:,:,iblk) , dyhx (:,:,iblk), & + cxp (:,:,iblk) , cyp (:,:,iblk), & + cxm (:,:,iblk) , cym (:,:,iblk), & + workspace_x(:,:,iblk) , workspace_y(:,:,iblk), & + vrel (:,:,iblk) , Cb (:,:,iblk), & + zetaD (:,:,iblk,:), & + umassdti (:,:,iblk) , fm (:,:,iblk), & + uarear (:,:,iblk) , & + arnoldi_basis_x(:,:,iblk,nextit), & + arnoldi_basis_y(:,:,iblk,nextit)) + enddo + !$OMP END PARALLEL DO + + ! Orthogonalize the new vector + call orthogonalize(ortho_type , initer , & + nextit , maxinner , & + arnoldi_basis_x, arnoldi_basis_y, & + hessenberg) + + ! Compute norm of new Arnoldi vector and update Hessenberg matrix + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call calc_L2norm_squared(nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj(:, iblk) , & + arnoldi_basis_x(:,:,iblk, nextit), & + arnoldi_basis_y(:,:,iblk, nextit), & + norm_squared(iblk)) + enddo + !$OMP END PARALLEL DO + hessenberg(nextit,initer) = sqrt(global_sum(sum(norm_squared), distrb_info)) + + ! Watch out for happy breakdown + if (.not. almost_zero( hessenberg(nextit,initer) ) ) then + ! Normalize next Arnoldi vector + inverse_norm = c1 / hessenberg(nextit,initer) + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + arnoldi_basis_x(i, j, iblk, nextit) = arnoldi_basis_x(i, j, iblk, nextit)*inverse_norm + arnoldi_basis_y(i, j, iblk, nextit) = arnoldi_basis_y(i, j, iblk, nextit)*inverse_norm + enddo ! ij + enddo + !$OMP END PARALLEL DO + end if + + ! Apply previous Givens rotation to the last column of the Hessenberg matrix + if (initer > 1) then + do k = 2, initer + t = hessenberg(k-1, initer) + hessenberg(k-1, initer) = rot_cos(k-1)*t + rot_sin(k-1)*hessenberg(k, initer) + hessenberg(k, initer) = -rot_sin(k-1)*t + rot_cos(k-1)*hessenberg(k, initer) + end do + end if + + ! Compute and apply new Givens rotation + nu = sqrt(hessenberg(initer,initer)**2 + hessenberg(nextit,initer)**2) + if (.not. almost_zero(nu)) then + rot_cos(initer) = hessenberg(initer,initer) / nu + rot_sin(initer) = hessenberg(nextit,initer) / nu + + rhs_hess(nextit) = -rot_sin(initer) * rhs_hess(initer) + rhs_hess(initer) = rot_cos(initer) * rhs_hess(initer) + + hessenberg(initer,initer) = rot_cos(initer) * hessenberg(initer,initer) + rot_sin(initer) * hessenberg(nextit,initer) + end if + + ! Check for convergence + norm_residual = abs(rhs_hess(nextit)) + + if (my_task == master_task .and. monitor_fgmres) then + write(nu_diag, '(a,i4,a,d26.16)') "monitor_fgmres: iter_fgmres= ", nbiter, & + " fgmres_L2norm= ", norm_residual + endif + + if ((initer >= maxinner) .or. (norm_residual <= relative_tolerance)) then + exit + endif + + end do ! end of inner (Arnoldi) loop + + ! At this point either the maximum number of inner iterations + ! was reached or the absolute residual is below the scaled tolerance. + + ! Solve the (now upper triangular) system "hessenberg * sol_hess = rhs_hess" + ! (sol_hess is stored in rhs_hess) + rhs_hess(initer) = rhs_hess(initer) / hessenberg(initer,initer) + do ii = 2, initer + k = initer - ii + 1 + t = rhs_hess(k) + do j = k + 1, initer + t = t - hessenberg(k,j) * rhs_hess(j) + end do + rhs_hess(k) = t / hessenberg(k,k) + end do + + ! Form linear combination to get new solution iterate + do it = 1, initer + t = rhs_hess(it) + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + solx(i, j, iblk) = solx(i, j, iblk) + t * orig_basis_x(i, j, iblk, it) + soly(i, j, iblk) = soly(i, j, iblk) + t * orig_basis_y(i, j, iblk, it) + enddo ! ij + enddo + !$OMP END PARALLEL DO + end do + + ! Increment outer loop counter and check for convergence + outiter = outiter + 1 + if (norm_residual <= relative_tolerance .or. outiter >= maxouter) then + return + end if + + ! Solution is not convergent : compute residual vector and continue. + + ! The residual vector is computed here using (see Saad p. 177) : + ! \begin{equation} + ! r = V_{m+1} * Q_m^T * (\gamma_{m+1} * e_{m+1}) + ! \end{equation} + ! where : + ! $r$ is the residual + ! $V_{m+1}$ is a matrix whose columns are the Arnoldi vectors from 1 to nextit (m+1) + ! $Q_m$ is the product of the Givens rotation : Q_m = G_m G_{m-1} ... G_1 + ! $gamma_{m+1}$ is the last element of rhs_hess + ! $e_{m+1})$ is the unit vector (0, 0, ..., 1)^T \in \reals^{m+1} + + ! Apply the Givens rotation in reverse order to g := \gamma_{m+1} * e_{m+1}, + ! store the result in rhs_hess + do it = 1, initer + jj = nextit - it + 1 + rhs_hess(jj-1) = -rot_sin(jj-1) * rhs_hess(jj) ! + rot_cos(jj-1) * g(jj-1) (== 0) + rhs_hess(jj) = rot_cos(jj-1) * rhs_hess(jj) ! + rot_sin(jj-1) * g(jj-1) (== 0) + end do + + ! Compute the residual by multiplying V_{m+1} and rhs_hess + workspace_x = c0 + workspace_y = c0 + do it = 1, nextit + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + workspace_x(i, j, iblk) = workspace_x(i, j, iblk) + rhs_hess(it) * arnoldi_basis_x(i, j, iblk, it) + workspace_y(i, j, iblk) = workspace_x(i, j, iblk) + rhs_hess(it) * arnoldi_basis_y(i, j, iblk, it) + enddo ! ij + enddo + !$OMP END PARALLEL DO + arnoldi_basis_x(:,:,:,1) = workspace_x + arnoldi_basis_y(:,:,:,1) = workspace_y + end do + end do ! end of outer (restarts) loop + + end subroutine fgmres + +!======================================================================= + +! PGMRES: Right-preconditioned generalized minimum residual method (with restarts). +! Solves the linear A x = b using GMRES with a right preconditioner +! +! authors: Stéphane Gaudreault, Abdessamad Qaddouri, Philippe Blain, ECCC + + subroutine pgmres (zetaD , & + Cb , vrel , & + umassdti , & + bx , by , & + diagx , diagy , & + tolerance, maxinner, & + maxouter , & + solx , soly , & + nbiter) + + real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks,4), intent(in) :: & + zetaD ! zetaD = 2*zeta (viscous coefficient) + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks), intent(in) :: & + vrel , & ! coefficient for tauw + Cb , & ! seabed stress coefficient + umassdti ! mass of U-cell/dte (kg/m^2 s) + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks), intent(in) :: & + bx , & ! Right hand side of the linear system (x components) + by ! Right hand side of the linear system (y components) + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks), intent(in) :: & + diagx , & ! Diagonal of the system matrix (x components) + diagy ! Diagonal of the system matrix (y components) + + real (kind=dbl_kind), intent(in) :: & + tolerance ! Tolerance to achieve. The algorithm terminates when the relative + ! residual is below tolerance + + integer (kind=int_kind), intent(in) :: & + maxinner, & ! Restart the method every maxinner inner (Arnoldi) iterations + maxouter ! Maximum number of outer (restarts) iterations + ! Iteration will stop after maxinner*maxouter Arnoldi steps + ! even if the specified tolerance has not been achieved + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks), intent(inout) :: & + solx , & ! Initial guess on input, approximate solution on output (x components) + soly ! Initial guess on input, approximate solution on output (y components) + + integer (kind=int_kind), intent(out) :: & + nbiter ! Total number of Arnoldi iterations performed + + ! local variables + + integer (kind=int_kind) :: & + iblk , & ! block index + ij , & ! index for indx[t|u][i|j] + i, j ! grid indices + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & + workspace_x , & ! work vector (x components) + workspace_y ! work vector (y components) + + real (kind=dbl_kind), dimension (max_blocks) :: & + norm_squared ! array to accumulate squared norm of grid function over blocks + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks, maxinner+1) :: & + arnoldi_basis_x , & ! Arnoldi basis (x components) + arnoldi_basis_y ! Arnoldi basis (y components) + + real (kind=dbl_kind) :: & + norm_residual , & ! current L^2 norm of residual vector + inverse_norm , & ! inverse of the norm of a vector + nu, t ! local temporary values + + integer (kind=int_kind) :: & + initer , & ! inner (Arnoldi) loop counter + outiter , & ! outer (restarts) loop counter + nextit , & ! nextit == initer+1 + it, k, ii, jj ! reusable loop counters + + real (kind=dbl_kind), dimension(maxinner+1) :: & + rot_cos , & ! cosine elements of Givens rotations + rot_sin , & ! sine elements of Givens rotations + rhs_hess ! right hand side vector of the Hessenberg (least squares) system + + real (kind=dbl_kind), dimension(maxinner+1, maxinner) :: & + hessenberg ! system matrix of the Hessenberg (least squares) system + + character(len=char_len) :: & + precond_type , & ! type of preconditioner + ortho_type ! type of orthogonalization + + real (kind=dbl_kind) :: & + relative_tolerance ! relative_tolerance, i.e. tolerance*norm(initial residual) + + character(len=*), parameter :: subname = '(pgmres)' + + ! Here we go ! + + ! Initialize + outiter = 0 + nbiter = 0 + + norm_squared = c0 + precond_type = 'diag' ! Jacobi preconditioner + ortho_type = 'cgs' ! classical gram-schmidt TODO: try with MGS + + ! Cells with no ice should be zero-initialized + workspace_x = c0 + workspace_y = c0 + arnoldi_basis_x = c0 + arnoldi_basis_y = c0 + + ! Residual of the initial iterate + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call matvec (nx_block , ny_block , & + icellu (iblk) , icellt (iblk), & + indxui (:,iblk) , indxuj (:,iblk), & + indxti (:,iblk) , indxtj (:,iblk), & + dxt (:,:,iblk) , dyt (:,:,iblk), & + dxhy (:,:,iblk) , dyhx (:,:,iblk), & + cxp (:,:,iblk) , cyp (:,:,iblk), & + cxm (:,:,iblk) , cym (:,:,iblk), & + solx (:,:,iblk) , soly (:,:,iblk), & + vrel (:,:,iblk) , Cb (:,:,iblk), & + zetaD (:,:,iblk,:), & + umassdti (:,:,iblk) , fm (:,:,iblk), & + uarear (:,:,iblk) , & + workspace_x(:,:,iblk) , workspace_y(:,:,iblk)) + call residual_vec (nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj (:,iblk), & + bx (:,:,iblk), by (:,:,iblk), & + workspace_x(:,:,iblk), workspace_y(:,:,iblk), & + arnoldi_basis_x (:,:,iblk, 1), & + arnoldi_basis_y (:,:,iblk, 1)) + enddo + !$OMP END PARALLEL DO + + ! Start outer (restarts) loop + do + ! Compute norm of initial residual + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call calc_L2norm_squared(nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj(:, iblk), & + arnoldi_basis_x(:,:,iblk, 1), & + arnoldi_basis_y(:,:,iblk, 1), & + norm_squared(iblk)) + + enddo + !$OMP END PARALLEL DO + norm_residual = sqrt(global_sum(sum(norm_squared), distrb_info)) + + if (my_task == master_task .and. monitor_pgmres) then + write(nu_diag, '(a,i4,a,d26.16)') "monitor_pgmres: iter_pgmres= ", nbiter, & + " pgmres_L2norm= ", norm_residual + endif + + ! Current guess is a good enough solution + ! if (norm_residual < tolerance) then + ! return + ! end if + + ! Normalize the first Arnoldi vector + inverse_norm = c1 / norm_residual + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + arnoldi_basis_x(i, j, iblk, 1) = arnoldi_basis_x(i, j, iblk, 1) * inverse_norm + arnoldi_basis_y(i, j, iblk, 1) = arnoldi_basis_y(i, j, iblk, 1) * inverse_norm + enddo ! ij + enddo + !$OMP END PARALLEL DO + + if (outiter == 0) then + relative_tolerance = tolerance * norm_residual + end if + + ! Initialize 1-st term of RHS of Hessenberg system + rhs_hess(1) = norm_residual + rhs_hess(2:) = c0 + + initer = 0 + + ! Start of inner (Arnoldi) loop + do + + nbiter = nbiter + 1 + initer = initer + 1 + nextit = initer + 1 + + ! precondition the current Arnoldi vector + call precondition(zetaD , & + Cb , vrel , & + umassdti , & + arnoldi_basis_x(:,:,:,initer), & + arnoldi_basis_y(:,:,:,initer), & + diagx , diagy , & + precond_type, & + workspace_x , workspace_y) + + ! NOTE: halo updates for (workspace_x, workspace_y) + ! are skipped here for efficiency since this is just a preconditioner + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call matvec (nx_block , ny_block , & + icellu (iblk) , icellt (iblk), & + indxui (:,iblk) , indxuj (:,iblk), & + indxti (:,iblk) , indxtj (:,iblk), & + dxt (:,:,iblk) , dyt (:,:,iblk), & + dxhy (:,:,iblk) , dyhx (:,:,iblk), & + cxp (:,:,iblk) , cyp (:,:,iblk), & + cxm (:,:,iblk) , cym (:,:,iblk), & + workspace_x(:,:,iblk) , workspace_y(:,:,iblk), & + vrel (:,:,iblk) , Cb (:,:,iblk), & + zetaD (:,:,iblk,:), & + umassdti (:,:,iblk) , fm (:,:,iblk), & + uarear (:,:,iblk) , & + arnoldi_basis_x(:,:,iblk,nextit), & + arnoldi_basis_y(:,:,iblk,nextit)) + enddo + !$OMP END PARALLEL DO + + ! Orthogonalize the new vector + call orthogonalize(ortho_type , initer , & + nextit , maxinner , & + arnoldi_basis_x, arnoldi_basis_y, & + hessenberg) + + ! Compute norm of new Arnoldi vector and update Hessenberg matrix + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call calc_L2norm_squared(nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj(:, iblk) , & + arnoldi_basis_x(:,:,iblk, nextit), & + arnoldi_basis_y(:,:,iblk, nextit), & + norm_squared(iblk)) + enddo + !$OMP END PARALLEL DO + hessenberg(nextit,initer) = sqrt(global_sum(sum(norm_squared), distrb_info)) + + ! Watch out for happy breakdown + if (.not. almost_zero( hessenberg(nextit,initer) ) ) then + ! Normalize next Arnoldi vector + inverse_norm = c1 / hessenberg(nextit,initer) + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + arnoldi_basis_x(i, j, iblk, nextit) = arnoldi_basis_x(i, j, iblk, nextit)*inverse_norm + arnoldi_basis_y(i, j, iblk, nextit) = arnoldi_basis_y(i, j, iblk, nextit)*inverse_norm + enddo ! ij + enddo + !$OMP END PARALLEL DO + end if + + ! Apply previous Givens rotation to the last column of the Hessenberg matrix + if (initer > 1) then + do k = 2, initer + t = hessenberg(k-1, initer) + hessenberg(k-1, initer) = rot_cos(k-1)*t + rot_sin(k-1)*hessenberg(k, initer) + hessenberg(k, initer) = -rot_sin(k-1)*t + rot_cos(k-1)*hessenberg(k, initer) + end do + end if + + ! Compute and apply new Givens rotation + nu = sqrt(hessenberg(initer,initer)**2 + hessenberg(nextit,initer)**2) + if (.not. almost_zero(nu)) then + rot_cos(initer) = hessenberg(initer,initer) / nu + rot_sin(initer) = hessenberg(nextit,initer) / nu + + rhs_hess(nextit) = -rot_sin(initer) * rhs_hess(initer) + rhs_hess(initer) = rot_cos(initer) * rhs_hess(initer) + + hessenberg(initer,initer) = rot_cos(initer) * hessenberg(initer,initer) + rot_sin(initer) * hessenberg(nextit,initer) + end if + + ! Check for convergence + norm_residual = abs(rhs_hess(nextit)) + + if (my_task == master_task .and. monitor_pgmres) then + write(nu_diag, '(a,i4,a,d26.16)') "monitor_pgmres: iter_pgmres= ", nbiter, & + " pgmres_L2norm= ", norm_residual + endif + + if ((initer >= maxinner) .or. (norm_residual <= relative_tolerance)) then + exit + endif + + end do ! end of inner (Arnoldi) loop + + ! At this point either the maximum number of inner iterations + ! was reached or the absolute residual is below the scaled tolerance. + + ! Solve the (now upper triangular) system "hessenberg * sol_hess = rhs_hess" + ! (sol_hess is stored in rhs_hess) + rhs_hess(initer) = rhs_hess(initer) / hessenberg(initer,initer) + do ii = 2, initer + k = initer - ii + 1 + t = rhs_hess(k) + do j = k + 1, initer + t = t - hessenberg(k,j) * rhs_hess(j) + end do + rhs_hess(k) = t / hessenberg(k,k) + end do + + ! Form linear combination to get new solution iterate + workspace_x = c0 + workspace_y = c0 + do it = 1, initer + t = rhs_hess(it) + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + workspace_x(i, j, iblk) = workspace_x(i, j, iblk) + t * arnoldi_basis_x(i, j, iblk, it) + workspace_y(i, j, iblk) = workspace_y(i, j, iblk) + t * arnoldi_basis_y(i, j, iblk, it) + enddo ! ij + enddo + !$OMP END PARALLEL DO + end do + + ! Call preconditioner + call precondition(zetaD , & + Cb , vrel , & + umassdti , & + workspace_x , workspace_y, & + diagx , diagy , & + precond_type, & + workspace_x , workspace_y) + + solx = solx + workspace_x + soly = soly + workspace_y + + ! Increment outer loop counter and check for convergence + outiter = outiter + 1 + if (norm_residual <= relative_tolerance .or. outiter >= maxouter) then + return + end if + + ! Solution is not convergent : compute residual vector and continue. + + ! The residual vector is computed here using (see Saad p. 177) : + ! \begin{equation} + ! r = V_{m+1} * Q_m^T * (\gamma_{m+1} * e_{m+1}) + ! \end{equation} + ! where : + ! $r$ is the residual + ! $V_{m+1}$ is a matrix whose columns are the Arnoldi vectors from 1 to nextit (m+1) + ! $Q_m$ is the product of the Givens rotation : Q_m = G_m G_{m-1} ... G_1 + ! $gamma_{m+1}$ is the last element of rhs_hess + ! $e_{m+1})$ is the unit vector (0, 0, ..., 1)^T \in \reals^{m+1} + + ! Apply the Givens rotation in reverse order to g := \gamma_{m+1} * e_{m+1}, + ! store the result in rhs_hess + do it = 1, initer + jj = nextit - it + 1 + rhs_hess(jj-1) = -rot_sin(jj-1) * rhs_hess(jj) ! + rot_cos(jj-1) * g(jj-1) (== 0) + rhs_hess(jj) = rot_cos(jj-1) * rhs_hess(jj) ! + rot_sin(jj-1) * g(jj-1) (== 0) + end do + + ! Compute the residual by multiplying V_{m+1} and rhs_hess + workspace_x = c0 + workspace_y = c0 + do it = 1, nextit + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + workspace_x(i, j, iblk) = workspace_x(i, j, iblk) + rhs_hess(it) * arnoldi_basis_x(i, j, iblk, it) + workspace_y(i, j, iblk) = workspace_x(i, j, iblk) + rhs_hess(it) * arnoldi_basis_y(i, j, iblk, it) + enddo ! ij + enddo + !$OMP END PARALLEL DO + arnoldi_basis_x(:,:,:,1) = workspace_x + arnoldi_basis_y(:,:,:,1) = workspace_y + end do + end do ! end of outer (restarts) loop + + end subroutine pgmres + +!======================================================================= + +! Generic routine to precondition a vector +! +! authors: Philippe Blain, ECCC + + subroutine precondition(zetaD , & + Cb , vrel , & + umassdti , & + vx , vy , & + diagx , diagy, & + precond_type, & + wx , wy) + + real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks,4), intent(in) :: & + zetaD ! zetaD = 2*zeta (viscous coefficient) + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks), intent(in) :: & + vrel , & ! coefficient for tauw + Cb , & ! seabed stress coefficient + umassdti ! mass of U-cell/dte (kg/m^2 s) + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), intent(in) :: & + vx , & ! input vector (x components) + vy ! input vector (y components) + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), intent(in) :: & + diagx , & ! diagonal of the system matrix (x components) + diagy ! diagonal of the system matrix (y components) + + character (len=char_len), intent(in) :: & + precond_type ! type of preconditioner + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), intent(inout) :: & + wx , & ! preconditionned vector (x components) + wy ! preconditionned vector (y components) + + ! local variables + + integer (kind=int_kind) :: & + iblk , & ! block index + ij , & ! compressed index + i, j ! grid indices + + real (kind=dbl_kind) :: & + tolerance ! Tolerance for PGMRES + + integer (kind=int_kind) :: & + maxinner ! Restart parameter for PGMRES + + integer (kind=int_kind) :: & + maxouter ! Maximum number of outer iterations for PGMRES + + integer (kind=int_kind) :: & + nbiter ! Total number of iteration PGMRES performed + + character(len=*), parameter :: subname = '(precondition)' + + if (precond_type == 'ident') then ! identity (no preconditioner) + wx = vx + wy = vy + elseif (precond_type == 'diag') then ! Jacobi preconditioner (diagonal) + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + wx(i,j,iblk) = vx(i,j,iblk) / diagx(i,j,iblk) + wy(i,j,iblk) = vy(i,j,iblk) / diagy(i,j,iblk) + enddo ! ij + enddo + !$OMP END PARALLEL DO + elseif (precond_type == 'pgmres') then ! PGMRES (Jacobi-preconditioned GMRES) + ! Initialize preconditioned vector to 0 ! TODO: try with wx = vx or vx/diagx + wx = c0 + wy = c0 + tolerance = reltol_pgmres + maxinner = dim_pgmres + maxouter = maxits_pgmres + call pgmres (zetaD, & + Cb , vrel , & + umassdti , & + vx , vy , & + diagx , diagy , & + tolerance, maxinner, & + maxouter , & + wx , wy , & + nbiter) + else + call abort_ice(error_message='wrong preconditioner in ' // subname, & + file=__FILE__, line=__LINE__) + endif + end subroutine precondition + +!======================================================================= + +! Generic routine to orthogonalize a vector (arnoldi_basis_[xy](:, :, :, nextit)) +! against a set of vectors (arnoldi_basis_[xy](:, :, :, 1:initer)) +! +! authors: Philippe Blain, ECCC + + subroutine orthogonalize(ortho_type , initer , & + nextit , maxinner , & + arnoldi_basis_x, arnoldi_basis_y, & + hessenberg) + + character(len=*), intent(in) :: & + ortho_type ! type of orthogonalization + + integer (kind=int_kind), intent(in) :: & + initer , & ! inner (Arnoldi) loop counter + nextit , & ! nextit == initer+1 + maxinner ! Restart the method every maxinner inner iterations + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks, maxinner+1), intent(inout) :: & + arnoldi_basis_x , & ! arnoldi basis (x components) + arnoldi_basis_y ! arnoldi basis (y components) + + real (kind=dbl_kind), dimension(maxinner+1, maxinner), intent(inout) :: & + hessenberg ! system matrix of the Hessenberg (least squares) system + + ! local variables + + integer (kind=int_kind) :: & + it , & ! reusable loop counter + iblk , & ! block index + ij , & ! compressed index + i, j ! grid indices + + real (kind=dbl_kind), dimension (max_blocks) :: & + local_dot ! local array value to accumulate dot product of grid function over blocks + + real (kind=dbl_kind), dimension(maxinner) :: & + dotprod_local ! local array to accumulate several dot product computations + + character(len=*), parameter :: subname = '(orthogonalize)' + + if (trim(ortho_type) == 'cgs') then ! Classical Gram-Schmidt + ! Classical Gram-Schmidt orthogonalisation process + ! First loop of Gram-Schmidt (compute coefficients) + dotprod_local = c0 + do it = 1, initer + local_dot = c0 + + !$OMP PARALLEL DO PRIVATE(iblk, ij, i, j) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + local_dot(iblk) = local_dot(iblk) + & + (arnoldi_basis_x(i, j, iblk, it) * arnoldi_basis_x(i, j, iblk, nextit)) + & + (arnoldi_basis_y(i, j, iblk, it) * arnoldi_basis_y(i, j, iblk, nextit)) + enddo ! ij + enddo + !$OMP END PARALLEL DO + + dotprod_local(it) = sum(local_dot) + end do + + hessenberg(1:initer, initer) = global_allreduce_sum(dotprod_local(1:initer), distrb_info) + + ! Second loop of Gram-Schmidt (orthonormalize) + do it = 1, initer + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + arnoldi_basis_x(i, j, iblk, nextit) = arnoldi_basis_x(i, j, iblk, nextit) & + - hessenberg(it,initer) * arnoldi_basis_x(i, j, iblk, it) + arnoldi_basis_y(i, j, iblk, nextit) = arnoldi_basis_y(i, j, iblk, nextit) & + - hessenberg(it,initer) * arnoldi_basis_y(i, j, iblk, it) + enddo ! ij + enddo + !$OMP END PARALLEL DO + end do + elseif (trim(ortho_type) == 'mgs') then ! Modified Gram-Schmidt + ! Modified Gram-Schmidt orthogonalisation process + do it = 1, initer + local_dot = c0 + + !$OMP PARALLEL DO PRIVATE(iblk, ij, i, j) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + local_dot(iblk) = local_dot(iblk) + & + (arnoldi_basis_x(i, j, iblk, it) * arnoldi_basis_x(i, j, iblk, nextit)) + & + (arnoldi_basis_y(i, j, iblk, it) * arnoldi_basis_y(i, j, iblk, nextit)) + enddo ! ij + enddo + !$OMP END PARALLEL DO + + hessenberg(it,initer) = global_sum(sum(local_dot), distrb_info) + + !$OMP PARALLEL DO PRIVATE(iblk, ij, i, j) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + arnoldi_basis_x(i, j, iblk, nextit) = arnoldi_basis_x(i, j, iblk, nextit) & + - hessenberg(it,initer) * arnoldi_basis_x(i, j, iblk, it) + arnoldi_basis_y(i, j, iblk, nextit) = arnoldi_basis_y(i, j, iblk, nextit) & + - hessenberg(it,initer) * arnoldi_basis_y(i, j, iblk, it) + enddo ! ij + enddo + !$OMP END PARALLEL DO + end do + else + call abort_ice(error_message='wrong orthonalization in ' // subname, & + file=__FILE__, line=__LINE__) + endif + + end subroutine orthogonalize + +!======================================================================= + +! Check if value A is close to zero, up to machine precision +! +!author +! Stéphane Gaudreault, ECCC -- June 2014 +! +!revision +! v4-80 - Gaudreault S. - gfortran compatibility +! 2019 - Philippe Blain, ECCC - converted to CICE standards + + logical function almost_zero(A) result(retval) + + real (kind=dbl_kind), intent(in) :: A + + ! local variables + + character(len=*), parameter :: subname = '(almost_zero)' + + integer (kind=int8_kind) :: aBit + integer (kind=int8_kind), parameter :: two_complement = int(Z'80000000', kind=int8_kind) + aBit = 0 + aBit = transfer(A, aBit) + if (aBit < 0) then + aBit = two_complement - aBit + end if + ! lexicographic order test with a tolerance of 1 adjacent float + retval = (abs(aBit) <= 1) + + end function almost_zero + +!======================================================================= + + end module ice_dyn_vp + +!======================================================================= diff --git a/cicecore/cicedynB/general/ice_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index f2eaae17d..fb9c45978 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -100,6 +100,11 @@ subroutine input_data basalstress, k1, k2, alphab, threshold_hw, & Ktens, e_ratio, coriolis, ssh_stress, & kridge, ktransport, brlx, arlx + use ice_dyn_vp, only: maxits_nonlin, precond, dim_fgmres, dim_pgmres, maxits_fgmres, & + maxits_pgmres, monitor_nonlin, monitor_fgmres, & + monitor_pgmres, reltol_nonlin, reltol_fgmres, reltol_pgmres, & + algo_nonlin, fpfunc_andacc, dim_andacc, reltol_andacc, & + damping_andacc, start_andacc, use_mean_vrel, ortho_type use ice_transport_driver, only: advection, conserv_check use ice_restoring, only: restore_ice #ifdef CESMCOUPLED @@ -194,7 +199,13 @@ subroutine input_data advection, coriolis, kridge, ktransport, & kstrength, krdg_partic, krdg_redist, mu_rdg, & e_ratio, Ktens, Cf, basalstress, & - k1, k2, alphab, threshold_hw, & + k1, maxits_nonlin, precond, dim_fgmres, & + dim_pgmres, maxits_fgmres, maxits_pgmres, monitor_nonlin, & + monitor_fgmres, monitor_pgmres, reltol_nonlin, reltol_fgmres, & + reltol_pgmres, algo_nonlin, dim_andacc, reltol_andacc, & + damping_andacc, start_andacc, fpfunc_andacc, use_mean_vrel, & + ortho_type, & + k2, alphab, threshold_hw, & Pstar, Cstar namelist /shortwave_nml/ & @@ -322,7 +333,27 @@ subroutine input_data alphab = 20.0_dbl_kind ! alphab=Cb factor in Lemieux et al 2015 threshold_hw = 30.0_dbl_kind ! max water depth for grounding Ktens = 0.0_dbl_kind ! T=Ktens*P (tensile strength: see Konig and Holland, 2010) - e_ratio = 2.0_dbl_kind ! EVP ellipse aspect ratio + e_ratio = 2.0_dbl_kind ! VP ellipse aspect ratio + maxits_nonlin = 4 ! max nb of iteration for nonlinear solver + precond = 'pgmres' ! preconditioner for fgmres: 'ident' (identity), 'diag' (diagonal), 'pgmres' (Jacobi-preconditioned GMRES) + dim_fgmres = 50 ! size of fgmres Krylov subspace + dim_pgmres = 5 ! size of pgmres Krylov subspace + maxits_fgmres = 50 ! max nb of iteration for fgmres + maxits_pgmres = 5 ! max nb of iteration for pgmres + monitor_nonlin = .false. ! print nonlinear residual norm + monitor_fgmres = .false. ! print fgmres residual norm + monitor_pgmres = .false. ! print pgmres residual norm + ortho_type = 'mgs' ! orthogonalization procedure 'cgs' or 'mgs' + reltol_nonlin = 1e-8_dbl_kind ! nonlinear stopping criterion: reltol_nonlin*res(k=0) + reltol_fgmres = 1e-2_dbl_kind ! fgmres stopping criterion: reltol_fgmres*res(k) + reltol_pgmres = 1e-6_dbl_kind ! pgmres stopping criterion: reltol_pgmres*res(k) + algo_nonlin = 'picard' ! nonlinear algorithm: 'picard' (Picard iteration), 'anderson' (Anderson acceleration) + fpfunc_andacc = 1 ! fixed point function for Anderson acceleration: 1: g(x) = FMGRES(A(x),b(x)), 2: g(x) = x - A(x)x + b(x) + dim_andacc = 5 ! size of Anderson minimization matrix (number of saved previous residuals) + reltol_andacc = 1e-6_dbl_kind ! relative tolerance for Anderson acceleration + damping_andacc = 0 ! damping factor for Anderson acceleration + start_andacc = 0 ! acceleration delay factor (acceleration starts at this iteration) + use_mean_vrel = .true. ! use mean of previous 2 iterates to compute vrel advection = 'remap' ! incremental remapping transport scheme conserv_check = .false.! tracer conservation check shortwave = 'ccsm3' ! 'ccsm3' or 'dEdd' (delta-Eddington) @@ -628,6 +659,26 @@ subroutine input_data call broadcast_scalar(ssh_stress, master_task) call broadcast_scalar(kridge, master_task) call broadcast_scalar(ktransport, master_task) + call broadcast_scalar(maxits_nonlin, master_task) + call broadcast_scalar(precond, master_task) + call broadcast_scalar(dim_fgmres, master_task) + call broadcast_scalar(dim_pgmres, master_task) + call broadcast_scalar(maxits_fgmres, master_task) + call broadcast_scalar(maxits_pgmres, master_task) + call broadcast_scalar(monitor_nonlin, master_task) + call broadcast_scalar(monitor_fgmres, master_task) + call broadcast_scalar(monitor_pgmres, master_task) + call broadcast_scalar(ortho_type, master_task) + call broadcast_scalar(reltol_nonlin, master_task) + call broadcast_scalar(reltol_fgmres, master_task) + call broadcast_scalar(reltol_pgmres, master_task) + call broadcast_scalar(algo_nonlin, master_task) + call broadcast_scalar(fpfunc_andacc, master_task) + call broadcast_scalar(dim_andacc, master_task) + call broadcast_scalar(reltol_andacc, master_task) + call broadcast_scalar(damping_andacc, master_task) + call broadcast_scalar(start_andacc, master_task) + call broadcast_scalar(use_mean_vrel, master_task) call broadcast_scalar(conduct, master_task) call broadcast_scalar(R_ice, master_task) call broadcast_scalar(R_pnd, master_task) @@ -831,7 +882,7 @@ subroutine input_data revised_evp = .false. endif - if (kdyn > 2) then + if (kdyn > 3) then if (my_task == master_task) then write(nu_diag,*) subname//' WARNING: kdyn out of range' endif @@ -1037,6 +1088,38 @@ subroutine input_data endif endif + ! Implicit solver input validation + if (kdyn == 3) then + if (.not. (trim(algo_nonlin) == 'picard' .or. trim(algo_nonlin) == 'anderson')) then + if (my_task == master_task) then + write(nu_diag,*) subname//' ERROR: unknown algo_nonlin: '//algo_nonlin + write(nu_diag,*) subname//' ERROR: allowed values: ''picard'', ''anderson''' + endif + abort_list = trim(abort_list)//":60" + endif + + if (trim(algo_nonlin) == 'picard') then + ! Picard solver is implemented in the Anderson solver; reset number of saved residuals to zero + dim_andacc = 0 + endif + + if (.not. (trim(precond) == 'ident' .or. trim(precond) == 'diag' .or. trim(precond) == 'pgmres')) then + if (my_task == master_task) then + write(nu_diag,*) subname//' ERROR: unknown precond: '//precond + write(nu_diag,*) subname//' ERROR: allowed values: ''ident'', ''diag'', ''pgmres''' + endif + abort_list = trim(abort_list)//":61" + endif + + if (.not. (trim(ortho_type) == 'cgs' .or. trim(ortho_type) == 'mgs')) then + if (my_task == master_task) then + write(nu_diag,*) subname//' ERROR: unknown ortho_type: '//ortho_type + write(nu_diag,*) subname//' ERROR: allowed values: ''cgs'', ''mgs''' + endif + abort_list = trim(abort_list)//":62" + endif + endif + ice_IOUnitsMinUnit = numin ice_IOUnitsMaxUnit = numax @@ -1139,28 +1222,35 @@ subroutine input_data write(nu_diag,*) '--------------------------------' if (kdyn == 1) then tmpstr2 = ' elastic-viscous-plastic dynamics' - write(nu_diag,*) 'yield_curve = ', trim(yield_curve) - if (trim(yield_curve) == 'ellipse') & - write(nu_diag,1007) ' e_ratio = ', e_ratio, ' aspect ratio of ellipse' elseif (kdyn == 2) then tmpstr2 = ' elastic-anisotropic-plastic dynamics' + elseif (kdyn == 3) then + tmpstr2 = ' viscous-plastic dynamics' elseif (kdyn < 1) then tmpstr2 = ' dynamics disabled' endif write(nu_diag,1022) ' kdyn = ', kdyn,trim(tmpstr2) if (kdyn >= 1) then - if (revised_evp) then - tmpstr2 = ' revised EVP formulation used' - else - tmpstr2 = ' revised EVP formulation not used' - endif - write(nu_diag,1012) ' revised_evp = ', revised_evp,trim(tmpstr2) - write(nu_diag,1022) ' kevp_kernel = ', kevp_kernel,' EVP solver' + if (kdyn == 1 .or. kdyn == 2) then + if (revised_evp) then + tmpstr2 = ' revised EVP formulation used' + write(nu_diag,1007) ' arlx = ', arlx, ' stress equation factor alpha' + write(nu_diag,1007) ' brlx = ', brlx, ' stress equation factor beta' + else + tmpstr2 = ' revised EVP formulation not used' + endif + write(nu_diag,1012) ' revised_evp = ', revised_evp,trim(tmpstr2) + write(nu_diag,1022) ' kevp_kernel = ', kevp_kernel,' EVP solver' + + write(nu_diag,1022) ' ndtd = ', ndtd, ' number of dynamics/advection/ridging/steps per thermo timestep' + write(nu_diag,1022) ' ndte = ', ndte, ' number of EVP or EAP subcycles' + endif - write(nu_diag,1022) ' ndtd = ', ndtd, ' number of dynamics/advection/ridging/steps per thermo timestep' - write(nu_diag,1022) ' ndte = ', ndte, ' number of EVP or EAP subcycles' - write(nu_diag,1007) ' arlx = ', arlx, ' stress equation factor alpha' - write(nu_diag,1007) ' brlx = ', brlx, ' stress equation factor beta' + if (kdyn == 1 .or. kdyn == 3) then + write(nu_diag,*) 'yield_curve = ', trim(yield_curve) + if (trim(yield_curve) == 'ellipse') & + write(nu_diag,1007) ' e_ratio = ', e_ratio, ' aspect ratio of ellipse' + endif if (trim(coriolis) == 'latitude') then tmpstr2 = ': latitude-dependent Coriolis parameter' @@ -1524,6 +1614,31 @@ subroutine input_data write(nu_diag,1010) ' orca_halogrid = ', & orca_halogrid + if (kdyn == 3) then + write(nu_diag,1020) ' maxits_nonlin = ', maxits_nonlin + write(nu_diag,1030) ' precond = ', precond + write(nu_diag,1020) ' dim_fgmres = ', dim_fgmres + write(nu_diag,1020) ' dim_pgmres = ', dim_pgmres + write(nu_diag,1020) ' maxits_fgmres = ', maxits_fgmres + write(nu_diag,1020) ' maxits_pgmres = ', maxits_pgmres + write(nu_diag,1010) ' monitor_nonlin = ', monitor_nonlin + write(nu_diag,1010) ' monitor_fgmres = ', monitor_fgmres + write(nu_diag,1010) ' monitor_pgmres = ', monitor_pgmres + write(nu_diag,1030) ' ortho_type = ', ortho_type + write(nu_diag,1008) ' reltol_nonlin = ', reltol_nonlin + write(nu_diag,1008) ' reltol_fgmres = ', reltol_fgmres + write(nu_diag,1008) ' reltol_pgmres = ', reltol_pgmres + write(nu_diag,1030) ' algo_nonlin = ', algo_nonlin + write(nu_diag,1010) ' use_mean_vrel = ', use_mean_vrel + if (algo_nonlin == 'anderson') then + write(nu_diag,1020) ' fpfunc_andacc = ', fpfunc_andacc + write(nu_diag,1020) ' dim_andacc = ', dim_andacc + write(nu_diag,1008) ' reltol_andacc = ', reltol_andacc + write(nu_diag,1005) ' damping_andacc = ', damping_andacc + write(nu_diag,1020) ' start_andacc = ', start_andacc + endif + endif + write(nu_diag,1010) ' conserv_check = ', conserv_check write(nu_diag,1020) ' fyear_init = ', & @@ -1675,6 +1790,7 @@ subroutine input_data 1005 format (a30,2x,f12.6) ! float 1006 format (a20,2x,f10.6,a) 1007 format (a20,2x,f6.2,a) + 1008 format (a30,2x,d13.6) ! float, exponential notation 1009 format (a20,2x,d13.6,a) ! float, exponential notation 1010 format (a30,2x,l6) ! logical 1012 format (a20,2x,l3,1x,a) ! logical diff --git a/cicecore/cicedynB/infrastructure/ice_grid.F90 b/cicecore/cicedynB/infrastructure/ice_grid.F90 index 34b37cf29..67129c911 100644 --- a/cicecore/cicedynB/infrastructure/ice_grid.F90 +++ b/cicecore/cicedynB/infrastructure/ice_grid.F90 @@ -340,6 +340,7 @@ subroutine init_grid2 real (kind=dbl_kind) :: & angle_0, angle_w, angle_s, angle_sw, & pi, pi2, puny + logical (kind=log_kind), dimension(nx_block,ny_block,max_blocks):: & out_of_range diff --git a/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 b/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 index dc41ff9fd..49cf12ce1 100644 --- a/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 +++ b/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 @@ -71,7 +71,8 @@ subroutine cice_init use ice_domain, only: init_domain_blocks use ice_domain_size, only: ncat, nfsd use ice_dyn_eap, only: init_eap, alloc_dyn_eap - use ice_dyn_shared, only: kdyn, init_evp, basalstress, alloc_dyn_shared + use ice_dyn_shared, only: kdyn, init_dyn, basalstress, alloc_dyn_shared + use ice_dyn_vp, only: init_vp use ice_flux, only: init_coupler_flux, init_history_therm, & init_history_dyn, init_flux_atm, init_flux_ocn, alloc_flux use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & @@ -120,11 +121,12 @@ subroutine cice_init call init_calendar ! initialize some calendar stuff call init_hist (dt) ! initialize output history file + call init_dyn (dt_dyn) ! define dynamics parameters, variables if (kdyn == 2) then call alloc_dyn_eap ! allocate dyn_eap arrays - call init_eap (dt_dyn) ! define eap dynamics parameters, variables - else ! for both kdyn = 0 or 1 - call init_evp (dt_dyn) ! define evp dynamics parameters, variables + call init_eap ! define eap dynamics parameters, variables + else if (kdyn == 3) then + call init_vp ! define vp dynamics parameters, variables endif call init_coupler_flux ! initialize fluxes exchanged with coupler diff --git a/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 b/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 index 80bb2570e..da745d965 100644 --- a/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 +++ b/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 @@ -71,7 +71,8 @@ subroutine cice_init(mpicom_ice) use ice_domain, only: init_domain_blocks use ice_domain_size, only: ncat, nfsd use ice_dyn_eap, only: init_eap, alloc_dyn_eap - use ice_dyn_shared, only: kdyn, init_evp, alloc_dyn_shared + use ice_dyn_shared, only: kdyn, init_dyn, alloc_dyn_shared + use ice_dyn_vp, only: init_vp use ice_flux, only: init_coupler_flux, init_history_therm, & init_history_dyn, init_flux_atm, init_flux_ocn, alloc_flux use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & @@ -122,11 +123,12 @@ subroutine cice_init(mpicom_ice) call init_calendar ! initialize some calendar stuff call init_hist (dt) ! initialize output history file + call init_dyn (dt_dyn) ! define dynamics parameters, variables if (kdyn == 2) then call alloc_dyn_eap ! allocate dyn_eap arrays - call init_eap (dt_dyn) ! define eap dynamics parameters, variables - else ! for both kdyn = 0 or 1 - call init_evp (dt_dyn) ! define evp dynamics parameters, variables + call init_eap ! define eap dynamics parameters, variables + else if (kdyn == 3) then + call init_vp ! define vp dynamics parameters, variables endif call init_coupler_flux ! initialize fluxes exchanged with coupler diff --git a/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 b/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 index edc22b710..323e3a189 100644 --- a/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 +++ b/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 @@ -367,6 +367,7 @@ subroutine coupling_prep (iblk) alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & fresh_ai, fsalt_ai, fsalt, & fswthru_ai, fhocn, fswthru, scale_factor, snowfrac, & + fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt, Uref, wind @@ -565,6 +566,10 @@ subroutine coupling_prep (iblk) Tref (:,:,iblk), Qref (:,:,iblk), & fresh (:,:,iblk), fsalt (:,:,iblk), & fhocn (:,:,iblk), fswthru (:,:,iblk), & + fswthru_vdr(:,:,iblk), & + fswthru_vdf(:,:,iblk), & + fswthru_idr(:,:,iblk), & + fswthru_idf(:,:,iblk), & faero_ocn(:,:,:,iblk), & alvdr (:,:,iblk), alidr (:,:,iblk), & alvdf (:,:,iblk), alidf (:,:,iblk), & diff --git a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 index 917774908..b37d73f65 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 @@ -52,7 +52,8 @@ subroutine cice_init use ice_domain, only: init_domain_blocks use ice_domain_size, only: ncat, nfsd use ice_dyn_eap, only: init_eap, alloc_dyn_eap - use ice_dyn_shared, only: kdyn, init_evp, alloc_dyn_shared + use ice_dyn_shared, only: kdyn, init_dyn, alloc_dyn_shared + use ice_dyn_vp, only: init_vp use ice_flux, only: init_coupler_flux, init_history_therm, & init_history_dyn, init_flux_atm, init_flux_ocn, alloc_flux use ice_forcing, only: init_forcing_ocn @@ -98,11 +99,12 @@ subroutine cice_init call init_calendar ! initialize some calendar stuff call init_hist (dt) ! initialize output history file + call init_dyn (dt_dyn) ! define dynamics parameters, variables if (kdyn == 2) then call alloc_dyn_eap ! allocate dyn_eap arrays - call init_eap (dt_dyn) ! define eap dynamics parameters, variables - else ! for both kdyn = 0 or 1 - call init_evp (dt_dyn) ! define evp dynamics parameters, variables + call init_eap ! define eap dynamics parameters, variables + else if (kdyn == 3) then + call init_vp ! define vp dynamics parameters, variables endif call init_coupler_flux ! initialize fluxes exchanged with coupler @@ -161,8 +163,8 @@ subroutine cice_init call faero_optics !initialize aerosol optical property tables end if - ! Initialize shortwave components using swdn from previous timestep - ! if restarting. These components will be scaled to current forcing + ! Initialize shortwave components using swdn from previous timestep + ! if restarting. These components will be scaled to current forcing ! in prep_radiation. if (trim(runtype) == 'continue' .or. restart) then @@ -249,7 +251,7 @@ subroutine init_restart if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - if (trim(runtype) == 'continue') then + if (trim(runtype) == 'continue') then ! start from core restart file call restartfile() ! given by pointer in ice_in call calendar(time) ! update time parameters @@ -260,17 +262,17 @@ subroutine init_restart ! call restartfile_v4 (ice_ic) ! CICE v4.1 binary restart file !!! uncomment if EAP restart data exists ! if (kdyn == 2) call read_restart_eap - endif + endif ! tracers - ! ice age tracer - if (tr_iage) then + ! ice age tracer + if (tr_iage) then if (trim(runtype) == 'continue') & restart_age = .true. if (restart_age) then call read_restart_age else - do iblk = 1, nblocks + do iblk = 1, nblocks call init_age(trcrn(:,:,nt_iage,:,iblk)) enddo ! iblk endif @@ -281,7 +283,7 @@ subroutine init_restart if (restart_FY) then call read_restart_FY else - do iblk = 1, nblocks + do iblk = 1, nblocks call init_FY(trcrn(:,:,nt_FY,:,iblk)) enddo ! iblk endif @@ -292,7 +294,7 @@ subroutine init_restart if (restart_lvl) then call read_restart_lvl else - do iblk = 1, nblocks + do iblk = 1, nblocks call init_lvl(iblk,trcrn(:,:,nt_alvl,:,iblk), & trcrn(:,:,nt_vlvl,:,iblk)) enddo ! iblk @@ -305,7 +307,7 @@ subroutine init_restart if (restart_pond_cesm) then call read_restart_pond_cesm else - do iblk = 1, nblocks + do iblk = 1, nblocks call init_meltponds_cesm(trcrn(:,:,nt_apnd,:,iblk), & trcrn(:,:,nt_hpnd,:,iblk)) enddo ! iblk @@ -318,7 +320,7 @@ subroutine init_restart if (restart_pond_lvl) then call read_restart_pond_lvl else - do iblk = 1, nblocks + do iblk = 1, nblocks call init_meltponds_lvl(trcrn(:,:,nt_apnd,:,iblk), & trcrn(:,:,nt_hpnd,:,iblk), & trcrn(:,:,nt_ipnd,:,iblk), & @@ -333,7 +335,7 @@ subroutine init_restart if (restart_pond_topo) then call read_restart_pond_topo else - do iblk = 1, nblocks + do iblk = 1, nblocks call init_meltponds_topo(trcrn(:,:,nt_apnd,:,iblk), & trcrn(:,:,nt_hpnd,:,iblk), & trcrn(:,:,nt_ipnd,:,iblk)) @@ -356,7 +358,7 @@ subroutine init_restart if (restart_iso) then call read_restart_iso else - do iblk = 1, nblocks + do iblk = 1, nblocks call init_isotope(trcrn(:,:,nt_isosno:nt_isosno+n_iso-1,:,iblk), & trcrn(:,:,nt_isoice:nt_isoice+n_iso-1,:,iblk)) enddo ! iblk @@ -368,7 +370,7 @@ subroutine init_restart if (restart_aero) then call read_restart_aero else - do iblk = 1, nblocks + do iblk = 1, nblocks call init_aerosol(trcrn(:,:,nt_aero:nt_aero+4*n_aero-1,:,iblk)) enddo ! iblk endif ! .not. restart_aero diff --git a/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 b/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 index f79464ba8..c1b400b2f 100644 --- a/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 @@ -76,7 +76,7 @@ subroutine cice_init(mpi_comm) use ice_domain, only: init_domain_blocks use ice_domain_size, only: ncat, nfsd use ice_dyn_eap, only: init_eap, alloc_dyn_eap - use ice_dyn_shared, only: kdyn, init_evp, alloc_dyn_shared + use ice_dyn_shared, only: kdyn, init_dyn, alloc_dyn_shared use ice_flux, only: init_coupler_flux, init_history_therm, & init_history_dyn, init_flux_atm, init_flux_ocn, alloc_flux use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & @@ -134,11 +134,12 @@ subroutine cice_init(mpi_comm) call init_calendar ! initialize some calendar stuff call init_hist (dt) ! initialize output history file + call init_dyn (dt_dyn) ! define dynamics parameters, variables if (kdyn == 2) then call alloc_dyn_eap ! allocate dyn_eap arrays - call init_eap (dt_dyn) ! define eap dynamics parameters, variables - else ! for both kdyn = 0 or 1 - call init_evp (dt_dyn) ! define evp dynamics parameters, variables + call init_eap ! define eap dynamics parameters, variables + else if (kdyn == 3) then + call init_vp ! define vp dynamics parameters, variables endif call init_coupler_flux ! initialize fluxes exchanged with coupler diff --git a/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 b/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 index ad575f714..df8fe4978 100644 --- a/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 @@ -362,6 +362,7 @@ subroutine coupling_prep (iblk) alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & fresh_ai, fsalt_ai, fsalt, & fswthru_ai, fhocn, fswthru, scale_factor, snowfrac, & + fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt @@ -556,6 +557,10 @@ subroutine coupling_prep (iblk) Tref (:,:,iblk), Qref (:,:,iblk), & fresh (:,:,iblk), fsalt (:,:,iblk), & fhocn (:,:,iblk), fswthru (:,:,iblk), & + fswthru_vdr(:,:,iblk), & + fswthru_vdf(:,:,iblk), & + fswthru_idr(:,:,iblk), & + fswthru_idf(:,:,iblk), & faero_ocn(:,:,:,iblk), & alvdr (:,:,iblk), alidr (:,:,iblk), & alvdf (:,:,iblk), alidf (:,:,iblk), & diff --git a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 index 0a8614eb2..8b507740d 100644 --- a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 @@ -71,7 +71,8 @@ subroutine cice_init use ice_domain, only: init_domain_blocks use ice_domain_size, only: ncat, nfsd use ice_dyn_eap, only: init_eap, alloc_dyn_eap - use ice_dyn_shared, only: kdyn, init_evp, alloc_dyn_shared + use ice_dyn_shared, only: kdyn, init_dyn, alloc_dyn_shared + use ice_dyn_vp, only: init_vp use ice_flux, only: init_coupler_flux, init_history_therm, & init_history_dyn, init_flux_atm, init_flux_ocn, alloc_flux use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & @@ -122,11 +123,12 @@ subroutine cice_init call init_calendar ! initialize some calendar stuff call init_hist (dt) ! initialize output history file + call init_dyn (dt_dyn) ! define dynamics parameters, variables if (kdyn == 2) then call alloc_dyn_eap ! allocate dyn_eap arrays - call init_eap (dt_dyn) ! define eap dynamics parameters, variables - else ! for both kdyn = 0 or 1 - call init_evp (dt_dyn) ! define evp dynamics parameters, variables + call init_eap ! define eap dynamics parameters, variables + else if (kdyn == 3) then + call init_vp ! define vp dynamics parameters, variables endif call init_coupler_flux ! initialize fluxes exchanged with coupler diff --git a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 index b45db2514..bd818211e 100644 --- a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 @@ -352,9 +352,8 @@ subroutine coupling_prep (iblk) albpnd, albcnt, apeff_ai, fpond, fresh, l_mpond_fresh, & alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & fresh_ai, fsalt_ai, fsalt, & - fswthru_ai, fhocn, & + fswthru_ai, fhocn, scale_factor, snowfrac, & fswthru, fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & - scale_factor, snowfrac, & swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt diff --git a/cicecore/drivers/unittest/opticep/CICE_RunMod.F90 b/cicecore/drivers/unittest/opticep/CICE_RunMod.F90 index c7ae7601f..8f5de17ea 100644 --- a/cicecore/drivers/unittest/opticep/CICE_RunMod.F90 +++ b/cicecore/drivers/unittest/opticep/CICE_RunMod.F90 @@ -395,6 +395,7 @@ subroutine coupling_prep (iblk) alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & fresh_ai, fsalt_ai, fsalt, & fswthru_ai, fhocn, fswthru, scale_factor, snowfrac, & + fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt @@ -589,6 +590,10 @@ subroutine coupling_prep (iblk) Tref (:,:,iblk), Qref (:,:,iblk), & fresh (:,:,iblk), fsalt (:,:,iblk), & fhocn (:,:,iblk), fswthru (:,:,iblk), & + fswthru_vdr(:,:,iblk), & + fswthru_vdf(:,:,iblk), & + fswthru_idr(:,:,iblk), & + fswthru_idf(:,:,iblk), & faero_ocn(:,:,:,iblk), & alvdr (:,:,iblk), alidr (:,:,iblk), & alvdf (:,:,iblk), alidf (:,:,iblk), & diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index eb96db66f..3eee54ee0 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -134,6 +134,21 @@ kridge = 1 ktransport = 1 ssh_stress = 'geostrophic' + maxits_nonlin = 4 + precond = 'pgmres' + dim_fgmres = 50 + dim_pgmres = 5 + maxits_fgmres = 1 + maxits_pgmres = 1 + monitor_nonlin = .false. + monitor_fgmres = .false. + monitor_pgmres = .false. + ortho_type = 'mgs' + reltol_nonlin = 1e-8 + reltol_fgmres = 1e-2 + reltol_pgmres = 1e-6 + algo_nonlin = 'picard' + use_mean_vrel = .true. / &shortwave_nml diff --git a/configuration/scripts/machines/Macros.conda_macos b/configuration/scripts/machines/Macros.conda_macos index 6f26da0fc..4acc4d3ba 100644 --- a/configuration/scripts/machines/Macros.conda_macos +++ b/configuration/scripts/machines/Macros.conda_macos @@ -14,8 +14,7 @@ FFLAGS := -fconvert=big-endian -fbacktrace -ffree-line-length-none # Additional flags for the Fortran compiler when compiling in debug mode ifeq ($(ICE_BLDDEBUG), true) -# FFLAGS += -O0 -g -fcheck=bounds -finit-real=nan -fimplicit-none -ffpe-trap=invalid,zero,overflow - FFLAGS += -O0 -g -fcheck=bounds -finit-real=nan -fimplicit-none -ffpe-trap=zero,overflow + FFLAGS += -O0 -g -fcheck=bounds -finit-real=nan -fimplicit-none -ffpe-trap=invalid,zero,overflow else FFLAGS += -O2 endif @@ -23,10 +22,8 @@ endif # C and Fortran compilers and MPI wrappers SCC := clang SFC := gfortran -#MPICC := mpicc -#MPIFC := mpifort -MPICC := clang -MPIFC := gfortran +MPICC := mpicc +MPIFC := mpifort ifeq ($(ICE_COMMDIR), mpi) FC := $(MPIFC) @@ -40,7 +37,7 @@ endif LD:= $(FC) # Location of the compiled Fortran modules (NetCDF) -MODDIR += -I$(CONDA_PREFIX)/include -I$(CONDA_PREFIX)/lib +MODDIR += -I$(CONDA_PREFIX)/include # Location of the system C header files (required on recent macOS to compile makdep) SDKPATH = $(shell xcrun --show-sdk-path) @@ -48,11 +45,10 @@ ifeq ($(strip $(SDKPATH)),) CFLAGS_HOST := else CFLAGS_HOST = -isysroot $(SDKPATH) - LD += -L$(SDKPATH)/usr/lib endif # Libraries to be passed to the linker -SLIBS := -L$(CONDA_PREFIX)/lib -lnetcdf -lnetcdff -llapack -lmpi_usempif08 -lmpi_usempi_ignore_tkr -lmpi_mpifh -lmpi +SLIBS := -L$(CONDA_PREFIX)/lib -lnetcdf -lnetcdff -llapack # Necessary flag to compile with OpenMP support ifeq ($(ICE_THREADED), true) @@ -61,7 +57,3 @@ ifeq ($(ICE_THREADED), true) FFLAGS += -fopenmp endif -ifeq ($(ICE_IOTYPE), pio2) - SLIBS := $(SLIBS) -lpiof -lpioc -endif - diff --git a/configuration/scripts/machines/Macros.gpsc3_intel b/configuration/scripts/machines/Macros.gpsc3_intel index 916996617..2ad3ff1f3 100644 --- a/configuration/scripts/machines/Macros.gpsc3_intel +++ b/configuration/scripts/machines/Macros.gpsc3_intel @@ -1,5 +1,5 @@ #============================================================================== -# Makefile macros for "gpsc3" +# Makefile macros for "cesium" #============================================================================== # For use with intel compiler #============================================================================== @@ -11,12 +11,12 @@ CFLAGS := -c -O2 -fp-model precise FIXEDFLAGS := -132 FREEFLAGS := -FR -FFLAGS := -fp-model source -convert big_endian -assume byterecl -ftz -traceback -diag-disable 5140 -no-wrap-margin +FFLAGS := -fp-model source -convert big_endian -assume byterecl -ftz -traceback -no-wrap-margin #-xHost +FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -check -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -#-init=snan,arrays + FFLAGS += -O0 -g -check -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays # -heap-arrays 1024 else FFLAGS += -O2 @@ -36,14 +36,25 @@ else endif LD:= $(FC) -ifeq ($(ICE_IOTYPE), netcdf) - INCLDIR += $(shell nf-config --fflags) - SLIBS := $(shell nf-config --flibs) -endif +NETCDF_PATH := /fs/ssm/hpco/tmp/eccc/201402/04/intel-2016.1.150/ubuntu-14.04-amd64-64/ + +PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs + +#PNETCDF_PATH := $(PNETCDF) +#PNETCDF_PATH := /glade/u/apps/ch/opt/pio/2.2/mpt/2.15f/intel/17.0.1/lib + +INCLDIR := $(INCLDIR) + +LIB_NETCDF := $(NETCDF_PATH)/lib +LIB_PNETCDF := $(PNETCDF_PATH)/lib +LIB_MPI := $(IMPILIBDIR) + +#SLIBS := -L$(LIB_NETCDF) -lnetcdff -lnetcdf -L$(LIB_PNETCDF) -lpnetcdf -lgptl +SLIBS := -L$(LIB_NETCDF) -lnetcdff -lnetcdf -llapack -lblas ifeq ($(ICE_THREADED), true) - LDFLAGS += -qopenmp - CFLAGS += -qopenmp - FFLAGS += -qopenmp + LDFLAGS += -openmp + CFLAGS += -openmp + FFLAGS += -openmp endif diff --git a/configuration/scripts/machines/Macros.ppp3_intel b/configuration/scripts/machines/Macros.ppp3_intel index 143445478..4a3b21093 100644 --- a/configuration/scripts/machines/Macros.ppp3_intel +++ b/configuration/scripts/machines/Macros.ppp3_intel @@ -1,5 +1,5 @@ #============================================================================== -# Makefile macros for "ppp3" +# Makefile macros for "millikan" #============================================================================== # For use with intel compiler #============================================================================== @@ -11,12 +11,12 @@ CFLAGS := -c -O2 -fp-model precise FIXEDFLAGS := -132 FREEFLAGS := -FR -FFLAGS := -fp-model source -convert big_endian -assume byterecl -ftz -traceback -diag-disable 5140 -no-wrap-margin +FFLAGS := -fp-model source -convert big_endian -assume byterecl -ftz -traceback -no-wrap-margin #-xHost +FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -check -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -#-init=snan,arrays + FFLAGS += -O0 -g -check -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays # -heap-arrays 1024 else FFLAGS += -O2 @@ -36,14 +36,25 @@ else endif LD:= $(FC) -ifeq ($(ICE_IOTYPE), netcdf) - INCLDIR += $(shell nf-config --fflags) - SLIBS := $(shell nf-config --flibs) -endif +NETCDF_PATH := /fs/ssm/hpco/tmp/eccc/201402/04/intel-2016.1.150/ubuntu-14.04-amd64-64/ + +PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs + +#PNETCDF_PATH := $(PNETCDF) +#PNETCDF_PATH := /glade/u/apps/ch/opt/pio/2.2/mpt/2.15f/intel/17.0.1/lib + +INCLDIR := $(INCLDIR) + +LIB_NETCDF := $(NETCDF_PATH)/lib +LIB_PNETCDF := $(PNETCDF_PATH)/lib +LIB_MPI := $(IMPILIBDIR) + +#SLIBS := -L$(LIB_NETCDF) -lnetcdff -lnetcdf -L$(LIB_PNETCDF) -lpnetcdf -lgptl +SLIBS := -L$(LIB_NETCDF) -lnetcdff -lnetcdf ifeq ($(ICE_THREADED), true) - LDFLAGS += -qopenmp - CFLAGS += -qopenmp - FFLAGS += -qopenmp + LDFLAGS += -openmp + CFLAGS += -openmp + FFLAGS += -openmp endif diff --git a/configuration/scripts/options/set_nml.dynanderson b/configuration/scripts/options/set_nml.dynanderson index 2306ac918..566c53a09 100644 --- a/configuration/scripts/options/set_nml.dynanderson +++ b/configuration/scripts/options/set_nml.dynanderson @@ -1,5 +1,3 @@ kdyn = 3 algo_nonlin = 'anderson' use_mean_vrel = .false. -capping_method = 'max' - diff --git a/configuration/scripts/options/set_nml.dynpicard b/configuration/scripts/options/set_nml.dynpicard index 6f32c5153..b81f4d4e6 100644 --- a/configuration/scripts/options/set_nml.dynpicard +++ b/configuration/scripts/options/set_nml.dynpicard @@ -1,4 +1,3 @@ kdyn = 3 algo_nonlin = 'picard' use_mean_vrel = .true. -capping_method = 'max' diff --git a/configuration/scripts/options/set_nml.run3dt b/configuration/scripts/options/set_nml.run3dt index 11a8c0f85..102a19d80 100644 --- a/configuration/scripts/options/set_nml.run3dt +++ b/configuration/scripts/options/set_nml.run3dt @@ -1,7 +1,6 @@ -npt_unit = '1' npt = 3 dump_last = .true. histfreq = '1','x','x','x','x' -hist_avg = .false.,.false.,.false.,.false.,.false. +hist_avg = .false. f_uvel = '1' f_vvel = '1' diff --git a/configuration/scripts/tests/base_suite.ts b/configuration/scripts/tests/base_suite.ts index fad8b22f3..386c29e41 100755 --- a/configuration/scripts/tests/base_suite.ts +++ b/configuration/scripts/tests/base_suite.ts @@ -8,10 +8,9 @@ smoke gx3 8x2 diag24,run1year,medium decomp gx3 4x2x25x29x5 smoke gx3 4x2 diag1,run5day smoke_gx3_8x2_diag1_run5day smoke gx3 4x1 diag1,run5day,thread smoke_gx3_8x2_diag1_run5day -restart gx1 40x4 droundrobin,medium -restart tx1 40x4 dsectrobin,medium +restart gx1 40x4 droundrobin,medium +restart tx1 40x4 dsectrobin,medium restart gx3 4x4 none -restart gx3 4x4 iobinary restart gx3 6x2 alt01 restart gx3 8x2 alt02 restart gx3 4x2 alt03 @@ -22,24 +21,24 @@ restart gx3 8x2 alt02,debug,short restart gx3 4x2 alt03,debug,short smoke gx3 4x4 alt04,debug,short smoke gx3 4x4 alt05,debug,short -restart gbox128 4x2 short -restart gbox128 4x2 boxdyn,short -restart gbox128 4x2 boxdyn,short,debug -restart gbox128 2x2 boxadv,short -smoke gbox128 2x2 boxadv,short,debug -restart gbox128 4x4 boxrestore,short -smoke gbox128 4x4 boxrestore,short,debug -restart gbox80 1x1 box2001 -smoke gbox80 1x1 boxslotcyl +restart gbox128 4x2 short +restart gbox128 4x2 boxdyn,short +restart gbox128 4x2 boxdyn,short,debug +restart gbox128 2x2 boxadv,short +smoke gbox128 2x2 boxadv,short,debug +restart gbox128 4x4 boxrestore,short +smoke gbox128 4x4 boxrestore,short,debug +restart gbox80 1x1 box2001 +smoke gbox80 1x1 boxslotcyl smoke gx3 8x2 bgcz smoke gx3 8x2 bgcz,debug smoke gx3 8x1 bgcskl,debug #smoke gx3 4x1 bgcz,thread smoke_gx3_8x2_bgcz restart gx1 4x2 bgcsklclim,medium restart gx1 8x1 bgczclim,medium -smoke gx1 24x1 jra55_gx1_2008,medium,run90day +smoke gx1 24x1 jra55_gx1_2008,medium,run90day smoke gx3 8x1 jra55_gx3_2008,medium,run90day -restart gx1 24x1 jra55_gx1,short +restart gx1 24x1 jra55_gx1,short restart gx3 8x1 jra55_gx3,short smoke gx3 4x2 fsd1,diag24,run5day,debug smoke gx3 8x2 fsd12,diag24,run5day,short @@ -47,4 +46,8 @@ restart gx3 4x2 fsd12,debug,short smoke gx3 8x2 fsd12ww3,diag24,run1day,medium smoke gx3 4x1 isotope,debug restart gx3 8x2 isotope - +restart gx3 4x4 iobinary +restart gx3 4x4 histall,precision8,cdf64 +smoke gx3 30x1 bgcz,histall +smoke gx3 14x2 fsd12,histall +smoke gx3 4x1 dynpicard,medium diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index c32f1cdbf..64afcb22b 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -335,7 +335,7 @@ either Celsius or Kelvin units). "kalg", ":math:`\bullet` absorption coefficient for algae", "" "kappav", "visible extinction coefficient in ice, wavelength\ :math:`<`\ 700nm", "1.4 m\ :math:`^{-1}`" "kcatbound", ":math:`\bullet` category boundary formula", "" - "kdyn", ":math:`\bullet` type of dynamics (1 = EVP, 0 = off)", "1" + "kdyn", ":math:`\bullet` type of dynamics (1 = EVP, 2 = EAP, 3 = VP, 0,-1 = off)", "1" "kg_to_g", "kg to g conversion factor", "1000." "kice", "thermal conductivity of fresh ice (:cite:`Bitz99`)", "2.03 W/m/deg" "kitd", ":math:`\bullet` type of itd conversions (0 = delta function, 1 = linear remap)", "1" diff --git a/doc/source/developer_guide/dg_dynamics.rst b/doc/source/developer_guide/dg_dynamics.rst index 3551763b5..eac19b1f6 100644 --- a/doc/source/developer_guide/dg_dynamics.rst +++ b/doc/source/developer_guide/dg_dynamics.rst @@ -30,13 +30,13 @@ Dynamical Solvers -------------------- The dynamics solvers are found in **cicecore/cicedynB/dynamics/**. A couple of different solvers are -available including EVP, revised EVP, and EAP. The dynamics solver is specified in namelist with the -``kdyn`` variable. ``kdyn=1`` is evp, ``kdyn=2`` is eap, and revised evp requires the ``revised_evp`` -namelist flag be set to true. +available including EVP, revised EVP, EAP and VP. The dynamics solver is specified in namelist with the +``kdyn`` variable. ``kdyn=1`` is evp, ``kdyn=2`` is eap, ``kdyn=3`` is VP and revised EVP requires +the ``revised_evp`` namelist flag be set to true. -Multiple evp solvers are supported thru the namelist flag ``kevp_kernel``. The standard implementation +Multiple EVP solvers are supported thru the namelist flag ``kevp_kernel``. The standard implementation and current default is ``kevp_kernel=0``. In this case, the stress is solved on the regular decomposition -via subcycling and calls to subroutine stress and subroutine stepu with MPI global sums required in each +via subcycling and calls to subroutine ``stress`` and subroutine ``stepu`` with MPI global sums required in each subcycling call. With ``kevp_kernel=2``, the data required to compute the stress is gathered to the root MPI process and the stress calculation is performed on the root task without any MPI global sums. OpenMP parallelism is supported in ``kevp_kernel=2``. The solutions with ``kevp_kernel`` set to 0 or 2 will diff --git a/doc/source/master_list.bib b/doc/source/master_list.bib index a7c3a1174..0b928d012 100644 --- a/doc/source/master_list.bib +++ b/doc/source/master_list.bib @@ -60,7 +60,7 @@ @string{CRST @string{IJHPCA={Int. J High Perform. Comput. Appl}} @string{PTRSA={Philos. Trans. Royal Soc. A}} @string{SIAMJCP={SIAM J. Sci. Comput.}} -@string{TC={The Cryosphere}} + % ********************************************** @@ -77,7 +77,7 @@ @incollection{Assur58 volume = {598}, pages = {106-138} } -@Article{Schwarzacher59, +@Article{Schwarzacher59 author = "W. Schwarzacher", title = "{Pack ice studies in the Arctic Ocean}", journal = JGR, @@ -86,7 +86,7 @@ @Article{Schwarzacher59 pages = {2357-2367}, url = {http://dx.doi.org/10.1029/JZ064i012p02357} } -@Article{Untersteiner64, +@Article{Untersteiner64 author = "N. Untersteiner", title = "{Calculations of temperature regime and heat budget of sea ice in the Central Arctic}", journal = JGR, @@ -105,7 +105,7 @@ @incollection{Ono67 volume = "I", pages = "599--610" } -@Article{Maykut71, +@Article{Maykut71 author = "G.A. Maykut and N. Untersteiner", title = "{Some results from a time dependent thermodynamic model of sea ice}", journal = JGR, @@ -114,7 +114,7 @@ @Article{Maykut71 pages = {1550-1575}, url = {http://dx.doi.org/10.1029/JC076i006p01550} } -@Book{Stroud71, +@Book{Stroud71 author = "A.H. Stroud", title = "{Approximate Calculation of Multiple Integrals}", publisher = "Prentice-Hall", @@ -122,7 +122,7 @@ @Book{Stroud71 year = {1971}, pages = {431 pp}, } -@Article{Arya75, +@Article{Arya75 author = "S.P.S. Arya", title = "{A drag partition theory for determining the large-scale roughness parameter and wind stress on the Arctic pack ice}", journal = JGR, @@ -131,7 +131,7 @@ @Article{Arya75 pages = {3447-3454}, url = {http://dx.doi.org/10.1029/JC080i024p03447} } -@Article{Rothrock75, +@Article{Rothrock75 author = "D.A. Rothrock", title = "{The energetics of plastic deformation of pack ice by ridging}", journal = JGR, @@ -140,7 +140,7 @@ @Article{Rothrock75 pages = {4514-4519}, url = {http://dx.doi.org/10.1029/JC080i033p04514} } -@Article{Thorndike75, +@Article{Thorndike75 author = "A.S. Thorndike and D.A. Rothrock and G.A. Maykut and R. Colony", title = "{The thickness distribution of sea ice}", journal = JGR, @@ -149,7 +149,7 @@ @Article{Thorndike75 pages = {4501-4513}, url = {http://dx.doi.org/10.1029/JC080i033p04501} } -@Article{Semtner76, +@Article{Semtner76 author = "A.J. Semtner", title = "{A Model for the Thermodynamic Growth of Sea Ice in Numerical Investigations of Climate}", journal = JPO, @@ -158,7 +158,7 @@ @Article{Semtner76 pages = {379-389}, url = {http://dx.doi.org/10.1175/1520-0485(1976)006<0379:AMFTTG>2.0.CO;2} } -@Article{Hibler79, +@Article{Hibler79 author = "W.D. Hibler", title = "{A dynamic thermodynamic sea ice model}", journal = JPO, @@ -167,7 +167,7 @@ @Article{Hibler79 pages = {817-846}, url = {http://dx.doi.org/10.1175/1520-0485(1979)009<0815:ADTSIM>2.0.CO;2} } -@Article{Parkinson79, +@Article{Parkinson79 author = "C.L. Parkinson and W.M. Washington", title = "{A large-scale numerical model of sea ice}", journal = JGRO, @@ -177,7 +177,7 @@ @Article{Parkinson79 pages = {331-337}, url = {http://dx.doi.org/10.1029/JC084iC01p00311} } -@Article{Zalesak79, +@Article{Zalesak79 author = "S. T. Zalesak", title = "{Fully multidimensional flux-corrected transport algorithms for fluids}", journal = JCP, @@ -187,7 +187,7 @@ @Article{Zalesak79 pages = {335-362}, url = {http://dx.doi.org/10.1016/0021-9991(79)90051-2} } -@Article{Hibler80, +@Article{Hibler80 author = "W.D. Hibler", title = "{Modeling a variable thickness sea ice cover}", journal = MWR, @@ -196,7 +196,7 @@ @Article{Hibler80 pages = {1943-1973}, url = {http://dx.doi.org/10.1175/1520-0493(1980)108<1943:MAVTSI>2.0.CO;2} } -@Article{Maykut82, +@Article{Maykut82 author = "G.A. Maykut", title = "{Large-scale heat exchange and ice production in the central Arctic}", journal = JGRO, @@ -205,7 +205,7 @@ @Article{Maykut82 pages = {7971-7984}, url = {http://dx.doi.org/10.1029/JC087iC10p07971} } -@incollection{Siedler86, +@incollection{Siedler86 author = "G. Siedler and H. Peters", title = "Physical properties (general) of sea water", booktitle = "Landolt-Börnstein: Numerical data and functional relationships in science and technology, New Series V/3a", @@ -213,7 +213,7 @@ @incollection{Siedler86 year = {1986}, pages = {233-264}, } -@Article{Hibler87, +@Article{Hibler87 author = "W.D. Hibler and K. Bryan", title = "{A diagnostic ice-ocean model}", journal = JPO, @@ -222,7 +222,7 @@ @Article{Hibler87 pages = {987-1015}, url = {http://dx.doi.org/10.1175/1520-0485(1987)017<0987:ADIM>2.0.CO;2} } -@Article{Maykut87, +@Article{Maykut87 author = "G.A. Maykut and D.K. Perovich", title = "{The role of shortwave radiation in the summer decay of a sea ice cover}", journal = JGRO, @@ -231,7 +231,7 @@ @Article{Maykut87 pages = {7032-7044}, url = {http://dx.doi.org/10.1029/JC092iC07p07032} } -@Article{Rosati88, +@Article{Rosati88 author = "A. Rosati and K. Miyakoda", title = "{A general circulation model for upper ocean simulation}", journal = JPO, @@ -240,7 +240,7 @@ @Article{Rosati88 pages = {1601-1626}, url = {http://dx.doi.org/10.1175/1520-0485(1988)018<1601:AGCMFU>2.0.CO;2} } -@Article{Steele92, +@Article{Steele92 author = "M. Steele", title = "{Sea ice melting and floe geometry in a simple ice-ocean model}", journal = JGRO, @@ -249,7 +249,7 @@ @Article{Steele92 pages = {17729-17738}, url = {http://dx.doi.org/10.1029/92JC01755} } -@Article{Smith92, +@Article{Smith92 author = "R.D. Smith and J.K. Dukowicz and R.C. Malone", title = "{Parallel ocean general circulation modeling}", journal = PHYS, @@ -259,7 +259,7 @@ @Article{Smith92 pages = {38-61}, url = {http://dx.doi.org/10.1016/0167-2789(92)90225-C} } -@Article{Arrigo93, +@Article{Arrigo93 author = "K.R. Arrigo and J.N. Kremer and C.W. Sullivan", title = "{A simulated Antarctic fast ice ecosystem}", journal = JGRO, @@ -268,7 +268,7 @@ @Article{Arrigo93 pages = {6929-6946}, url = {http://dx.doi.org/10.1029/93JC00141} } -@Article{Dukowicz93, +@Article{Dukowicz93 author = "J.K. Dukowicz and R.D. Smith and R.C. Malone", title = "{A reformulation and implementation of the Bryan-Cox-Semtner ocean model on the connection machine}", journal = JTECH, @@ -278,18 +278,7 @@ @Article{Dukowicz93 pages = {195-208}, url = {http://dx.doi.org/10.1175/1520-0426(1993)010<0195:ARAIOT>2.0.CO;2} } -@Article{Saad93, - author = "Y. Saad", - title = "{A Flexible Inner-Outer Preconditioned GMRES Algorithm}", - journal = SIAMJCP, - volume = {14}, - number = {2}, - year = {1993}, - pages = {461-469}, - doi = {10.1137/0914028}, - URL = {https://doi.org/10.1137/0914028} -} -@Article{Dukowicz94, +@Article{Dukowicz94 author = "J.K. Dukowicz and R.D. Smith and R.C. Malone", title = "{Implicit free-surface method for the Bryan-Cox-Semtner ocean model}", journal = JGRO, @@ -299,7 +288,7 @@ @Article{Dukowicz94 pages = {7991-8014}, url = {http://dx.doi.org/10.1029/93JC03455} } -@Article{Ebert95, +@Article{Ebert95 author = "E.E. Ebert and J.L. Schramm and J.A. Curry", title = "{Disposition of solar radiation in sea ice and the upper ocean}", journal = JGRO, @@ -308,7 +297,7 @@ @Article{Ebert95 pages = {15965-15975}, url = {http://dx.doi.org/10.1029/95JC01672} } -@Article{Flato95, +@Article{Flato95 author = "G.M. Flato and W.D. Hibler", title = "{Ridging and strength in modeling the thickness distribution of Arctic sea ice}", journal = JGRO, @@ -317,7 +306,7 @@ @Article{Flato95 pages = {18611-18626}, url = {http://dx.doi.org/10.1029/95JC02091} } -@Article{Maykut95, +@Article{Maykut95 author = "G.A. Maykut and M.G. McPhee", title = "{Solar heating of the Arctic mixed layer}", journal = JGRO, @@ -326,12 +315,12 @@ @Article{Maykut95 pages = {24691-24703}, url = {http://dx.doi.org/10.1029/95JC02554} } -@Manual{Smith95, +@Manual{Smith95 author = "R.D. Smith and S. Kortas and B. Meltz", title = "{Curvilinear coordinates for global ocean models}", organization = "Technical Report LA-UR-95-1146, Los Alamos National Laboratory", year = {1995}, - url = {https://github.com/CICE-Consortium/CICE/blob/main/doc/PDF/LAUR-95-1146.pdf} + url = {https://github.com/CICE-Consortium/CICE/blob/master/doc/PDF/LAUR-95-1146.pdf} } @Article{Zwiers95, author = "F.W. Zwiers and H. von Storch", @@ -343,7 +332,7 @@ @Article{Zwiers95 pages = {336-351}, url = {http://dx.doi.org/10.1175/1520-0442(1995)008<0336:TSCIAI>2.0.CO;2} } -@Article{Murray96, +@Article{Murray96 author = "R.J. Murray", title = "{Explicit generation of orthogonal grids for ocean models}", journal = JCT, @@ -352,7 +341,7 @@ @Article{Murray96 pages = {251-273}, url = {http://dx.doi.org/10.1006/jcph.1996.0136} } -@Article{Hunke97, +@Article{Hunke97 author = "E.C. Hunke and J.K. Dukowicz", title = "{An elastic-viscous-plastic model for sea ice dynamics}", journal = JPO, @@ -361,7 +350,7 @@ @Article{Hunke97 pages = {1849-1867}, url = {http://dx.doi.org/10.1175/1520-0485(1997)027<1849:AEVPMF>2.0.CO;2} } -@Article{Steele97, +@Article{Steele97 author = "M. Steele and J. Zhang and D. Rothrock and H. Stern", title = "{The force balance of sea ice in a numerical model of the Arctic Ocean}", journal = JGRO, @@ -371,7 +360,7 @@ @Article{Steele97 pages = {21061-21079}, url = {http://dx.doi.org/10.1029/97JC01454} } -@Article{Geiger98, +@Article{Geiger98 author = "C.A. Geiger and W.D. Hibler and S.F. Ackley", title = "{Large-scale sea ice drift and deformation: Comparison between models and observations in the western Weddell Sea during 1992}", journal = JGRO, @@ -381,7 +370,7 @@ @Article{Geiger98 pages = {21893-21913}, url = {http://dx.doi.org/10.1029/98JC01258} } -@Book{Lipscomb98, +@Book{Lipscomb98 author = "W.H. Lipscomb", title = "{Modeling the Thickness Distribution of Arctic Sea Ice}", publisher = "Dept. of Atmospheric Sciences University of Washington, Seattle", @@ -389,7 +378,7 @@ @Book{Lipscomb98 year = {1998}, url = {http://hdl.handle.net/1773/10081} } -@Article{Bitz99, +@Article{Bitz99 author = "C.M. Bitz and W.H. Lipscomb", title = "{An energy-conserving thermodynamic sea ice model for climate study}", journal = JGRO, @@ -399,7 +388,7 @@ @Article{Bitz99 pages = {15669-15677}, url = {http://dx.doi.org/10.1029/1999JC900100} } -@Article{Hunke99, +@Article{Hunke99 author = "E.C. Hunke and Y. Zhang", title = "{A comparison of sea ice dynamics models at high resolution}", journal = MWR, @@ -408,7 +397,7 @@ @Article{Hunke99 pages = {396-408}, url = {http://dx.doi.org/10.1175/1520-0493(1999)127<0396:ACOSID>2.0.CO;2} } -@Article{Jordan99, +@Article{Jordan99 author = "R.E. Jordan and E.L. Andreas and A.P. Makshtas", title = "{Heat budget of snow-covered sea ice at North Pole 4}", journal = JGRO, @@ -418,7 +407,7 @@ @Article{Jordan99 pages = {7785-7806}, url = {http://dx.doi.org/10.1029/1999JC900011} } -@Book{vonstorch99, +@Book{vonstorch99 author = "H. von Storch and F.W. Zwiers", title = "{Statistical Analysis in Climate Research}", publisher = "Cambridge University Press", @@ -426,7 +415,7 @@ @Book{vonstorch99 year = {1999}, pages = {484 pp}, } -@Article{Dukowicz00, +@Article{Dukowicz00 author = "J.K. Dukowicz and J.R. Baumgardner", title = "{Incremental remapping as a transport/advection algorithm}", journal = JCT, @@ -435,16 +424,7 @@ @Article{Dukowicz00 pages = {318-335}, url = {http://dx.doi.org/10.1006/jcph.2000.6465} } -@Article{Kreyscher00, - author = "M. Kreyscher and M. Harder and P. Lemke and G.M. Flato", - title = "{Results of the {S}ea {I}ce {M}odel {I}ntercomparison {P}roject: evaluation of sea ice rheology schemes for use in climate simulations}", - journal = JGR, - year = {2000}, - volume = {105}, - number = {C5}, - pages = {11299-11320} -} -@Article{Bitz01, +@Article{Bitz01 author = "C.M. Bitz and M.M. Holland and M. Eby and A.J. Weaver", title = "{Simulating the ice-thickness distribution in a coupled climate model}", journal = JGRO, @@ -453,7 +433,7 @@ @Article{Bitz01 pages = {2441-2463}, url = {http://dx.doi.org/10.1029/1999JC000113} } -@Article{Hunke01, +@Article{Hunke01 author = "E.C. Hunke", title = "{Viscous-plastic sea ice dynamics with the EVP model: Linearization issues}", journal = JCP, @@ -462,7 +442,7 @@ @Article{Hunke01 pages = {18-38}, url = {http://dx.doi.org/10.1006/jcph.2001.6710} } -@Article{Lipscomb01, +@Article{Lipscomb01 author = "W.H. Lipscomb", title = "{Remapping the thickness distribution in sea ice models}", journal = JGRO, @@ -471,7 +451,7 @@ @Article{Lipscomb01 pages = {13989-14000}, url = {http://dx.doi.org/10.1029/2000JC000518} } -@Article{He01, +@Article{He01 author = "Y. He and C.H.Q. Ding", title = "{Using Accurate Arithmetics to Improve Numerical Reproducibility and Stability in Parallel Applications}", journal = JOS, @@ -481,7 +461,7 @@ @Article{He01 pages = {259-277}, url = {http://dx.doi.org/10.1023/A:1008153532043} } -@Article{Schulson01, +@Article{Schulson01 author = "E.M. Schulson", title = "{Brittle failure of ice}", journal = EFM, @@ -500,7 +480,7 @@ @Article{Taylor01 pages = {7183-7192}, url = {http://dx.doi.org/10.1029/2000JD900719} } -@Article{Trodahl01, +@Article{Trodahl01 author = "H.J. Trodahl and S.O.F. Wilkinson and M.J. McGuinness and T.G. Haskeel", title = "{Thermal conductivity of sea ice: dependence on temperature and depth}", journal = GRL, @@ -509,7 +489,7 @@ @Article{Trodahl01 pages = {1279-1282}, url = {http://dx.doi.org/10.1029/2000GL012088} } -@Article{Hunke02, +@Article{Hunke02 author = "E.C. Hunke and J.K. Dukowicz", title = "{The Elastic-Viscous-Plastic sea ice dynamics model in general orthogonal curvilinear coordinates on a sphere—Effect of metric terms}", journal = MWR, @@ -518,21 +498,21 @@ @Article{Hunke02 pages = {1848-1865}, url = {http://dx.doi.org/10.1175/1520-0493(2002)130<1848:TEVPSI>2.0.CO;2} } -@Manual{Kauffman02, +@Manual{Kauffman02 author = "B.G. Kauffman and W.G. Large", title = "{The CCSM coupler, version 5.0.1}", journal = NTN, year = {2002}, - url = {https://github.com/CICE-Consortium/CICE/blob/main/doc/PDF/KL_NCAR2002.pdf} + url = {https://github.com/CICE-Consortium/CICE/blob/master/doc/PDF/KL_NCAR2002.pdf} } -@Manual{Hunke03, +@Manual{Hunke03 author = "E.C. Hunke and J.K. Dukowicz", title = "{The sea ice momentum equation in the free drift regime}", organization = "Technical Report LA-UR-03-2219, Los Alamos National Laboratory", year = {2003}, - url = {https://github.com/CICE-Consortium/CICE/blob/main/doc/PDF/LAUR-03-2219.pdf} + url = {https://github.com/CICE-Consortium/CICE/blob/master/doc/PDF/LAUR-03-2219.pdf} } -@Article{Amundrud04, +@Article{Amundrud04 author = "T.L. Amundrud and H. Malling and R.G. Ingram", title = "{Geometrical constraints on the evolution of ridged sea ice}", journal = JGRO, @@ -541,7 +521,7 @@ @Article{Amundrud04 issue = {C6}, url = {http://dx.doi.org/10.1029/2003JC002251} } -@Article{Connolley04, +@Article{Connolley04 author = "W.M. Connolley and J.M. Gregory and E.C. Hunke and A.J. McLaren", title = "{On the consistent scaling of terms in the sea ice dynamics equation}", journal = JPO, @@ -550,7 +530,7 @@ @Article{Connolley04 pages = {1776-1780}, url = {http://dx.doi.org/10.1175/1520-0485(2004)034<1776:OTCSOT>2.0.CO;2} } -@Article{Eicken04, +@Article{Eicken04 author = "H. Eicken and T.C. Grenfell and D.K. Perovich and J.A Richter-Menge and K. Frey", title = "{Hydraulic controls of summer Arctic pack ice albedo}", journal = JGRO, @@ -559,7 +539,7 @@ @Article{Eicken04 issue = {C8}, url = {http://dx.doi.org/10.1029/2003JC001989} } -@Article{Lipscomb04, +@Article{Lipscomb04 author = "W.H. Lipscomb and E.C. Hunke", title = "{Modeling sea ice transport using incremental remapping}", journal = MWR, @@ -568,7 +548,7 @@ @Article{Lipscomb04 pages = {1341-1354}, url = {http://dx.doi.org/10.1175/1520-0493(2004)132<1341:MSITUI>2.0.CO;2} } -@Article{Taylor04, +@Article{Taylor04 author = "P.D. Taylor and D.L. Feltham", title = "{A model of melt pond evolution on sea ice}", journal = JGRO, @@ -577,7 +557,7 @@ @Article{Taylor04 issue = {C12}, url = {http://dx.doi.org/10.1029/2004JC002361} } -@Article{Wilchinsky04, +@Article{Wilchinsky04 author = "A.V. Wilchinsky and D.L. Feltham", title = "{Dependence of sea ice yield-curve shape on ice thickness}", journal = JPO, @@ -595,7 +575,7 @@ @Article{Lavoie05 issue = {C11}, url = {http://dx.doi.org/10.1029/2005JC002922} } -@Book{Notz05, +@Book{Notz05 author = "D. Notz", title = "Thermodynamic and Fluid-Dynamical Processes in Sea Ice", publisher = "University of Cambridge, UK", @@ -603,7 +583,7 @@ @Book{Notz05 year = {2005}, url = {http://ulmss-newton.lib.cam.ac.uk/vwebv/holdingsInfo?bibId=27224} } -@Article{Feltham06, +@Article{Feltham06 author = "D.L. Feltham and N. Untersteiner and J.S. Wettlaufer and M.G. Worster", title = "{Sea ice is a mushy layer}", journal = GRL, @@ -636,9 +616,9 @@ @Article{Jin06 year = {2006}, volume = {44}, pages = {63-72}, - url = {https://github.com/CICE-Consortium/CICE/blob/main/doc/PDF/JDWSTWLG06.pdf} + url = {https://github.com/CICE-Consortium/CICE/blob/master/doc/PDF/JDWSTWLG06.pdf} } -@Article{Wilchinsky06, +@Article{Wilchinsky06 author = "A.V. Wilchinsky and D.L. Feltham", title = "{Modelling the rheology of sea ice as a collection of diamond-shaped floes}", journal = JNON, @@ -647,7 +627,7 @@ @Article{Wilchinsky06 pages = {22-32}, url = {http://dx.doi.org/10.1016/j.jnnfm.2006.05.001} } -@Book{Wilks06, +@Book{Wilks06 author = "D.S. Wilks", title = "{Statistical methods in the atmospheric sciences}", publisher = "Academic Press", @@ -655,14 +635,14 @@ @Book{Wilks06 year = {2006}, pages = {627 pp}, } -@Manual{Briegleb07, +@Manual{Briegleb07 author = "B.P. Briegleb and B. Light", title = "{A Delta-Eddington multiple scattering parameterization for solar radiation in the sea ice component of the Community Climate System Model}", organization = "NCAR Technical Note NCAR/TN-472+STR, National Center for Atmospheric Research", year = {2007}, - url = {https://github.com/CICE-Consortium/CICE/blob/main/doc/PDF/BL_NCAR2007.pdf} + url = {https://github.com/CICE-Consortium/CICE/blob/master/doc/PDF/BL_NCAR2007.pdf} } -@Article{Flocco07, +@Article{Flocco07 author = "D. Flocco and D.L. Feltham", title = "{A continuum model of melt pond evolution on Arctic sea ice}", journal = JGRO, @@ -671,7 +651,7 @@ @Article{Flocco07 number = {C8}, url = {http://dx.doi.org/10.1029/2006JC003836} } -@Article{Golden07, +@Article{Golden07 author = "K.M. Golden and H. Eicken and A.L. Heaton and J. Miner and D.J. Pringle and J. Zhu", title = "{Thermal evolution of permeability and microstructure in sea ice}", journal = GRL, @@ -680,16 +660,7 @@ @Article{Golden07 issue = {16}, url = {http://dx.doi.org/10.1029/2007GL030447} } -@Article{Hunke07, - author = "E. Hunke and M.M. Holland", - title = "{Global atmospheric forcing data for Arctic ice-ocean modeling}", - journal = JGRO, - year = {2007}, - volume = {112}, - number = {C4}, - url = {http://dx.doi.org/10.1029/2006JC003640} -} -@Article{Lipscomb07, +@Article{Lipscomb07 author = "W.H. Lipscomb and E.C. Hunke and W. Maslowski and J. Jakacki", title = "{Ridging, strength, and stability in high-resolution sea ice models}", journal = JGRO, @@ -698,7 +669,7 @@ @Article{Lipscomb07 issue = {C3}, url = {http://dx.doi.org/10.1029/2005JC003355} } -@Article{Pringle07, +@Article{Pringle07 author = "D.J. Pringle and H. Eicken and H.J. Trodahl and L.G.E. Backstrom", title = "{Thermal conductivity of landfast Antarctic and Arctic sea ice}", journal = JGRO, @@ -707,7 +678,7 @@ @Article{Pringle07 issue = {C4}, url = {http://dx.doi.org/10.1029/2006JC003641} } -@Article{Stefels07, +@Article{Stefels07 author = "J. Stefels and M. Steinke and S. Turner and G. Malin and S. Belviso", title = "{Environmental constraints on the production and removal of the climatically active gas dimethylsulphide (DMS) and implications for ecosystem modelling}", journal = BGC, @@ -716,20 +687,7 @@ @Article{Stefels07 pages = {245-275}, url = {http://dx.doi.org/10.1007/978-1-4020-6214-8_18} } -@Article{Lemieux08, - author = "J.-F. Lemieux and B. Tremblay and S. Thomas and J. Sedláček and L. A. Mysak", - title = "{Using the preconditioned Generalized Minimum RESidual (GMRES) method to solve the sea-ice momentum equation}", - journal = JGRO, - volume = {113}, - number = {C10}, - pages = {}, - keywords = {Sea ice, GMRES, Krylov subspace}, - doi = {10.1029/2007JC004680}, - url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2007JC004680}, - eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2007JC004680}, - year = {2008} -} -@Article{Hunke09, +@Article{Hunke09 author = "E.C. Hunke and C.M. Bitz", title = "{Age characteristics in a multidecadal Arctic sea ice simulation}", journal = JGRO, @@ -738,7 +696,7 @@ @Article{Hunke09 issue = {CB}, url = {http://dx.doi.org/10.1029/2008JC005186} } -@Article{Large09, +@Article{Large09 author = "W.G. Large and S.G. Yeager", title = "{The global climatology of an interannually varying air-sea flux data set}", journal = OM, @@ -755,7 +713,7 @@ @Article{Tagliabue09 issue = {13}, url = {http://dx.doi.org/10.1029/2009GL038914} } -@Article{Weiss09, +@Article{Weiss09 author = "J. Weiss and E.M. Schulson", title = "{Coulombic faulting from the grain scale to the geophysical scale: lessons from ice}", journal = JPD, @@ -764,7 +722,7 @@ @Article{Weiss09 pages = {214017}, url = {http://dx.doi.org/10.1088/0022-3727/42/21/214017} } -@Article{Flocco10, +@Article{Flocco10 author = "D. Flocco and D.L. Feltham and A.K. Turner", title = "{Incorporation of a physically based melt pond scheme into the sea ice component of a climate model}", journal = JGRO, @@ -773,7 +731,7 @@ @Article{Flocco10 number = {C8}, url = {http://dx.doi.org/10.1029/2009JC005568} } -@Article{Konig10, +@Article{Konig10 author = "C. Konig Beatty and D.M. Holland", title = "{Modeling landfast ice by adding tensile strength}", journal = JPO, @@ -782,7 +740,7 @@ @Article{Konig10 pages = {185-198}, url = {http://dx.doi.org/10.1175/2009JPO4105.1} } -@Article{Armour11, +@Article{Armour11 author = "K.C. Armour and C.M. Bitz and L. Thompson and E.C. Hunke", title = "{Controls on Arctic sea ice from first-year and multi-year ice survivability}", journal = JC, @@ -791,7 +749,7 @@ @Article{Armour11 pages = {2378-2390}, url = {http://dx.doi.org/10.1175/2010JCLI3823.1} } -@Article{Deal11, +@Article{Deal11 author = "C. Deal and M. Jin and S. Elliott and E. Hunke and M. Maltrud and N. Jeffery", title = "{Large scale modeling of primary production and ice algal biomass within Arctic sea ice in 1992}", journal = JGRO, @@ -800,7 +758,7 @@ @Article{Deal11 issue = {C7}, url = {http://dx.doi.org/10.1029/2010JC006409} } -@Article{Lu11, +@Article{Lu11 author = "P. Lu and Z. Li and B. Cheng and M. Lepp{\"{a}}ranta", title = "{A parametrization fo the ice-ocean drag coefficient}", journal = JGRO, @@ -809,7 +767,7 @@ @Article{Lu11 number = {C7}, url = {http://dx.doi.org/10.1029/2010JC006878} } -@Article{Elliott12, +@Article{Elliott12 author = "S. Elliott and C. Deal and G. Humphries and E. Hunke and N. Jeffery and M. Jin and M. Levasseur and J. Stefels", title = "{Pan-Arctic simulation of coupled nutrient-sulfur cycling due to sea ice biology: Preliminary results}", journal = JGRB, @@ -818,7 +776,7 @@ @Article{Elliott12 issue = {G1}, url = {http://dx.doi.org/10.1029/2011JG001649} } -@Article{Flocco12, +@Article{Flocco12 author = "D. Flocco and D. Schroeder and D.L. Feltham and E.C. Hunke", title = "{Impact of melt ponds on Arctic sea ice simulations from 1990 to 2007}", journal = JGRO, @@ -827,7 +785,7 @@ @Article{Flocco12 number = {C9}, url = {http://dx.doi.org/10.1029/2012JC008195} } -@Article{Holland12, +@Article{Holland12 author = "M.M. Holland and D.A. Bailey and B.P. Briegleb and B. Light and E. Hunke", title = "{Improved sea ice shortwave radiation physics in CCSM4: The impact of melt ponds and aerosols on Arctic sea ice}", journal = JC, @@ -836,7 +794,7 @@ @Article{Holland12 pages = {1413-1430}, url = {http://dx.doi.org/10.1175/JCLI-D-11-00078.1} } -@Article{Lemieux12, +@Article{Lemieux12 author = "J.F. Lemieux and D.A. Knoll and B. Tremblay and D.M. Holland and M. Losch", title = "{A comparison of the {J}acobian-free {N}ewton {K}rylov method and the {EVP} model for solving the sea ice momentum equation with a viscous-plastic formulation: a serial algorithm study}", @@ -855,7 +813,7 @@ @Article{Lepparanta12 pages = {83-91}, doi = {http://dx.doi.org/10.1016/j.coldregions.2011.12.005} } -@Article{Lupkes12, +@Article{Lupkes12 author = "C. Lüpkes and V.M. Gryanik and J. Hartmann and E.L. Andreas", title = "{A parametrization, based on sea ice morphology, of the neutral atmospheric drag coefficients for weather prediction and climate models}", journal = JGRA, @@ -864,7 +822,7 @@ @Article{Lupkes12 number = {D13}, url = {http://dx.doi.org/10.1029/2012JD017630} } -@Article{Mirin12, +@Article{Mirin12 author = "A.A. Mirin and P.H. Worley", title = "{Improving the Performance Scalability of the Community Atmosphere Model}", journal = IJHPCA, @@ -874,18 +832,7 @@ @Article{Mirin12 pages = {17-30}, url = {http://dx.doi.org/10.1177/1094342011412630} } - -@Article{Bouillon09, - author = "S. Bouillon and M.A Morales Maqueda and V. Legat and T. Fichefet", - title = "{An elastic-viscous-plastic sea ice model formulated on Arakawa B and C grids}", - journal = OM, - year = {2009}, - volume = {27}, - pages = {174-184}, - url = {doi:10.1016/j.ocemod.2009.01.004} -} - -@Article{Bouillon13, +@Article{Bouillon13 author = "S. Bouillon and T. Fichefet and V. Legat and G. Madec", title = "{The elastic-viscous-plastic method revisited}", journal = OM, @@ -894,7 +841,7 @@ @Article{Bouillon13 pages = {1-12}, url = {http://dx.doi.org/10.1016/j.ocemod.2013.05.013} } -@Article{Hunke13, +@Article{Hunke13 author = "E.C. Hunke and D.A. Hebert and O. Lecomte", title = "{Level-ice melt ponds in the Los Alamos Sea Ice Model, CICE}", journal = OM, @@ -903,7 +850,7 @@ @Article{Hunke13 pages = {26-42}, url = {http://dx.doi.org/10.1016/j.ocemod.2012.11.008} } -@Article{Tsamados13, +@Article{Tsamados13 author = "M. Tsamados and D.L. Feltham and A.V. Wilchinsky", title = "{Impact of a new anisotropic rheology on simulations of Arctic sea ice}", journal = JGRO, @@ -912,7 +859,7 @@ @Article{Tsamados13 pages = {91-107}, url = {http://dx.doi.org/10.1029/2012JC007990} } -@Article{Turner13, +@Article{Turner13 author = "A.K. Turner and E.C. Hunke and C.M. Bitz", title = "{Two modes of sea-ice gravity drainage: a parameterization for large-scale modeling}", journal = JGRO, @@ -931,7 +878,7 @@ @Article{Craig14 pages = {154-165}, url = {http://dx.doi.org/10.1177/1094342014548771} } -@Article{Tsamados14, +@Article{Tsamados14 author = "M. Tsamados and D.L. Feltham and D. Schroeder and D. Flocco and S.L. Farrell and N.T. Kurtz and S.W. Laxon and S. Bacon", title = "{Impact of variable atmospheric and oceanic form drag on simulations of Arctic sea ice}", journal = JPO, @@ -940,7 +887,7 @@ @Article{Tsamados14 pages = {1329-1353}, url = {http://dx.doi.org/10.1175/JPO-D-13-0215.1} } -@Article{Kimmritz15, +@Article{Kimmritz15 author = "M. Kimmritz and S. Danilov and M. Losch", title = "{On the convergence of the modified elastic-viscous-plastic method for solving the sea ice momentum equation}", journal = JCP, @@ -949,17 +896,6 @@ @Article{Kimmritz15 pages = {90-100}, url = {http://dx.doi.org/10.1016/j.jcp.2015.04.051} } - -@Article{Kimmritz16, - author = "M. Kimmritz and S. Danilov and M. Losch", - title = "{The adaptive EVP method for solving the sea ice momentum equation}", - journal = OM, - year = {2016}, - volume = {101}, - pages = {59-67}, - url = {http://dx.doi.org/10.1016/j.ocemod.2016.03.004} -} - @Article{Roberts15, author = "A.F. Roberts and A.P. Craig and W. Maslowski and R. Osinski and A.K. DuVivier and M. Hughes and B. Nijssen and J.J. Cassano and M. Brunke", title = "{Simulating transient ice-ocean Ekman transport in the Regional Arctic System Model and Community Earth System Model}", @@ -970,7 +906,7 @@ @Article{Roberts15 pages = {211-228}, url = {http://dx.doi.org/10.3189/2015AoG69A760} } -@Article{Lemieux16, +@Article{Lemieux16 author = "J.F. Lemieux and F. Dupont and P. Blain and F. Roy and G.C. Smith and G.M. Flato", title = "{Improving the simulation of landfast ice by combining tensile strength and a parameterization for grounded ridges}", journal = JGRO, @@ -979,7 +915,7 @@ @Article{Lemieux16 pages = {7354-7368}, url = {http://dx.doi.org/10.1002/2016JC012006} } -@Article{Notz16, +@Article{Notz16 author = "D. Notz and A. Jahn and E. Hunke and F. Massonnet and J. Stroeve and B. Tremblay and M. Vancoppenolle", title = "{The CMIP6 Sea-Ice Model Intercomparison Project (SIMIP): understanding sea ice through climate-model simulations}", journal = GMD, @@ -1005,40 +941,15 @@ @Article{Roberts18 } @article{Roach19, - author = "L.A. Roach and C. M. Bitz and C. Horvat and S. M. Dean", - title = {{Advances in modelling interactions between sea ice and ocean surface waves}}, - journal = {Journal of Advances in Modeling Earth Systems}, - url = {http://doi.wiley.com/10.1029/2019MS001836}, - year={2019} -} - -@article{Koldunov19, - author = "N.V. Koldunov and S. Danilov and D. Sidorenko and N. Hutter and M. Losch and H. Goessling and N. Rakowsky and P. Scholz and D. Sein and Q. Wang and T. Jung", - title = {{Fast EVP solutions in a high-resolution sea ice model}}, - journal = {Journal of Advances in Modeling Earth Systems}, - volume={11}, - number={5}, - pages={1269-1284}, - year={2019}, - url = {http://doi.wiley.com/10.1029/2018MS001485} +author = "L.A. Roach and C. M. Bitz and C. Horvat and S. M. Dean", +title = {{Advances in modelling interactions between sea ice and ocean surface waves}}, +journal = {Journal of Advances in Modeling Earth Systems}, +url = {http://doi.wiley.com/10.1029/2019MS001836}, +year={2019} } -@incollection{Arakawa77, - author = "A. Arakawa and V.R. Lamb", - title = "Computational Design of the Basic Dynamical Processes of the UCLA General Circulation Model", - editor = "Julius Chang", - series = "Methods in Computational Physics: Advances in Research and Applications", - publisher = {Elsevier}, - volume = {17}, - pages = {173-265}, - year = {1977}, - booktitle = "General Circulation Models of the Atmosphere", - issn = {0076-6860}, - doi = {https://doi.org/10.1016/B978-0-12-460817-7.50009-4}, - url = {https://www.sciencedirect.com/science/article/pii/B9780124608177500094}, -} - +======= @article{Horvat15, author = "C. Horvat and E. Tziperman", journal = {The Cryosphere}, @@ -1049,7 +960,7 @@ @article{Horvat15 volume = {9}, year = {2015} } -@article{Roach18, + @article{Roach18, author = "L. A. Roach and C. Horvat and S. M. Dean and C. M. Bitz", url = {http://dx.doi.org/10.1029/2017JC013692}, journal = JGRO, @@ -1059,39 +970,6 @@ @article{Roach18 volume = {123}, year = {2018} } - -@Article{Ringeisen21, - author = "D. Ringeisen and L.B. Tremblay and M. Losch", - title = "{Non-normal flow rules affect fracture angles in sea ice viscous-plastic rheologies}", - journal = TC, - year = {2021}, - volume = {15}, - pages = {2873-2888}, - url = {https://doi.org/10.5194/tc-15-2873-2021} -} - -@article{Bouchat22, -author = {Bouchat, Amelie and Hutter, Nils and Chanut, Jerome and Dupont, Frederic and Dukhovskoy, Dmitry and Garric, Gilles and Lee, Younjoo J. and Lemieux, Jean-Francois and Lique, Camille and Losch, Martin and Maslowski, Wieslaw and Myers, Paul G. and Olason, Einar and Rampal, Pierre and Rasmussen, Till and Talandier, Claude and Tremblay, Bruno and Wang, Qiang}, -title = {Sea Ice Rheology Experiment (SIREx): 1. Scaling and Statistical Properties of Sea-Ice Deformation Fields}, -journal = {Journal of Geophysical Research: Oceans}, -volume = {127}, -number = {4}, -pages = {e2021JC017667}, -doi = {https://doi.org/10.1029/2021JC017667}, -url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2021JC017667}, -year = {2022} -} - -@Article{Dupont22, - author = {F. Dupont and D. Dumont and J.F. Lemieux and E. Dumas-Lefebvre and A. Caya}, - title = "{A probabilistic seabed-ice keel interaction model}", - journal = TC, - year = {2022}, - volume = {16}, - pages = {1963-1977}, - url = {https://doi.org/10.5194/tc-16-1963-2022} -} - @Article{Tsujino18, author = "H. Tsujino and S. Urakawa and R.J. Small and W.M. Kim and S.G. Yeager and et al.", title = "{JRA‐55 based surface dataset for driving ocean–sea‐ice models (JRA55‐do)}", @@ -1101,6 +979,31 @@ @Article{Tsujino18 pages = {79-139}, url = {http://dx.doi.org/10.1016/j.ocemod.2018.07.002} } +@Article{Lemieux08, + author = "J.-F. Lemieux and B. Tremblay and S. Thomas and J. Sedláček and L. A. Mysak", + title = "{Using the preconditioned Generalized Minimum RESidual (GMRES) method to solve the sea-ice momentum equation}", + journal = JGRO, + volume = {113}, + number = {C10}, + pages = {}, + keywords = {Sea ice, GMRES, Krylov subspace}, + doi = {10.1029/2007JC004680}, + url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2007JC004680}, + eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2007JC004680}, + year = {2008} +} +@Article{Saad93, + author = "Y. Saad", + title = "{A Flexible Inner-Outer Preconditioned GMRES Algorithm}", + journal = SIAMJCP, + volume = {14}, + number = {2}, + year = {1993}, + pages = {461-469}, + doi = {10.1137/0914028}, + URL = {https://doi.org/10.1137/0914028} +} + % ********************************************** % For new entries, see example entry in BIB_TEMPLATE.txt % ********************************************** diff --git a/doc/source/science_guide/sg_dynamics.rst b/doc/source/science_guide/sg_dynamics.rst index 1ddf94472..e7f214ff7 100644 --- a/doc/source/science_guide/sg_dynamics.rst +++ b/doc/source/science_guide/sg_dynamics.rst @@ -5,6 +5,57 @@ Dynamics ======== +There are different approaches in the CICE code for representing sea ice +rheology and for solving the sea ice momentum equation. The +elastic-viscous-plastic (EVP) model represents a modification of the +standard viscous-plastic (VP) model for sea ice dynamics +:cite:`Hibler79`. The elastic-anisotropic-plastic (EAP) model, +on the other hand, explicitly accounts for the observed sub-continuum +anisotropy of the sea ice cover :cite:`Wilchinsky06,Weiss09`. If +``kdyn`` = 1 in the namelist then the EVP model is used (module +**ice\_dyn\_evp.F90**), while ``kdyn`` = 2 is associated with the EAP +model (**ice\_dyn\_eap.F90**), and ``kdyn`` = 3 is associated with the +VP model (**ice\_dyn\_vp.F90**). + +At times scales associated with the +wind forcing, the EVP model reduces to the VP model while the EAP model +reduces to the anisotropic rheology described in detail in +:cite:`Wilchinsky06,Tsamados13`. At shorter time scales the +adjustment process takes place in both models by a numerically more +efficient elastic wave mechanism. While retaining the essential physics, +this elastic wave modification leads to a fully explicit numerical +scheme which greatly improves the model’s computational efficiency. + +The EVP sea ice dynamics model is thoroughly documented in +:cite:`Hunke97`, :cite:`Hunke01`, +:cite:`Hunke02` and :cite:`Hunke03` and the EAP +dynamics in :cite:`Tsamados13`. Simulation results and +performance of the EVP and EAP models have been compared with the VP +model and with each other in realistic simulations of the Arctic +respectively in :cite:`Hunke99` and +:cite:`Tsamados13`. + +The EVP numerical +implementation in this code release is that of :cite:`Hunke02` +and :cite:`Hunke03`, with revisions to the numerical solver as +in :cite:`Bouillon13`. The implementation of the EAP sea ice +dynamics into CICE is described in detail in +:cite:`Tsamados13`. + +The VP solver implementation mostly follows :cite:`Lemieux08`, with +FGMRES :cite:`Saad93` as the linear solver and GMRES as the preconditioner. +Note that the VP solver has not yet been tested on the ``tx1`` grid or with +threading enabled. + +Here we summarize the equations and +direct the reader to the above references for details. + +.. _momentum: + +******** +Momentum +******** + The force balance per unit area in the ice pack is given by a two-dimensional momentum equation :cite:`Hibler79`, obtained by integrating the 3D equation through the thickness of the ice in the @@ -17,7 +68,7 @@ vertical direction: where :math:`m` is the combined mass of ice and snow per unit area and :math:`\vec{\tau}_a` and :math:`\vec{\tau}_w` are wind and ocean -stresses, respectively. The term :math:`\vec{\tau}_b` is a +stresses, respectively. The term :math:`\vec{\tau}_b` is a seabed stress (also referred to as basal stress) that represents the grounding of pressure ridges in shallow water :cite:`Lemieux16`. The mechanical properties of the ice are represented by the internal stress tensor :math:`\sigma_{ij}`. The other two terms on @@ -33,114 +84,62 @@ For clarity, the two components of Equation :eq:`vpmom` are .. math:: \begin{aligned} - m{\partial u\over\partial t} &= {\partial\sigma_{1j}\over\partial x_j} + \tau_{ax} + + m{\partial u\over\partial t} &= {\partial\sigma_{1j}\over\partial x_j} + \tau_{ax} + a_i c_w \rho_w \left|{\bf U}_w - {\bf u}\right| \left[\left(U_w-u\right)\cos\theta - \left(V_w-v\right)\sin\theta\right] -C_bu +mfv - mg{\partial H_\circ\over\partial x}, \\ - m{\partial v\over\partial t} &= {\partial\sigma_{2j}\over\partial x_j} + \tau_{ay} + + m{\partial v\over\partial t} &= {\partial\sigma_{2j}\over\partial x_j} + \tau_{ay} + a_i c_w \rho_w \left|{\bf U}_w - {\bf u}\right| \left[\left(U_w-u\right)\sin\theta + \left(V_w-v\right)\cos\theta\right] -C_bv-mfu - mg{\partial H_\circ\over\partial y}. \end{aligned} :label: momsys -On the B grid, the equations above are solved at the U point for the collocated u and v components (see figure :ref:`fig-Bgrid`). On the C grid, however, the two components are not collocated: the u component is at the E point while the v component is at the N point. -The B grid spatial discretization is based on a variational method described in :cite:`Hunke97` and :cite:`Hunke02`. A bilinear discretization is used for the stress terms +A bilinear discretization is used for the stress terms :math:`\partial\sigma_{ij}/\partial x_j`, which enables the discrete equations to be derived from the continuous equations written in curvilinear coordinates. In this manner, metric terms associated with the curvature of the grid are incorporated into the discretization explicitly. Details pertaining to -the spatial discretization are found in :cite:`Hunke02` - -On the C grid, however, a finite difference approach is used for the spatial discretization. The C grid discretization is based on :cite:`Bouillon09`, :cite:`Bouillon13` and :cite:`Kimmritz16`. - -There are different approaches in the CICE code for representing sea ice -rheology and for solving the sea ice momentum equation: the viscous-plastic (VP) rheology :cite:`Hibler79` with an implicit method, -the elastic-viscous-plastic (EVP) :cite:`Hunke97` model which represents a modification of the -VP model, the revised EVP (rEVP) approach :cite:`Lemieux12,Bouillon13` and the elastic-anisotropic-plastic (EAP) model which explicitly accounts for the sub-continuum -anisotropy of the sea ice cover :cite:`Wilchinsky06,Weiss09`. If -``kdyn`` = 1 in the namelist then the EVP model is used (module -**ice\_dyn\_evp.F90**), while ``kdyn`` = 2 is associated with the EAP -model (**ice\_dyn\_eap.F90**), and ``kdyn`` = 3 is associated with the -VP model (**ice\_dyn\_vp.F90**). The rEVP approach can be used by setting ``kdyn`` = 1 and ``revised_evp`` = true in the namelist. - -At times scales associated with the -wind forcing, the EVP model reduces to the VP model while the EAP model -reduces to the anisotropic rheology described in detail in -:cite:`Wilchinsky06,Tsamados13`. At shorter time scales the -adjustment process takes place in both models by a numerically more -efficient elastic wave mechanism. While retaining the essential physics, -this elastic wave modification leads to a fully explicit numerical -scheme which greatly improves the model’s computational efficiency. The rEVP is also a fully explicit scheme which by construction should lead to the VP solution. - -The EVP sea ice dynamics model is thoroughly documented in -:cite:`Hunke97`, :cite:`Hunke01`, -:cite:`Hunke02` and :cite:`Hunke03` and the EAP -dynamics in :cite:`Tsamados13`. Simulation results and -performance of the EVP and EAP models have been compared with the VP -model and with each other in realistic simulations of the Arctic -respectively in :cite:`Hunke99` and -:cite:`Tsamados13`. - -The EVP numerical -implementation in this code release is that of :cite:`Hunke02` -and :cite:`Hunke03`, with revisions to the numerical solver as -in :cite:`Bouillon13`. Details about the rEVP solver can be found in :cite:`Lemieux12`, :cite:`Bouillon13`, :cite:`Kimmritz15` and :cite:`Koldunov19`. The implementation of the EAP sea ice -dynamics into CICE is described in detail in -:cite:`Tsamados13`. - -The VP solver implementation mostly follows :cite:`Lemieux08`, with -FGMRES :cite:`Saad93` as the linear solver and GMRES as the preconditioner. -Note that the VP solver has not yet been tested on the ``tx1`` grid. - -The EVP, rEVP, EAP and VP approaches are all available with the B grid. However, at the moment, only the EVP and rEVP schemes are possible with the C grid. - -Here we summarize the equations and -direct the reader to the above references for details. - -.. _momentumTS: - -********************** -Momentum time stepping -********************** +the spatial discretization are found in :cite:`Hunke02`. .. _evp-momentum: -EVP time discretization and solution -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Elastic-Viscous-Plastic +~~~~~~~~~~~~~~~~~~~~~~~ The momentum equation is discretized in time as follows, for the classic EVP approach. In the code, -:math:`{\tt vrel}=a_i c_w \rho_w\left|{\bf U}_w - {\bf u}^k\right|` and -:math:`C_b=T_b \left( \sqrt{(u^k)^2+(v^k)^2}+u_0 \right)^{-1}`, +:math:`{\tt vrel}=a_i c_w \rho_w\left|{\bf U}_w - {\bf u}^k\right|` and +:math:`C_b=T_b \left( \sqrt{(u^k)^2+(v^k)^2}+u_0 \right)^{-1}`, where :math:`k` denotes the subcycling step. The following equations illustrate the time discretization and define some of the other variables used in the code. .. math:: - \underbrace{\left({m\over\Delta t_e}+{\tt vrel} \cos\theta\ + C_b \right)}_{\tt cca} u^{k+1} - - \underbrace{\left(mf+{\tt vrel}\sin\theta\right)}_{\tt ccb}v^{l} + \underbrace{\left({m\over\Delta t_e}+{\tt vrel} \cos\theta\ + C_b \right)}_{\tt cca} u^{k+1} + - \underbrace{\left(mf+{\tt vrel}\sin\theta\right)}_{\tt ccb}v^{k+1} = &\underbrace{{\partial\sigma_{1j}^{k+1}\over\partial x_j}}_{\tt strintx} + \underbrace{\tau_{ax} - mg{\partial H_\circ\over\partial x} }_{\tt forcex} \\ &+ {\tt vrel}\underbrace{\left(U_w\cos\theta-V_w\sin\theta\right)}_{\tt waterx} + {m\over\Delta t_e}u^k, :label: umom .. math:: - \underbrace{\left(mf+{\tt vrel}\sin\theta\right)}_{\tt ccb} u^{l} + \underbrace{\left(mf+{\tt vrel}\sin\theta\right)}_{\tt ccb} u^{k+1} + \underbrace{\left({m\over\Delta t_e}+{\tt vrel} \cos\theta + C_b \right)}_{\tt cca}v^{k+1} = &\underbrace{{\partial\sigma_{2j}^{k+1}\over\partial x_j}}_{\tt strinty} + \underbrace{\tau_{ay} - mg{\partial H_\circ\over\partial y} }_{\tt forcey} \\ &+ {\tt vrel}\underbrace{\left(U_w\sin\theta+V_w\cos\theta\right)}_{\tt watery} + {m\over\Delta t_e}v^k, :label: vmom -where :math:`{\tt vrel}\ \cdot\ {\tt waterx(y)}= {\tt taux(y)}` and the definitions of :math:`u^{l}` and :math:`v^{l}` vary depending on the grid. +and :math:`{\tt vrel}\ \cdot\ {\tt waterx(y)}= {\tt taux(y)}`. -As :math:`u` and :math:`v` are collocated on the B grid, :math:`u^{l}` and :math:`v^{l}` are respectively :math:`u^{k+1}` and :math:`v^{k+1}` such that this system of equations can be solved as follows. Define +We solve this system of equations analytically for :math:`u^{k+1}` and +:math:`v^{k+1}`. Define .. math:: - \hat{u} = F_u + \tau_{ax} - mg{\partial H_\circ\over\partial x} + {\tt vrel} \left(U_w\cos\theta - V_w\sin\theta\right) + {m\over\Delta t_e}u^k + \hat{u} = F_u + \tau_{ax} - mg{\partial H_\circ\over\partial x} + {\tt vrel} \left(U_w\cos\theta - V_w\sin\theta\right) + {m\over\Delta t_e}u^k :label: cevpuhat .. math:: @@ -170,82 +169,25 @@ where .. math:: b = mf + {\tt vrel}\sin\theta. :label: cevpb - -Note that the time discretization and solution method for the EAP is exactly the same as for the B grid EVP. More details on the EAP model are given in Section :ref:`stress-eap`. - -However, on the C grid, :math:`u` and :math:`v` are not collocated. When solving the :math:`u` momentum equation for :math:`u^{k+1}` (at the E point), :math:`v^{l}=v^{k}_{int}` where :math:`v^{k}_{int}` is :math:`v^{k}` from the surrounding N points interpolated to the E point. The same approach is used for the :math:`v` momentum equation. With this explicit treatment of the off-diagonal terms :cite:`Kimmritz16`, :math:`u^{k+1}` and :math:`v^{k+1}` are obtained by solving - -.. math:: - \begin{aligned} - u^{k+1} = {\hat{u} + b v^{k}_{int} \over a} \\ - v^{k+1} = {\hat{v} - b u^{k}_{int} \over a}. \end{aligned} - -.. _revp-momentum: - -Revised EVP time discretization and solution -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The revised EVP approach is based on a pseudo-time iterative scheme :cite:`Lemieux12`, :cite:`Bouillon13`, :cite:`Kimmritz15`. By construction, the revised EVP approach should lead to the VP solution -(given the right numerical parameters and a sufficiently large number of iterations). To do so, the inertial term is formulated such that it matches the backward Euler approach of -implicit solvers and there is an additional term for the pseudo-time iteration. Hence, with the revised approach, the discretized momentum equations :eq:`umom` and :eq:`vmom` become - -.. math:: - {\beta^*(u^{k+1}-u^k)\over\Delta t_e} + {m(u^{k+1}-u^n)\over\Delta t} + {\left({\tt vrel} \cos\theta + C_b \right)} u^{k+1} - - & {\left(mf+{\tt vrel}\sin\theta\right)} v^{l} - = {{\partial\sigma_{1j}^{k+1}\over\partial x_j}} - + {\tau_{ax}} \\ - & - {mg{\partial H_\circ\over\partial x} } - + {\tt vrel} {\left(U_w\cos\theta-V_w\sin\theta\right)}, - :label: umomr - -.. math:: - {\beta^*(v^{k+1}-v^k)\over\Delta t_e} + {m(v^{k+1}-v^n)\over\Delta t} + {\left({\tt vrel} \cos\theta + C_b \right)}v^{k+1} - + & {\left(mf+{\tt vrel}\sin\theta\right)} u^{l} - = {{\partial\sigma_{2j}^{k+1}\over\partial x_j}} - + {\tau_{ay}} \\ - & - {mg{\partial H_\circ\over\partial y} } - + {\tt vrel}{\left(U_w\sin\theta+V_w\cos\theta\right)}, - :label: vmomr - -where :math:`\beta^*` is a numerical parameter and :math:`u^n, v^n` are the components of the previous time level solution. -With :math:`\beta=\beta^* \Delta t \left( m \Delta t_e \right)^{-1}` :cite:`Bouillon13`, these equations can be written as - -.. math:: - \underbrace{\left((\beta+1){m\over\Delta t}+{\tt vrel} \cos\theta\ + C_b \right)}_{\tt cca} u^{k+1} - - \underbrace{\left(mf+{\tt vrel} \sin\theta\right)}_{\tt ccb} & v^{l} - = \underbrace{{\partial\sigma_{1j}^{k+1}\over\partial x_j}}_{\tt strintx} - + \underbrace{\tau_{ax} - mg{\partial H_\circ\over\partial x} }_{\tt forcex} \\ - & + {\tt vrel}\underbrace{\left(U_w\cos\theta-V_w\sin\theta\right)}_{\tt waterx} + {m\over\Delta t}(\beta u^k + u^n), - :label: umomr2 - -.. math:: - \underbrace{\left(mf+{\tt vrel}\sin\theta\right)}_{\tt ccb} u^{l} - + \underbrace{\left((\beta+1){m\over\Delta t}+{\tt vrel} \cos\theta + C_b \right)}_{\tt cca} & v^{k+1} - = \underbrace{{\partial\sigma_{2j}^{k+1}\over\partial x_j}}_{\tt strinty} - + \underbrace{\tau_{ay} - mg{\partial H_\circ\over\partial y} }_{\tt forcey} \\ - & + {\tt vrel}\underbrace{\left(U_w\sin\theta+V_w\cos\theta\right)}_{\tt watery} + {m\over\Delta t}(\beta v^k + v^n), - :label: vmomr2 - -At this point, the solutions :math:`u^{k+1}` and :math:`v^{k+1}` for the B or the C grids are obtained in the same manner as for the standard EVP approach (see Section :ref:`evp-momentum` for details). - + .. _vp-momentum: -Implicit (VP) time discretization and solution -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Viscous-Plastic +~~~~~~~~~~~~~~~ In the VP approach, equation :eq:`momsys` is discretized implicitly using a Backward Euler approach, and stresses are not computed explicitly: .. math:: - \begin{aligned} + \begin{align} m\frac{(u^{n}-u^{n-1})}{\Delta t} &= \frac{\partial \sigma_{1j}^n}{\partial x_j} - \tau_{w,x}^n + \tau_{b,x}^n + mfv^n + r_{x}^n, \\ m\frac{(v^{n}-v^{n-1})}{\Delta t} &= \frac{\partial \sigma^{n} _{2j}}{\partial x_j} - - \tau_{w,y}^n + \tau_{b,y}^n - mfu^{n} + - \tau_{w,y}^n + \tau_{b,y}^n -mfu^{n} + r_{y}^n - \end{aligned} + \end{align} :label: u_sit where :math:`r = (r_x,r_y)` contains all terms that do not depend on the velocities :math:`u^n, v^n` (namely the sea surface tilt and the wind stress). @@ -277,15 +219,6 @@ The Picard iterative process stops when :math:`\left\lVert \mathbf{u}_{k} \right Parameters for the FGMRES linear solver and the preconditioner can be controlled using additional namelist flags (see :ref:`dynamics_nml`). - -.. _surfstress: - -******************** -Surface stress terms -******************** - -The formulation for the wind stress is described in `Icepack Documentation `_. Below, some details about the ice-ocean stress and the seabed stress are given. - Ice-Ocean stress ~~~~~~~~~~~~~~~~ @@ -297,189 +230,89 @@ The Hibler-Bryan form for the ice-ocean stress :cite:`Hibler87` is included in **ice\_dyn\_shared.F90** but is currently commented out, pending further testing. -.. _seabedstress: +.. _seabed-stress: +*************** Seabed stress -~~~~~~~~~~~~~ +*************** -CICE includes two options for calculating the seabed stress, -i.e. the term in the momentum equation that represents the interaction -between grounded ice keels and the seabed. The seabed stress can be -activated by setting ``seabed_stress`` to true in the namelist. The seabed stress (or basal -stress) parameterization of :cite:`Lemieux16` is chosen if ``seabed_stress_method`` = ``LKD`` while the approach based on the probability of contact between the ice and the seabed is used if ``seabed_stress_method`` = ``probabilistic``. - -For both parameterizations, the components of the seabed -stress are expressed as :math:`\tau_{bx}=C_bu` and -:math:`\tau_{by}=C_bv`, where :math:`C_b` is a seabed stress -coefficient. - -The two parameterizations differ in their calculation of -the :math:`C_b` coefficients. - -Note that the user must provide a bathymetry field for using these -grounding schemes. It is suggested to have a bathymetry field with water depths -larger than 5 m that represents well shallow water (less than 30 m) regions such as the Laptev Sea -and the East Siberian Sea. - -**Seabed stress based on linear keel draft (LKD)** - -This parameterization for the seabed stress is described in -:cite:`Lemieux16`. It assumes that the largest keel draft varies linearly with the mean thickness in a grid cell (i.e. sea ice volume). The :math:`C_b` coefficients are expressed as +The parameterization for the seabed stress is described in :cite:`Lemieux16`. The components of the basal seabed stress are +:math:`\tau_{bx}=C_bu` and :math:`\tau_{by}=C_bv`, where :math:`C_b` is a coefficient expressed as .. math:: - C_b= k_2 \max [0,(h - h_{c})] e^{-\alpha_b * (1 - a)} (\sqrt{u^2+v^2}+u_0)^{-1}, \\ - :label: Cb - -where :math:`k_2` determines the maximum seabed stress that can be sustained by the grounded parameterized ridge(s), :math:`u_0` -is a small residual velocity and :math:`\alpha_b` is a parameter to ensure that the seabed stress quickly drops when -the ice concentration is smaller than 1. In the code, :math:`k_2 \max [0,(h - h_{c})] e^{-\alpha_b * (1 - a)}` is defined as -:math:`T_b`. + C_b= k_2 \max [0,(h_u - h_{cu})] e^{-\alpha_b * (1 - a_u)} (\sqrt{u^2+v^2}+u_0)^{-1}, \\ + :label: Cb -On the B grid, the quantities :math:`h`, :math:`a` and :math:`h_{c}` are calculated at -the U point and are referred to as :math:`h_u`, :math:`a_{u}` and :math:`h_{cu}`. They are respectively given by +where :math:`k_2` determines the maximum seabed stress that can be sustained by the grounded parameterized ridge(s), :math:`u_0` +is a small residual velocity and :math:`\alpha_b` is a parameter to ensure that the seabed stress quickly drops when +the ice concentration is smaller than 1. In the code, :math:`k_2 \max [0,(h_u - h_{cu})] e^{-\alpha_b * (1 - a_u)}` is defined as +:math:`T_b`. The quantities :math:`h_u`, :math:`a_{u}` and :math:`h_{cu}` are calculated at +the 'u' point based on local ice conditions (surrounding tracer points). They are respectively given by .. math:: h_u=\max[v_i(i,j),v_i(i+1,j),v_i(i,j+1),v_i(i+1,j+1)], \\ - :label: hu - + :label: hu + .. math:: - a_u=\max[a_i(i,j),a_i(i+1,j),a_i(i,j+1),a_i(i+1,j+1)], \\ - :label: au - + a_u=\max[a_i(i,j),a_i(i+1,j),a_i(i,j+1),a_i(i+1,j+1)]. \\ + :label: au + .. math:: h_{cu}=a_u h_{wu} / k_1, \\ :label: hcu -where the :math:`a_i` and :math:`v_i` are the total ice concentrations and ice volumes around the U point :math:`i,j` and -:math:`k_1` is a parameter that defines the critical ice thickness :math:`h_{cu}` at which the parameterized -ridge(s) reaches the seafloor for a water depth :math:`h_{wu}=\min[h_w(i,j),h_w(i+1,j),h_w(i,j+1),h_w(i+1,j+1)]`. Given the formulation of :math:`C_b` in equation :eq:`Cb`, the seabed stress components are non-zero only -when :math:`h_u > h_{cu}`. - -As :math:`u` and :math:`v` are not collocated on the C grid, :math:`T_b` is calculated at E and N points. For example, at the E point, :math:`h_e`, :math:`a_{e}` and :math:`h_{ce}` are respectively - -.. math:: - h_e=\max[v_i(i,j),v_i(i+1,j)], \\ - :label: he - -.. math:: - a_e=\max[a_i(i,j),a_i(i+1,j)], \\ - :label: ae - -.. math:: - h_{ce}=a_e h_{we} / k_1, \\ - :label: hce - -where :math:`h_{we}=\min[h_w(i,j),h_w(i+1,j)]`. Similar calculations are done at the N points. - -To prevent unrealistic grounding, :math:`T_b` is set to zero when :math:`h_{wu}` -is larger than 30 m (same idea on the C grid depending on :math:`h_{we}` and :math:`h_{wn}`). This maximum value is chosen based on observations of large keels in the Arctic Ocean :cite:`Amundrud04`. - -The maximum seabed stress depends on the weight of the ridge -above hydrostatic balance and the value of :math:`k_2`. It is, however, the parameter :math:`k_1` that has the most notable impact on the simulated extent of landfast ice. -The value of :math:`k_1` can be changed at runtime using the namelist variable ``k1``. - -**Seabed stress based on probabilistic approach** - -This more sophisticated grounding parameterization computes the seabed stress based -on the probability of contact between the ice thickness distribution -(ITD) and the seabed :cite:`Dupont22`. Multi-thickness category models such as CICE typically use a -few thickness categories (5-10). This crude representation of the ITD -does not resolve the tail of the ITD, which is crucial for grounding -events. +where the :math:`a_i` and :math:`v_i` are the total ice concentrations and ice volumes around the :math:`u` point :math:`i,j` and +:math:`k_1` is a parameter that defines the critical ice thickness :math:`h_{cu}` at which the parameterized +ridge(s) reaches the seafloor for a water depth :math:`h_{wu}=\min[h_w(i,j),h_w(i+1,j),h_w(i,j+1),h_w(i+1,j+1)]`. Given the formulation of :math:`C_b` in equation :eq:`Cb`, the seabed stress components are non-zero only +when :math:`h_u > h_{cu}`. -To represent the tail of the distribution, the simulated ITD is -converted to a positively skewed probability function :math:`f(x)` -with :math:`x` the sea ice thickness. The mean and variance are set -equal to the ones of the original ITD. A -log-normal distribution is used for :math:`f(x)`. +The maximum seabed stress depends on the weight of the ridge +above hydrostatic balance and the value of :math:`k_2`. It is, however, the parameter :math:`k_1` that has the most notable impact on the simulated extent of landfast ice. +The value of :math:`k_1` can be changed at runtime using the namelist variable ``k1``. The grounding scheme can be turned on or off using the namelist logical basalstress. -It is assumed that the bathymetry :math:`y` (at the 't' point) follows a normal -distribution :math:`b(y)`. The mean of :math:`b(y)` comes from the user's bathymetry field and the -standard deviation :math:`\sigma_b` is currently fixed to 2.5 m. Two -possible improvements would be to specify a distribution based on high -resolution bathymetry data and to take into account variations of the -water depth due to changes in the sea surface height. - -Assuming hydrostatic balance and neglecting the impact of snow, the draft of floating ice of thickness -:math:`x` is :math:`D(x)=\rho_i x / \rho_w` where :math:`\rho_i` is the sea ice density. Hence, the probability of contact (:math:`P_c`) between the -ITD and the seabed is given by - -.. math:: - P_c=\int_{0}^{\inf} \int_{0}^{D(x)} g(x)b(y) dy dx \label{prob_contact}. - -:math:`T_b` is first calculated at the T point (referred to as :math:`T_{bt}`). :math:`T_{bt}` depends on the weight of the ridge in excess of hydrostatic balance. The parameterization first calculates - -.. math:: - T_{bt}^*=\mu_s g \int_{0}^{\inf} \int_{0}^{D(x)} (\rho_i x - \rho_w - y)g(x)b(y) dy dx, \\ - :label: Tbt - -and then obtains :math:`T_{bt}` by multiplying :math:`T_{bt}^*` by :math:`e^{-\alpha_b * (1 - a_i)}` (similar to what is done for ``seabed_stress_method`` = ``LKD``). - -To calculate :math:`T_{bt}^*` in equation :eq:`Tbt`, :math:`f(x)` and :math:`b(y)` are discretized using many small categories (100). :math:`f(x)` is discretized between 0 and 50 m while :math:`b(y)` is truncated at plus and minus three :math:`\sigma_b`. :math:`f(x)` is also modified by setting it to zero after a certain percentile of the log-normal distribution. This percentile, which is currently set to 99.7%, notably affects the simulation of landfast ice and is used as a tuning parameter. Its impact is similar to the one of the parameter :math:`k_1` for the LKD method. - -On the B grid, :math:`T_b` at the U point is calculated from the T point values around it according to - -.. math:: - T_{bu}=\max[T_{bt}(i,j),T_{bt}(i+1,j),T_{bt}(i,j+1),T_{bt}(i+1,j+1)]. \\ - :label: Tb - -Following again the LKD method, the seabed stress coefficients are finally expressed as - -.. math:: - C_b= T_{bu} (\sqrt{u^2+v^2}+u_0)^{-1}. \\ - :label: Cb2 - -On the C grid, :math:`T_b` is needs to be calculated at the E and N points. :math:`T_{be}` and :math:`T_{bn}` are respectively given by - -.. math:: - T_{be}=\max[T_{bt}(i,j),T_{bt}(i+1,j)], \\ - :label: Tbe - -.. math:: - T_{bn}=\max[T_{bt}(i,j),T_{bt}(i,j+1)]. \\ - :label: Tbn - -The :math:`C_{b}` are different at the E and N points and are respectively :math:`T_{be} (\sqrt{u^2+v^2_{int}}+u_0)^{-1}` and :math:`T_{bn} (\sqrt{u^2_{int} + v^2}+u_0)^{-1}` where :math:`v_{int}` (:math:`u_{int}`) is :math:`v` ( :math:`u`) interpolated to the E (N) point. +Note that the user must provide a bathymetry field for using this grounding +scheme. It is suggested to have a bathymetry field with water depths larger than +5 m that represents well shallow water regions such as the Laptev Sea and the +East Siberian Sea. To prevent unrealistic grounding, :math:`T_b` is set to zero when :math:`h_{wu}` +is larger than 30 m. This maximum value is chosen based on observations of large +keels in the Arctic Ocean :cite:`Amundrud04`. + .. _internal-stress: -******** -Rheology -******** +*************** +Internal stress +*************** For convenience we formulate the stress tensor :math:`\bf \sigma` in -terms of :math:`\sigma_1=\sigma_{11}+\sigma_{22}` (``stressp``), -:math:`\sigma_2=\sigma_{11}-\sigma_{22}` (``stressm``), and introduce the +terms of :math:`\sigma_1=\sigma_{11}+\sigma_{22}`, +:math:`\sigma_2=\sigma_{11}-\sigma_{22}`, and introduce the divergence, :math:`D_D`, and the horizontal tension and shearing strain rates, :math:`D_T` and :math:`D_S` respectively: .. math:: - D_D = \dot{\epsilon}_{11} + \dot{\epsilon}_{22}, + D_D = \dot{\epsilon}_{11} + \dot{\epsilon}_{22}, .. math:: - D_T = \dot{\epsilon}_{11} - \dot{\epsilon}_{22}, + D_T = \dot{\epsilon}_{11} - \dot{\epsilon}_{22}, .. math:: - D_S = 2\dot{\epsilon}_{12}, + D_S = 2\dot{\epsilon}_{12}, where .. math:: \dot{\epsilon}_{ij} = {1\over 2}\left({{\partial u_i}\over{\partial x_j}} + {{\partial u_j}\over{\partial x_i}}\right) -Note that :math:`\sigma_1` and :math:`\sigma_2` are not to be confused with the normalized principal stresses, -:math:`\sigma_{n,1}` and :math:`\sigma_{n,2}` (``sig1`` and ``sig2``), which are defined as: - -.. math:: - \sigma_{n,1}, \sigma_{n,2} = \frac{1}{P} \left( \frac{\sigma_1}{2} \pm \sqrt{\left(\frac{\sigma_2}{2}\right)^2 + \sigma_{12}^2} \right) - -where :math:`P` is the ice strength. - -In addition to the normalized principal stresses, CICE can output the internal ice pressure which is an important field to support navigation in ice-infested water. -The internal ice pressure (``sigP``) is the average of the normal stresses (:math:`\sigma_{11}`, :math:`\sigma_{22}`) multiplied by :math:`-1` and +CICE can output the internal ice pressure which is an important field to support navigation in ice-infested water. +The internal ice pressure (``sigP``) is the average of the normal stresses multiplied by :math:`-1` and is therefore simply equal to :math:`-\sigma_1/2`. +Following the approach of :cite:`Konig10` (see also :cite:`Lemieux16`), the +elliptical yield curve can be modified such that the ice has isotropic tensile strength. +The tensile strength :math:`T_p` is expressed as a fraction of the ice strength :math:`P`, that is :math:`T_p=k_t P` +where :math:`k_t` should be set to a value between 0 and 1 (this can be changed at runtime with the namelist parameter ``Ktens``). + .. _stress-vp: Viscous-Plastic @@ -488,50 +321,30 @@ Viscous-Plastic The VP constitutive law is given by .. math:: - \sigma_{ij} = 2 \eta \dot{\epsilon}_{ij} + (\zeta - \eta) D_D - P_R\frac{\delta_{ij}}{2} + \sigma_{ij} = 2 \eta \dot{\epsilon}_{ij} + (\zeta - \eta) D_D - P_R(1 - k_t)\frac{\delta_{ij}}{2} :label: vp-const -where :math:`\eta` and :math:`\zeta` are the bulk and shear viscosities and -:math:`P_R` is a “replacement pressure” (see :cite:`Geiger98`, for example), -which serves to prevent residual ice motion due to spatial -variations of the ice strength :math:`P` when the strain rates are exactly zero. - +where :math:`\eta` and :math:`\zeta` are the bulk and shear viscosities. An elliptical yield curve is used, with the viscosities given by .. math:: - \zeta = {P(1+k_t)\over 2\Delta}, - :label: zeta + \zeta = {P(1+k_t)\over 2\Delta}, .. math:: - \eta = e_g^{-2} \zeta, - :label: eta + \eta = {P(1+k_t)\over {2\Delta e^2}}, where .. math:: - \Delta = \left[D_D^2 + {e_f^2\over e_g^4}\left(D_T^2 + D_S^2\right)\right]^{1/2}. - :label: Delta + \Delta = \left[D_D^2 + {1\over e^2}\left(D_T^2 + D_S^2\right)\right]^{1/2} -When the deformation :math:`\Delta` tends toward zero, the viscosities tend toward infinity. To avoid this issue, :math:`\Delta` needs to be limited and is replaced by :math:`\Delta^*` in equation :eq:`zeta`. Two methods for limiting :math:`\Delta` (or for capping the viscosities) are available in the code. If the namelist parameter ``capping_method`` is set to ``max``, :math:`\Delta^*=max(\Delta, \Delta_{min})` :cite:`Hibler79` while with ``capping_method`` set to ``sum``, the smoother formulation :math:`\Delta^*=(\Delta + \Delta_{min})` of :cite:`Kreyscher00` is used. - -The ice strength :math:`P` is a function of the ice thickness distribution as -described in the `Icepack Documentation `_. - -Two other modifications to the standard VP rheology of :cite:`Hibler79` are available. -First, following the approach of :cite:`Konig10` (see also :cite:`Lemieux16`), the -elliptical yield curve can be modified such that the ice has isotropic tensile strength. -The tensile strength is expressed as a fraction of :math:`P`, that is :math:`k_t P` -where :math:`k_t` should be set to a value between 0 and 1 (this can -be changed at runtime with the namelist parameter ``Ktens``). +and :math:`P_R` is a “replacement pressure” (see :cite:`Geiger98`, for +example), which serves to prevent residual ice motion due to spatial +variations of :math:`P` when the rates of strain are exactly zero. -Second, while :math:`e_f` is the ratio of the major and minor axes of the elliptical yield curve, the parameter -:math:`e_g` characterizes the plastic potential, i.e. another ellipse that decouples the flow rule from the -yield curve (:cite:`Ringeisen21`). :math:`e_f` and :math:`e_g` are respectively called ``e_yieldcurve`` and ``e_plasticpot`` in the code and -can be set in the namelist. The plastic potential can lead to more realistic fracture angles between linear kinematic features. :cite:`Ringeisen21` suggest to set :math:`e_f` to a value larger than 1 and to have :math:`e_g < e_f`. - -By default, the namelist parameters are set to :math:`e_f=e_g=2` and :math:`k_t=0` which correspond to the standard VP rheology. - -There are four options in the code for solving the sea ice momentum equation with a VP formulation: the standard EVP approach, a 1d EVP solver, the revised EVP approach and an implicit Picard solver. The choice of the capping method for the viscosities and the modifications to the yield curve and to the flow rule described above are available for these four different solution methods. Note that only the EVP and revised EVP methods are currently available if one chooses the C grid. +The ice strength :math:`P` +is a function of the ice thickness and concentration +as described in the `Icepack Documentation `_. The parameter :math:`e` is the ratio of the major and minor axes of the elliptical yield curve, also called the ellipse aspect ratio. It can be changed using the namelist parameter ``e_ratio``. .. _stress-evp: @@ -543,7 +356,7 @@ regularized version of the VP constitutive law :eq:`vp-const`. The constitutive .. math:: {1\over E}{\partial\sigma_1\over\partial t} + {\sigma_1\over 2\zeta} - + {P_R\over 2\zeta} = D_D, \\ + + {P_R(1-k_t)\over 2\zeta} = D_D, \\ :label: sig1 .. math:: @@ -561,75 +374,41 @@ dynamics component is subcycled within the time step, and the elastic parameter :math:`E` is defined in terms of a damping timescale :math:`T` for elastic waves, :math:`\Delta t_e < T < \Delta t`, as -.. math:: +.. math:: E = {\zeta\over T}, -where :math:`T=E_\circ\Delta t` and :math:`E_\circ` (elasticDamp) is a tunable +where :math:`T=E_\circ\Delta t` and :math:`E_\circ` (eyc) is a tunable parameter less than one. Including the modification proposed by :cite:`Bouillon13` for equations :eq:`sig2` and :eq:`sig12` in order to improve numerical convergence, the stress equations become .. math:: \begin{aligned} - {\partial\sigma_1\over\partial t} + {\sigma_1\over 2T} - + {P_R\over 2T} &=& {\zeta \over T} D_D, \\ - {\partial\sigma_2\over\partial t} + {\sigma_2\over 2T} &=& {\eta \over - T} D_T,\\ + {\partial\sigma_1\over\partial t} + {\sigma_1\over 2T} + + {P_R(1-k_t)\over 2T} &=& {P(1+k_t)\over 2T\Delta} D_D, \\ + {\partial\sigma_2\over\partial t} + {\sigma_2\over 2T} &=& {P(1+k_t)\over + 2Te^2\Delta} D_T,\\ {\partial\sigma_{12}\over\partial t} + {\sigma_{12}\over 2T} &=& - {\eta \over 2T}D_S.\end{aligned} + {P(1+k_t)\over 4Te^2\Delta}D_S.\end{aligned} Once discretized in time, these last three equations are written as .. math:: \begin{aligned} - {(\sigma_1^{k+1}-\sigma_1^{k})\over\Delta t_e} + {\sigma_1^{k+1}\over 2T} - + {P_R^k\over 2T} &=& {\zeta^k\over T} D_D^k, \\ - {(\sigma_2^{k+1}-\sigma_2^{k})\over\Delta t_e} + {\sigma_2^{k+1}\over 2T} &=& {\eta^k \over - T} D_T^k,\\ + {(\sigma_1^{k+1}-\sigma_1^{k})\over\Delta t_e} + {\sigma_1^{k+1}\over 2T} + + {P_R^k(1-k_t)\over 2T} &=& {P(1+k_t)\over 2T\Delta^k} D_D^k, \\ + {(\sigma_2^{k+1}-\sigma_2^{k})\over\Delta t_e} + {\sigma_2^{k+1}\over 2T} &=& {P(1+k_t)\over + 2Te^2\Delta^k} D_T^k,\\ {(\sigma_{12}^{k+1}-\sigma_{12}^{k})\over\Delta t_e} + {\sigma_{12}^{k+1}\over 2T} &=& - {\eta^k \over 2T}D_S^k,\end{aligned} - :label: sigdisc - + {P(1+k_t)\over 4Te^2\Delta^k}D_S^k,\end{aligned} + :label: sigdisc + where :math:`k` denotes again the subcycling step. All coefficients on the left-hand side are constant except for :math:`P_R`. This modification compensates for the decreased efficiency of including -the viscosity terms in the subcycling. Choices of the parameters used to define :math:`E`, +the viscosity terms in the subcycling. (Note that the viscosities do not +appear explicitly.) Choices of the parameters used to define :math:`E`, :math:`T` and :math:`\Delta t_e` are discussed in Sections :ref:`revp` and :ref:`parameters`. -On the B grid, the stresses :math:`\sigma_{1}`, :math:`\sigma_{2}` and :math:`\sigma_{12}` are collocated at the U point. To calculate these stresses, the viscosities :math:`\zeta` and :math:`\eta` and the replacement pressure :math:`P_R` are also defined at the U point. - -However, on the C grid, :math:`\sigma_{1}` and :math:`\sigma_{2}` are collocated at the T point while :math:`\sigma_{12}` is defined at the U point. During a subcycling step, :math:`\zeta`, :math:`\eta` and :math:`P_R` are first calculated at the T point. To do so, :math:`\Delta` given by equation :eq:`Delta` is calculated following the approach of :cite:`Bouillon13` (see also :cite:`Kimmritz16` for details). With this approach, :math:`D_S^2` at the T point is obtained by calculating :math:`D_S^2` at the U points and interpolating these values to the T point. As :math:`\sigma_{12}` is calculated at the U point, :math:`\eta` also needs to be computed as these locations. If ``visc_method`` in the namelist is set to ``avg_zeta`` (the default value), :math:`\eta` at the U point is obtained by interpolating T point values to this location. This corresponds to the approach used by :cite:`Bouillon13` and the one associated with the C1 configuration of :cite:`Kimmritz16`. On the other hand, if ``visc_method = avg_strength``, the strength :math:`P` calculated at T points is interpolated to the U point and :math:`\Delta` is calculated at the U point in order to obtain :math:`\eta` following equations :eq:`zeta` and :eq:`eta`. This latter approach is the one used in the C2 configuration of :cite:`Kimmritz16`. - -.. _evp1d: - -1d EVP solver -~~~~~~~~~~~~~ - -The standard EVP solver iterates hundreds of times, where each iteration includes a communication through MPI and a limited number of calculations. This limits how much the solver can be optimized as the speed is primarily determined by the communication. The 1d EVP solver avoids the communication by utilizing shared memory, which removes the requirement for calls to the MPI communicator. As a consequence of this the potential scalability of the code is improved. The performance is best on shared memory but the solver is also functional on MPI and hybrid MPI/OpenMP setups as it will run on the master processor alone. - -The scalability of geophysical models is in general terms limited by the memory usage. In order to optimize this the 1d EVP solver solves the same equations that are outlined in the section :ref:`stress-evp` but it transforms all matrices to vectors (1d matrices) as this compiles better with the computer hardware. The vectorization and the contiguous placement of arrays in the memory makes it easier for the compiler to optimize the code and pass pointers instead of copying the vectors. The 1d solver is not supported for tripole grids and the code will abort if this combination is attempted. - -.. _revp: - -Revised EVP approach -~~~~~~~~~~~~~~~~~~~~ - -Introducing the numerical parameter :math:`\alpha=2T \Delta t_e ^{-1}` :cite:`Bouillon13`, the stress equations in :eq:`sigdisc` become - -.. math:: - \begin{aligned} - {\alpha (\sigma_1^{k+1}-\sigma_1^{k})} + {\sigma_1^{k}} - + {P_R^k} &=& 2 \zeta^k D_D^k, \\ - {\alpha (\sigma_2^{k+1}-\sigma_2^{k})} + {\sigma_2^{k}} &=& 2 \eta^k D_T^k,\\ - {\alpha (\sigma_{12}^{k+1}-\sigma_{12}^{k})} + {\sigma_{12}^{k}} &=& - \eta^k D_S^k,\end{aligned} - -where as opposed to the classic EVP, the second term in each equation is at iteration :math:`k` :cite:`Bouillon13`. Also, contrary to the classic EVP, -:math:`\Delta t_e` times the number of subcycles (or iterations) does not need to be equal to the advective time step :math:`\Delta t`. -Finally, as with the classic EVP approach, the stresses are initialized using the previous time level values. -The revised EVP is activated by setting the namelist parameter ``revised_evp = true``. -In the code :math:`\alpha` is ``arlx`` and :math:`\beta` is ``brlx`` (introduced in Section :ref:`revp-momentum`). The values of ``arlx`` and ``brlx`` can be set in the namelist. -It is recommended to use large values of these parameters and to set :math:`\alpha=\beta` :cite:`Kimmritz15`. - .. _stress-eap: Elastic-Anisotropic-Plastic @@ -646,7 +425,7 @@ anisotropy of the sea ice cover is accounted for by an additional prognostic variable, the structure tensor :math:`\mathbf{A}` defined by -.. math:: +.. math:: {\mathbf A}=\int_{\mathbb{S}}\vartheta(\mathbf r)\mathbf r\mathbf r d\mathbf r\label{structuretensor}. where :math:`\mathbb{S}` is a unit-radius circle; **A** is a unit @@ -665,7 +444,7 @@ components of :math:`\mathbf{A}`, :math:`A_{1}/A_{2}`, are derived from the phenomenological evolution equation for the structure tensor :math:`\mathbf A`, -.. math:: +.. math:: \frac{D\mathbf{A}}{D t}=\mathbf{F}_{iso}(\mathbf{A})+\mathbf{F}_{frac}(\mathbf{A},\boldsymbol\sigma), :label: evolutionA @@ -729,7 +508,7 @@ of two equations: .. math:: \begin{aligned} - \frac{\partial A_{11}}{\partial t}&=&-k_{t}\left(A_{11}-\frac{1}{2}\right)+M_{11} \mbox{,} \\ + \frac{\partial A_{11}}{\partial t}&=&-k_{t}\left(A_{11}-\frac{1}{2}\right)+M_{11} \mbox{,} \\ \frac{\partial A_{12}}{\partial t}&=&-k_{t} A_{12}+M_{12} \mbox{,}\end{aligned} where the first terms on the right hand side correspond to the @@ -766,7 +545,7 @@ but in a continuum-scale sea ice region the floes can possess different orientations in different places and we take the mean sea ice stress over a collection of floes to be given by the average -.. math:: +.. math:: \boldsymbol\sigma^{EAP}(h)=P_{r}(h)\int_{\mathbb{S}}\vartheta(\mathbf r)\left[\boldsymbol\sigma_{r}^{b}(\mathbf r)+ k \boldsymbol\sigma_{s}^{b}(\mathbf r)\right]d\mathbf r :label: stressaverage @@ -781,11 +560,11 @@ efficient, explicit numerical algorithm used to solve the full sea ice momentum balance. We use the analogous EAP stress equations, .. math:: - \frac{\partial \sigma_{1}}{\partial t}+\frac{\sigma_1}{2T} = \frac{\sigma^{EAP}_{1}}{2T} \mbox{,} + \frac{\partial \sigma_{1}}{\partial t}+\frac{\sigma_1}{2T} = \frac{\sigma^{EAP}_{1}}{2T} \mbox{,} :label: EAPsigma1 .. math:: - \frac{\partial \sigma_{2}}{\partial t}+\frac{\sigma_2}{2T} = \frac{\sigma^{EAP}_{2}}{2T} \mbox{,} + \frac{\partial \sigma_{2}}{\partial t}+\frac{\sigma_2}{2T} = \frac{\sigma^{EAP}_{2}}{2T} \mbox{,} :label: EAPsigma2 .. math:: @@ -817,3 +596,68 @@ rheology we compute the area loss rate due to ridging as Both ridging rate and sea ice strength are computed in the outer loop of the dynamics. + +.. _revp: + +**************** +Revised approach +**************** + +The revised EVP approach is based on a pseudo-time iterative scheme :cite:`Lemieux12`, :cite:`Bouillon13`, :cite:`Kimmritz15`. By construction, the revised EVP approach should lead to the VP solution +(given the right numerical parameters and a sufficiently large number of iterations). To do so, the inertial term is formulated such that it matches the backward Euler approach of +implicit solvers and there is an additional term for the pseudo-time iteration. Hence, with the revised approach, the discretized momentum equations :eq:`umom` and :eq:`vmom` become + +.. math:: + {\beta^*(u^{k+1}-u^k)\over\Delta t_e} + {m(u^{k+1}-u^n)\over\Delta t} + {\left({\tt vrel} \cos\theta + C_b \right)} u^{k+1} + - {\left(mf+{\tt vrel}\sin\theta\right)} v^{k+1} + = {{\partial\sigma_{1j}^{k+1}\over\partial x_j}} + + {\tau_{ax} - mg{\partial H_\circ\over\partial x} } + + {\tt vrel} {\left(U_w\cos\theta-V_w\sin\theta\right)}, + :label: umomr + +.. math:: + {\beta^*(v^{k+1}-v^k)\over\Delta t_e} + {m(v^{k+1}-v^n)\over\Delta t} + {\left({\tt vrel} \cos\theta + C_b \right)}v^{k+1} + + {\left(mf+{\tt vrel}\sin\theta\right)} u^{k+1} + = {{\partial\sigma_{2j}^{k+1}\over\partial x_j}} + + {\tau_{ay} - mg{\partial H_\circ\over\partial y} } + + {\tt vrel}{\left(U_w\sin\theta+V_w\cos\theta\right)}, + :label: vmomr + +where :math:`\beta^*` is a numerical parameter and :math:`u^n, v^n` are the components of the previous time level solution. +With :math:`\beta=\beta^* \Delta t \left( m \Delta t_e \right)^{-1}` :cite:`Bouillon13`, these equations can be written as + +.. math:: + \underbrace{\left((\beta+1){m\over\Delta t}+{\tt vrel} \cos\theta\ + C_b \right)}_{\tt cca} u^{k+1} + - \underbrace{\left(mf+{\tt vrel}\sin\theta\right)}_{\tt ccb}v^{k+1} + = \underbrace{{\partial\sigma_{1j}^{k+1}\over\partial x_j}}_{\tt strintx} + + \underbrace{\tau_{ax} - mg{\partial H_\circ\over\partial x} }_{\tt forcex} + + {\tt vrel}\underbrace{\left(U_w\cos\theta-V_w\sin\theta\right)}_{\tt waterx} + {m\over\Delta t}(\beta u^k + u^n), + :label: umomr2 + +.. math:: + \underbrace{\left(mf+{\tt vrel}\sin\theta\right)}_{\tt ccb} u^{k+1} + + \underbrace{\left((\beta+1){m\over\Delta t}+{\tt vrel} \cos\theta + C_b \right)}_{\tt cca}v^{k+1} + = \underbrace{{\partial\sigma_{2j}^{k+1}\over\partial x_j}}_{\tt strinty} + + \underbrace{\tau_{ay} - mg{\partial H_\circ\over\partial y} }_{\tt forcey} + + {\tt vrel}\underbrace{\left(U_w\sin\theta+V_w\cos\theta\right)}_{\tt watery} + {m\over\Delta t}(\beta v^k + v^n), + :label: vmomr2 + +At this point, the solutions :math:`u^{k+1}` and :math:`v^{k+1}` are obtained in the same manner as for the standard EVP approach (see equations :eq:`cevpuhat` to :eq:`cevpb`). + +Introducing another numerical parameter :math:`\alpha=2T \Delta t_e ^{-1}` :cite:`Bouillon13`, the stress equations in :eq:`sigdisc` become + +.. math:: + \begin{aligned} + {\alpha (\sigma_1^{k+1}-\sigma_1^{k})} + {\sigma_1^{k}} + + {P_R^k(1-k_t)} &=& {P(1+k_t)\over \Delta^k} D_D^k, \\ + {\alpha (\sigma_2^{k+1}-\sigma_2^{k})} + {\sigma_2^{k}} &=& {P(1+k_t)\over + e^2\Delta^k} D_T^k,\\ + {\alpha (\sigma_{12}^{k+1}-\sigma_{12}^{k})} + {\sigma_{12}^{k}} &=& + {P(1+k_t)\over 2e^2\Delta^k}D_S^k,\end{aligned} + +where as opposed to the classic EVP, the second term in each equation is at iteration :math:`k` :cite:`Bouillon13`. Also, as opposed to the classic EVP, +:math:`\Delta t_e` times the number of subcycles (or iterations) does not need to be equal to the advective time step :math:`\Delta t`. +Finally, as with the classic EVP approach, the stresses are initialized using the previous time level values. +The revised EVP is activated by setting the namelist parameter ``revised_evp = true``. +In the code :math:`\alpha` is ``arlx`` and :math:`\beta` is ``brlx``. The values of ``arlx`` and ``brlx`` can be set in the namelist. +It is recommended to use large values of these parameters and to set :math:`\alpha=\beta` :cite:`Kimmritz15`. diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 032c8b529..227a63663 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -349,6 +349,8 @@ thermo_nml "``sw_dtemp``", "real", "temperature difference from melt to start redistributing", "0.02" "", "", "", "" +.. _dynamics_nml: + dynamics_nml ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -369,10 +371,13 @@ dynamics_nml "", "``zero``", "zero coriolis", "" "``Cstar``", "real", "constant in Hibler strength formula", "20" "``e_ratio``", "real", "EVP ellipse aspect ratio", "2.0" + "``dim_fgmres``", "integer", "maximum number of Arnoldi iterations for FGMRES solver", "50" + "``dim_pgmres``", "integer", "maximum number of Arnoldi iterations for PGMRES preconditioner", "5" "``kdyn``", "``-1``", "dynamics algorithm OFF", "1" "", "``0``", "dynamics OFF", "" "", "``1``", "EVP dynamics", "" "", "``2``", "EAP dynamics", "" + "", "``3``", "VP dynamics", "" "``kevp_kernel``", "``0``", "standard 2D EVP memory parallel solver", "0" "", "``2``", "1D shared memory solver (not fully validated)", "" "``kstrength``", "``0``", "ice strength formulation :cite:`Hibler79`", "1" @@ -388,9 +393,23 @@ dynamics_nml "``Ktens``", "real", "Tensile strength factor (see :cite:`Konig10`)", "0.0" "``k1``", "real", "1st free parameter for landfast parameterization", "8.0" "``k2``", "real", "2nd free parameter (N/m\ :math:`^3`) for landfast parameterization", "15.0" + "``maxits_nonlin``", "integer", "maximum number of nonlinear iterations for VP solver", "1000" + "``maxits_fgmres``", "integer", "maximum number of restarts for FGMRES solver", "1" + "``maxits_pgmres``", "integer", "maximum number of restarts for PGMRES preconditioner", "1" + "``monitor_nonlin``", "logical", "write velocity norm at each nonlinear iteration", "``.false.``" + "``monitor_fgmres``", "logical", "write velocity norm at each FGMRES iteration", "``.false.``" + "``monitor_pgmres``", "logical", "write velocity norm at each PGMRES iteration", "``.false.``" "``mu_rdg``", "real", "e-folding scale of ridged ice for ``krdg_partic`` = 1 in m^0.5", "3.0" "``ndte``", "integer", "number of EVP subcycles", "120" + "``ortho_type``", "``mgs``", "Use modified Gram-Shchmidt in FGMRES solver", "``mgs``" + "", "``cgs``", "Use classical Gram-Shchmidt in FGMRES solver", "" + "``precond``", "``pgmres``", "Use GMRES as preconditioner for FGMRES solver", "``pgmres``" + "", "``diag``", "Use Jacobi preconditioner for the FGMRES solver", "" + "", "``ident``", "Don't use a preconditioner for the FGMRES solver", "" "``Pstar``", "real", "constant in Hibler strength formula (N/m\ :math:`^2`)", "2.75e4" + "``reltol_nonlin``", "real", "relative tolerance for nonlinear solver", "1e-8" + "``reltol_fgmres``", "real", "relative tolerance for FGMRES solver", "1e-2" + "``reltol_pgmres``", "real", "relative tolerance for PGMRES preconditioner", "1e-6" "``revised_evp``", "logical", "use revised EVP formulation", "``.false.``" "``ssh_stress``", "``coupled``", "computed from coupled sea surface height gradient", "``geostrophic``" "", "``geostropic``", "computed from ocean velocity", ""