New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
icedyn_rhg_evp.F90 in NEMO/branches/2020/dev_r13787_SI3-10_EAP/tests/ICE_RHEO/MY_SRC – NEMO

source: NEMO/branches/2020/dev_r13787_SI3-10_EAP/tests/ICE_RHEO/MY_SRC/icedyn_rhg_evp.F90 @ 13805

Last change on this file since 13805 was 13797, checked in by acc, 4 years ago

Branch: dev_r13787_SI3-10_EAP. Initial port of 2019 developments onto 2020 base. The ICE_RHEO test case compiles and runs but still some tidying and checking to do

File size: 63.3 KB
Line 
1MODULE icedyn_rhg_evp
2   !!======================================================================
3   !!                     ***  MODULE  icedyn_rhg_evp  ***
4   !!   Sea-Ice dynamics : rheology Elasto-Viscous-Plastic
5   !!======================================================================
6   !! History :   -   !  2007-03  (M.A. Morales Maqueda, S. Bouillon) Original code
7   !!            3.0  !  2008-03  (M. Vancoppenolle) adaptation to new model
8   !!             -   !  2008-11  (M. Vancoppenolle, S. Bouillon, Y. Aksenov) add surface tilt in ice rheolohy
9   !!            3.3  !  2009-05  (G.Garric)    addition of the evp case
10   !!            3.4  !  2011-01  (A. Porter)   dynamical allocation
11   !!            3.5  !  2012-08  (R. Benshila) AGRIF
12   !!            3.6  !  2016-06  (C. Rousset)  Rewriting + landfast ice + mEVP (Bouillon 2013)
13   !!            3.7  !  2017     (C. Rousset)  add aEVP (Kimmritz 2016-2017)
14   !!            4.0  !  2018     (many people) SI3 [aka Sea Ice cube]
15   !!----------------------------------------------------------------------
16#if defined key_si3
17   !!----------------------------------------------------------------------
18   !!   'key_si3'                                       SI3 sea-ice model
19   !!----------------------------------------------------------------------
20   !!   ice_dyn_rhg_evp : computes ice velocities from EVP rheology
21   !!   rhg_evp_rst     : read/write EVP fields in ice restart
22   !!----------------------------------------------------------------------
23   USE phycst         ! Physical constant
24   USE dom_oce        ! Ocean domain
25   USE sbc_oce , ONLY : ln_ice_embd, nn_fsbc, ssh_m
26   USE sbc_ice , ONLY : utau_ice, vtau_ice, snwice_mass, snwice_mass_b
27   USE ice            ! sea-ice: ice variables
28   USE icevar         ! ice_var_sshdyn
29   USE icedyn_rdgrft  ! sea-ice: ice strength
30   USE bdy_oce , ONLY : ln_bdy 
31   USE bdyice 
32#if defined key_agrif
33   USE agrif_ice_interp
34#endif
35   !
36   USE in_out_manager ! I/O manager
37   USE iom            ! I/O manager library
38   USE lib_mpp        ! MPP library
39   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
40   USE lbclnk         ! lateral boundary conditions (or mpp links)
41   USE prtctl         ! Print control
42
43   USE netcdf         ! NetCDF library for convergence test
44   IMPLICIT NONE
45   PRIVATE
46
47   PUBLIC   ice_dyn_rhg_evp   ! called by icedyn_rhg.F90
48   PUBLIC   rhg_evp_rst       ! called by icedyn_rhg.F90
49
50   !! * Substitutions
51#  include "do_loop_substitute.h90"
52#  include "domzgr_substitute.h90"
53
54   !! for convergence tests
55   INTEGER ::   ncvgid   ! netcdf file id
56   INTEGER ::   nvarid   ! netcdf variable id
57   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zmsk00, zmsk15
58   !!----------------------------------------------------------------------
59   !! NEMO/ICE 4.0 , NEMO Consortium (2018)
60   !! $Id: icedyn_rhg_evp.F90 13612 2020-10-14 17:18:19Z clem $
61   !! Software governed by the CeCILL license (see ./LICENSE)
62   !!----------------------------------------------------------------------
63CONTAINS
64
65   SUBROUTINE ice_dyn_rhg_evp( kt, Kmm, pstress1_i, pstress2_i, pstress12_i, pshear_i, pdivu_i, pdelta_i )
66      !!-------------------------------------------------------------------
67      !!                 ***  SUBROUTINE ice_dyn_rhg_evp  ***
68      !!                             EVP-C-grid
69      !!
70      !! ** purpose : determines sea ice drift from wind stress, ice-ocean
71      !!  stress and sea-surface slope. Ice-ice interaction is described by
72      !!  a non-linear elasto-viscous-plastic (EVP) law including shear
73      !!  strength and a bulk rheology (Hunke and Dukowicz, 2002).   
74      !!
75      !!  The points in the C-grid look like this, dear reader
76      !!
77      !!                              (ji,jj)
78      !!                                 |
79      !!                                 |
80      !!                      (ji-1,jj)  |  (ji,jj)
81      !!                             ---------   
82      !!                            |         |
83      !!                            | (ji,jj) |------(ji,jj)
84      !!                            |         |
85      !!                             ---------   
86      !!                     (ji-1,jj-1)     (ji,jj-1)
87      !!
88      !! ** Inputs  : - wind forcing (stress), oceanic currents
89      !!                ice total volume (vt_i) per unit area
90      !!                snow total volume (vt_s) per unit area
91      !!
92      !! ** Action  : - compute u_ice, v_ice : the components of the
93      !!                sea-ice velocity vector
94      !!              - compute delta_i, shear_i, divu_i, which are inputs
95      !!                of the ice thickness distribution
96      !!
97      !! ** Steps   : 0) compute mask at F point
98      !!              1) Compute ice snow mass, ice strength
99      !!              2) Compute wind, oceanic stresses, mass terms and
100      !!                 coriolis terms of the momentum equation
101      !!              3) Solve the momentum equation (iterative procedure)
102      !!              4) Recompute delta, shear and divergence
103      !!                 (which are inputs of the ITD) & store stress
104      !!                 for the next time step
105      !!              5) Diagnostics including charge ellipse
106      !!
107      !! ** Notes   : There is the possibility to use aEVP from the nice work of Kimmritz et al. (2016 & 2017)
108      !!              by setting up ln_aEVP=T (i.e. changing alpha and beta parameters).
109      !!              This is an upgraded version of mEVP from Bouillon et al. 2013
110      !!              (i.e. more stable and better convergence)
111      !!
112      !! References : Hunke and Dukowicz, JPO97
113      !!              Bouillon et al., Ocean Modelling 2009
114      !!              Bouillon et al., Ocean Modelling 2013
115      !!              Kimmritz et al., Ocean Modelling 2016 & 2017
116      !!-------------------------------------------------------------------
117      INTEGER                 , INTENT(in   ) ::   kt                                    ! time step
118      INTEGER                 , INTENT(in   ) ::   Kmm                                   ! ocean time level index
119      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pstress1_i, pstress2_i, pstress12_i   !
120      REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pshear_i  , pdivu_i   , pdelta_i      !
121      !!
122      INTEGER ::   ji, jj       ! dummy loop indices
123      INTEGER ::   jter         ! local integers
124      !
125      REAL(wp) ::   zrhoco                                              ! rho0 * rn_cio
126      REAL(wp) ::   zdtevp, z1_dtevp                                    ! time step for subcycling
127      REAL(wp) ::   ecc2, z1_ecc2                                       ! square of yield ellipse eccenticity
128      REAL(wp) ::   zalph1, z1_alph1, zalph2, z1_alph2                  ! alpha coef from Bouillon 2009 or Kimmritz 2017
129      REAl(wp) ::   zbetau, zbetav
130      REAL(wp) ::   zm1, zm2, zm3, zmassU, zmassV, zvU, zvV             ! ice/snow mass and volume
131      REAL(wp) ::   zp_delf, zds2, zdt, zdt2, zdiv, zdiv2               ! temporary scalars
132      REAL(wp) ::   zTauO, zTauB, zRHS, zvel                            ! temporary scalars
133      REAL(wp) ::   zkt                                                 ! isotropic tensile strength for landfast ice
134      REAL(wp) ::   zvCr                                                ! critical ice volume above which ice is landfast
135      !
136      REAL(wp) ::   zintb, zintn                                        ! dummy argument
137      REAL(wp) ::   zfac_x, zfac_y
138      REAL(wp) ::   zshear, zdum1, zdum2
139      REAL(wp) ::   zinvw                                                ! for test case
140
141      !
142      REAL(wp), DIMENSION(jpi,jpj) ::   zdelta, zp_delt                 ! delta and P/delta at T points
143      REAL(wp), DIMENSION(jpi,jpj) ::   zbeta                           ! beta coef from Kimmritz 2017
144      !
145      REAL(wp), DIMENSION(jpi,jpj) ::   zdt_m                           ! (dt / ice-snow_mass) on T points
146      REAL(wp), DIMENSION(jpi,jpj) ::   zaU  , zaV                      ! ice fraction on U/V points
147      REAL(wp), DIMENSION(jpi,jpj) ::   zmU_t, zmV_t                    ! (ice-snow_mass / dt) on U/V points
148      REAL(wp), DIMENSION(jpi,jpj) ::   zmf                             ! coriolis parameter at T points
149      REAL(wp), DIMENSION(jpi,jpj) ::   v_oceU, u_oceV, v_iceU, u_iceV  ! ocean/ice u/v component on V/U points
150      !
151      REAL(wp), DIMENSION(jpi,jpj) ::   zds                             ! shear
152      REAL(wp), DIMENSION(jpi,jpj) ::   zten_i                          ! tension
153      REAL(wp), DIMENSION(jpi,jpj) ::   zs1, zs2, zs12                  ! stress tensor components
154      REAL(wp), DIMENSION(jpi,jpj) ::   zsshdyn                         ! array used for the calculation of ice surface slope:
155      !                                                                 !    ocean surface (ssh_m) if ice is not embedded
156      !                                                                 !    ice bottom surface if ice is embedded   
157      REAL(wp), DIMENSION(jpi,jpj) ::   zfU  , zfV                      ! internal stresses
158      REAL(wp), DIMENSION(jpi,jpj) ::   zspgU, zspgV                    ! surface pressure gradient at U/V points
159      REAL(wp), DIMENSION(jpi,jpj) ::   zCorU, zCorV                    ! Coriolis stress array
160      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_ai, ztauy_ai              ! ice-atm. stress at U-V points
161      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_oi, ztauy_oi              ! ice-ocean stress at U-V points
162      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_bi, ztauy_bi              ! ice-OceanBottom stress at U-V points (landfast)
163      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_base, ztauy_base          ! ice-bottom stress at U-V points (landfast)
164      !
165      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk01x, zmsk01y                ! dummy arrays
166      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00x, zmsk00y                ! mask for ice presence
167      REAL(wp), DIMENSION(jpi,jpj) ::   zfmask                          ! mask at F points for the ice
168
169      REAL(wp), PARAMETER          ::   zepsi  = 1.0e-20_wp             ! tolerance parameter
170      REAL(wp), PARAMETER          ::   zmmin  = 1._wp                  ! ice mass (kg/m2)  below which ice velocity becomes very small
171      REAL(wp), PARAMETER          ::   zamin  = 0.001_wp               ! ice concentration below which ice velocity becomes very small
172      !! --- check convergence
173      REAL(wp), DIMENSION(jpi,jpj) ::   zu_ice, zv_ice
174      !! --- diags
175      REAL(wp) ::   zsig1, zsig2, zsig12, zfac, z1_strength
176      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zsig_I, zsig_II, zsig1_p, zsig2_p         
177      !! --- SIMIP diags
178      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_xmtrp_ice ! X-component of ice mass transport (kg/s)
179      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_ymtrp_ice ! Y-component of ice mass transport (kg/s)
180      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_xmtrp_snw ! X-component of snow mass transport (kg/s)
181      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_ymtrp_snw ! Y-component of snow mass transport (kg/s)
182      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_xatrp     ! X-component of area transport (m2/s)
183      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_yatrp     ! Y-component of area transport (m2/s)     
184      !!-------------------------------------------------------------------
185
186      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_dyn_rhg_evp: EVP sea-ice rheology'
187      !
188      ! for diagnostics and convergence tests
189      ALLOCATE( zmsk00(jpi,jpj), zmsk15(jpi,jpj) )
190      DO_2D( 1, 1, 1, 1 )
191         zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice
192         zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less
193      END_2D
194      !
195      !!gm for Clem:  OPTIMIZATION:  I think zfmask can be computed one for all at the initialization....
196      !------------------------------------------------------------------------------!
197      ! 0) mask at F points for the ice
198      !------------------------------------------------------------------------------!
199      ! ocean/land mask
200      DO_2D( 1, 0, 1, 0 )
201         zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1)
202      END_2D
203      CALL lbc_lnk( 'icedyn_rhg_evp', zfmask, 'F', 1._wp )
204
205      ! Lateral boundary conditions on velocity (modify zfmask)
206      DO_2D( 0, 0, 0, 0 )
207         IF( zfmask(ji,jj) == 0._wp ) THEN
208            zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), &
209               &                                          vmask(ji,jj,1), vmask(ji+1,jj,1) ) )
210         ENDIF
211      END_2D
212      DO jj = 2, jpjm1
213         IF( zfmask(1,jj) == 0._wp ) THEN
214            zfmask(1  ,jj) = rn_ishlat * MIN( 1._wp , MAX( vmask(2,jj,1), umask(1,jj+1,1), umask(1,jj,1) ) )
215         ENDIF
216         IF( zfmask(jpi,jj) == 0._wp ) THEN
217            zfmask(jpi,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(jpi,jj+1,1), vmask(jpim1,jj,1), umask(jpi,jj-1,1) ) )
218        ENDIF
219      END DO
220      DO ji = 2, jpim1
221         IF( zfmask(ji,1) == 0._wp ) THEN
222            zfmask(ji, 1 ) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,1,1), umask(ji,2,1), vmask(ji,1,1) ) )
223         ENDIF
224         IF( zfmask(ji,jpj) == 0._wp ) THEN
225            zfmask(ji,jpj) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,1), vmask(ji-1,jpj,1), umask(ji,jpjm1,1) ) )
226         ENDIF
227      END DO
228      CALL lbc_lnk( 'icedyn_rhg_evp', zfmask, 'F', 1._wp )
229
230      !------------------------------------------------------------------------------!
231      ! 1) define some variables and initialize arrays
232      !------------------------------------------------------------------------------!
233      zrhoco = rho0 * rn_cio 
234!extra code for test case boundary conditions
235      zinvw=1._wp/(zrhoco*0.5_wp)
236
237      ! ecc2: square of yield ellipse eccenticrity
238      ecc2    = rn_ecc * rn_ecc
239      z1_ecc2 = 1._wp / ecc2
240
241      ! alpha parameters (Bouillon 2009)
242      IF( .NOT. ln_aEVP ) THEN
243         zdtevp   = rDt_ice / REAL( nn_nevp )
244         zalph1 =   2._wp * rn_relast * REAL( nn_nevp )
245         zalph2 = zalph1 * z1_ecc2
246
247         z1_alph1 = 1._wp / ( zalph1 + 1._wp )
248         z1_alph2 = 1._wp / ( zalph2 + 1._wp )
249      ELSE
250         zdtevp   = rdt_ice
251         ! zalpha parameters set later on adaptatively
252      ENDIF
253      z1_dtevp = 1._wp / zdtevp
254         
255      ! Initialise stress tensor
256      zs1 (:,:) = pstress1_i (:,:) 
257      zs2 (:,:) = pstress2_i (:,:)
258      zs12(:,:) = pstress12_i(:,:)
259
260      ! Ice strength
261      CALL ice_strength
262
263      ! landfast param from Lemieux(2016): add isotropic tensile strength (following Konig Beatty and Holland, 2010)
264      IF( ln_landfast_L16 ) THEN   ;   zkt = rn_lf_tensile
265      ELSE                         ;   zkt = 0._wp
266      ENDIF
267      !
268      !------------------------------------------------------------------------------!
269      ! 2) Wind / ocean stress, mass terms, coriolis terms
270      !------------------------------------------------------------------------------!
271      ! sea surface height
272      !    embedded sea ice: compute representative ice top surface
273      !    non-embedded sea ice: use ocean surface for slope calculation
274      zsshdyn(:,:) = ice_var_sshdyn( ssh_m, snwice_mass, snwice_mass_b)
275
276      DO_2D( 0, 0, 0, 0 )
277
278         ! ice fraction at U-V points
279         zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
280         zaV(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
281
282         ! Ice/snow mass at U-V points
283         zm1 = ( rhos * vt_s(ji  ,jj  ) + rhoi * vt_i(ji  ,jj  ) )
284         zm2 = ( rhos * vt_s(ji+1,jj  ) + rhoi * vt_i(ji+1,jj  ) )
285         zm3 = ( rhos * vt_s(ji  ,jj+1) + rhoi * vt_i(ji  ,jj+1) )
286         zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
287         zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
288
289         ! Ocean currents at U-V points
290         v_oceU(ji,jj)   = 0.25_wp * ( v_oce(ji,jj) + v_oce(ji,jj-1) + v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * umask(ji,jj,1)
291         u_oceV(ji,jj)   = 0.25_wp * ( u_oce(ji,jj) + u_oce(ji-1,jj) + u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * vmask(ji,jj,1)
292
293         ! Coriolis at T points (m*f)
294         zmf(ji,jj)      = zm1 * ff_t(ji,jj)
295
296         ! dt/m at T points (for alpha and beta coefficients)
297         zdt_m(ji,jj)    = zdtevp / MAX( zm1, zmmin )
298         
299         ! m/dt
300         zmU_t(ji,jj)    = zmassU * z1_dtevp
301         zmV_t(ji,jj)    = zmassV * z1_dtevp
302         
303         ! Drag ice-atm.
304         ztaux_ai(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj)
305         ztauy_ai(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj)
306
307         ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points
308         zspgU(ji,jj)    = - zmassU * grav * ( zsshdyn(ji+1,jj) - zsshdyn(ji,jj) ) * r1_e1u(ji,jj)
309         zspgV(ji,jj)    = - zmassV * grav * ( zsshdyn(ji,jj+1) - zsshdyn(ji,jj) ) * r1_e2v(ji,jj)
310
311         ! masks
312         zmsk00x(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) )  ! 0 if no ice
313         zmsk00y(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) )  ! 0 if no ice
314
315         ! switches
316         IF( zmassU <= zmmin .AND. zaU(ji,jj) <= zamin ) THEN   ;   zmsk01x(ji,jj) = 0._wp
317         ELSE                                                   ;   zmsk01x(ji,jj) = 1._wp   ;   ENDIF
318         IF( zmassV <= zmmin .AND. zaV(ji,jj) <= zamin ) THEN   ;   zmsk01y(ji,jj) = 0._wp
319         ELSE                                                   ;   zmsk01y(ji,jj) = 1._wp   ;   ENDIF
320
321      END_2D
322      CALL lbc_lnk_multi( 'icedyn_rhg_evp', zmf, 'T', 1.0_wp, zdt_m, 'T', 1.0_wp )
323      !
324      !                                  !== Landfast ice parameterization ==!
325      !
326      IF( ln_landfast_L16 ) THEN         !-- Lemieux 2016
327         DO_2D( 0, 0, 0, 0 )
328            ! ice thickness at U-V points
329            zvU = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
330            zvV = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
331            ! ice-bottom stress at U points
332            zvCr = zaU(ji,jj) * rn_lf_depfra * hu(ji,jj,Kmm)
333            ztaux_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) )
334            ! ice-bottom stress at V points
335            zvCr = zaV(ji,jj) * rn_lf_depfra * hv(ji,jj,Kmm)
336            ztauy_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) )
337            ! ice_bottom stress at T points
338            zvCr = at_i(ji,jj) * rn_lf_depfra * ht(ji,jj)
339            tau_icebfr(ji,jj) = - rn_lf_bfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) )
340         END_2D
341         CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1.0_wp )
342         !
343      ELSE                               !-- no landfast
344         DO_2D( 0, 0, 0, 0 )
345            ztaux_base(ji,jj) = 0._wp
346            ztauy_base(ji,jj) = 0._wp
347         END_2D
348      ENDIF
349
350      !------------------------------------------------------------------------------!
351      ! 3) Solution of the momentum equation, iterative procedure
352      !------------------------------------------------------------------------------!
353      !
354      !                                               ! ==================== !
355      DO jter = 1 , nn_nevp                           !    loop over jter    !
356         !                                            ! ==================== !       
357         l_full_nf_update = jter == nn_nevp   ! false: disable full North fold update (performances) for iter = 1 to nn_nevp-1
358         !
359         ! convergence test
360         IF( nn_rhg_chkcvg == 1 .OR. nn_rhg_chkcvg == 2  ) THEN
361            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
362               zu_ice(ji,jj) = u_ice(ji,jj) * umask(ji,jj,1) ! velocity at previous time step
363               zv_ice(ji,jj) = v_ice(ji,jj) * vmask(ji,jj,1)
364            END_2D
365         ENDIF
366
367         ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- !
368         DO_2D( 1, 0, 1, 0 )
369
370            ! shear at F points
371            zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   &
372               &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   &
373               &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)
374
375         END_2D
376
377         DO_2D( 0, 0, 0, 0 )
378
379            ! shear**2 at T points (doc eq. A16)
380            zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  &
381               &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  &
382               &   ) * 0.25_wp * r1_e1e2t(ji,jj)
383           
384            ! divergence at T points
385            zdiv  = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
386               &    + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
387               &    ) * r1_e1e2t(ji,jj)
388            zdiv2 = zdiv * zdiv
389           
390            ! tension at T points
391            zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
392               &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
393               &   ) * r1_e1e2t(ji,jj)
394            zdt2 = zdt * zdt
395           
396            ! delta at T points
397            zdelta(ji,jj) = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 ) 
398
399         END_2D
400         CALL lbc_lnk( 'icedyn_rhg_evp', zdelta, 'T', 1.0_wp )
401
402         ! P/delta at T points
403         DO_2D( 1, 1, 1, 1 )
404            zp_delt(ji,jj) = strength(ji,jj) / ( zdelta(ji,jj) + rn_creepl )
405         END_2D
406
407         DO_2D( 0, 1, 0, 1 )   ! loop ends at jpi,jpj so that no lbc_lnk are needed for zs1 and zs2
408
409            ! divergence at T points (duplication to avoid communications)
410            zdiv  = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
411               &    + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
412               &    ) * r1_e1e2t(ji,jj)
413           
414            ! tension at T points (duplication to avoid communications)
415            zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
416               &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
417               &   ) * r1_e1e2t(ji,jj)
418           
419            ! alpha for aEVP
420            !   gamma = 0.5*P/(delta+creepl) * (c*pi)**2/Area * dt/m
421            !   alpha = beta = sqrt(4*gamma)
422            IF( ln_aEVP ) THEN
423               zalph1   = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) )
424               z1_alph1 = 1._wp / ( zalph1 + 1._wp )
425               zalph2   = zalph1
426               z1_alph2 = z1_alph1
427               ! explicit:
428               ! z1_alph1 = 1._wp / zalph1
429               ! z1_alph2 = 1._wp / zalph1
430               ! zalph1 = zalph1 - 1._wp
431               ! zalph2 = zalph1
432            ENDIF
433           
434            ! stress at T points (zkt/=0 if landfast)
435            zs1(ji,jj) = ( zs1(ji,jj)*zalph1 + zp_delt(ji,jj) * ( zdiv*(1._wp + zkt) - zdelta(ji,jj)*(1._wp - zkt) ) ) * z1_alph1
436            zs2(ji,jj) = ( zs2(ji,jj)*zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2
437         
438         END_2D
439
440         ! Save beta at T-points for further computations
441         IF( ln_aEVP ) THEN
442            DO_2D( 1, 1, 1, 1 )
443               zbeta(ji,jj) = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) )
444            END_2D
445         ENDIF
446         
447         DO_2D( 1, 0, 1, 0 )
448
449            ! alpha for aEVP
450            IF( ln_aEVP ) THEN
451               zalph2   = MAX( zbeta(ji,jj), zbeta(ji+1,jj), zbeta(ji,jj+1), zbeta(ji+1,jj+1) )
452               z1_alph2 = 1._wp / ( zalph2 + 1._wp )
453               ! explicit:
454               ! z1_alph2 = 1._wp / zalph2
455               ! zalph2 = zalph2 - 1._wp
456            ENDIF
457           
458            ! P/delta at F points
459            zp_delf = 0.25_wp * ( zp_delt(ji,jj) + zp_delt(ji+1,jj) + zp_delt(ji,jj+1) + zp_delt(ji+1,jj+1) )
460           
461            ! stress at F points (zkt/=0 if landfast)
462            zs12(ji,jj)= ( zs12(ji,jj) * zalph2 + zp_delf * ( zds(ji,jj) * z1_ecc2 * (1._wp + zkt) ) * 0.5_wp ) * z1_alph2
463
464         END_2D
465
466         ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- !
467         DO_2D( 0, 0, 0, 0 )
468            !                   !--- U points
469            zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj)                                             &
470               &                  + ( zs2(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) - zs2(ji,jj) * e2t(ji,jj) * e2t(ji,jj)    &
471               &                    ) * r1_e2u(ji,jj)                                                                      &
472               &                  + ( zs12(ji,jj) * e1f(ji,jj) * e1f(ji,jj) - zs12(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1)  &
473               &                    ) * 2._wp * r1_e1u(ji,jj)                                                              &
474               &                  ) * r1_e1e2u(ji,jj)
475            !
476            !                !--- V points
477            zfV(ji,jj) = 0.5_wp * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj)                                             &
478               &                  - ( zs2(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) - zs2(ji,jj) * e1t(ji,jj) * e1t(ji,jj)    &
479               &                    ) * r1_e1v(ji,jj)                                                                      &
480               &                  + ( zs12(ji,jj) * e2f(ji,jj) * e2f(ji,jj) - zs12(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj)  &
481               &                    ) * 2._wp * r1_e2v(ji,jj)                                                              &
482               &                  ) * r1_e1e2v(ji,jj)
483            !
484            !                !--- ice currents at U-V point
485            v_iceU(ji,jj) = 0.25_wp * ( v_ice(ji,jj) + v_ice(ji,jj-1) + v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * umask(ji,jj,1)
486            u_iceV(ji,jj) = 0.25_wp * ( u_ice(ji,jj) + u_ice(ji-1,jj) + u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * vmask(ji,jj,1)
487            !
488         END_2D
489         !
490         ! --- Computation of ice velocity --- !
491         !  Bouillon et al. 2013 (eq 47-48) => unstable unless alpha, beta vary as in Kimmritz 2016 & 2017
492         !  Bouillon et al. 2009 (eq 34-35) => stable
493         IF( MOD(jter,2) == 0 ) THEN ! even iterations
494            !
495            DO_2D( 0, 0, 0, 0 )
496               !                 !--- tau_io/(v_oce - v_ice)
497               zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  &
498                  &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) )
499               !                 !--- Ocean-to-Ice stress
500               ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) )
501               !
502               !                 !--- tau_bottom/v_ice
503               zvel  = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) )
504               zTauB = ztauy_base(ji,jj) / zvel
505               !                 !--- OceanBottom-to-Ice stress
506               ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj)
507               !
508               !                 !--- Coriolis at V-points (energy conserving formulation)
509               zCorV(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  &
510                  &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  &
511                  &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) )
512               !
513               !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
514               zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj)
515               !
516               !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
517               !                                         1 = sliding friction : TauB < RHS
518               rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
519               !
520               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
521                  zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) )
522                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity
523                     &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
524                     &                                    ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
525                     &            + ( 1._wp - rswitch ) * (  v_ice_b(ji,jj)                                                   & 
526                     &                                     + v_ice  (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0
527                     &                                    ) / ( zbetav + 1._wp )                                              &
528                     &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
529                     &           )   * zmsk00y(ji,jj)
530               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
531                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                                       & ! previous velocity
532                     &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
533                     &                                    ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast
534                     &            + ( 1._wp - rswitch ) *   v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0
535                     &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
536                     &            )  * zmsk00y(ji,jj)
537               ENDIF
538!extra code for test case boundary conditions
539               IF (mjg(jj)<25 .or. mjg(jj)>975 .or. mig(ji)<25 .or. mig(ji)>975) THEN
540                  v_ice(ji,jj) = zinvw*(ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj))
541               END IF
542            END_2D
543            CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp )
544            !
545#if defined key_agrif
546!!            CALL agrif_interp_ice( 'V', jter, nn_nevp )
547            CALL agrif_interp_ice( 'V' )
548#endif
549            IF( ln_bdy )   CALL bdy_ice_dyn( 'V' )
550            !
551            DO_2D( 0, 0, 0, 0 )
552               !                 !--- tau_io/(u_oce - u_ice)
553               zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  &
554                  &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) )
555               !                 !--- Ocean-to-Ice stress
556               ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) )
557               !
558               !                 !--- tau_bottom/u_ice
559               zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) )
560               zTauB = ztaux_base(ji,jj) / zvel
561               !                 !--- OceanBottom-to-Ice stress
562               ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj)
563               !
564               !                 !--- Coriolis at U-points (energy conserving formulation)
565               zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  &
566                  &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  &
567                  &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) )
568               !
569               !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
570               zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj)
571               !
572               !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
573               !                                         1 = sliding friction : TauB < RHS
574               rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
575               !
576               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
577                  zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) )
578                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity
579                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
580                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
581                     &            + ( 1._wp - rswitch ) * (  u_ice_b(ji,jj)                                                   &
582                     &                                     + u_ice  (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0
583                     &                                    ) / ( zbetau + 1._wp )                                              &
584                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
585                     &           )   * zmsk00x(ji,jj)
586               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
587                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity
588                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
589                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast
590                     &            + ( 1._wp - rswitch ) *   u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0
591                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
592                     &           )   * zmsk00x(ji,jj)
593               ENDIF
594!extra code for test case boundary conditions
595               IF (mjg(jj)<25 .or. mjg(jj)>975 .or. mig(ji)<25 .or. mig(ji)>975) THEN
596                  u_ice(ji,jj) = zinvw*(ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj))
597               END IF
598            END_2D
599            CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp )
600            !
601#if defined key_agrif
602!!            CALL agrif_interp_ice( 'U', jter, nn_nevp )
603            CALL agrif_interp_ice( 'U' )
604#endif
605            IF( ln_bdy )   CALL bdy_ice_dyn( 'U' )
606            !
607         ELSE ! odd iterations
608            !
609            DO_2D( 0, 0, 0, 0 )
610               !                 !--- tau_io/(u_oce - u_ice)
611               zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  &
612                  &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) )
613               !                 !--- Ocean-to-Ice stress
614               ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) )
615               !
616               !                 !--- tau_bottom/u_ice
617               zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) )
618               zTauB = ztaux_base(ji,jj) / zvel
619               !                 !--- OceanBottom-to-Ice stress
620               ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj)
621               !
622               !                 !--- Coriolis at U-points (energy conserving formulation)
623               zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  &
624                  &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  &
625                  &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) )
626               !
627               !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
628               zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj)
629               !
630               !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
631               !                                         1 = sliding friction : TauB < RHS
632               rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
633               !
634               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
635                  zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) )
636                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity
637                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
638                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
639                     &            + ( 1._wp - rswitch ) * (  u_ice_b(ji,jj)                                                   &
640                     &                                     + u_ice  (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0
641                     &                                    ) / ( zbetau + 1._wp )                                              &
642                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
643                     &           )   * zmsk00x(ji,jj)
644               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
645                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity
646                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
647                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast
648                     &            + ( 1._wp - rswitch ) *   u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0
649                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
650                     &           )   * zmsk00x(ji,jj)
651               ENDIF
652!extra code for test case boundary conditions
653               IF (mjg(jj)<25 .or. mjg(jj)>975 .or. mig(ji)<25 .or. mig(ji)>975) THEN
654                  u_ice(ji,jj) = zinvw*(ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj))
655               END IF
656            END_2D
657            CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp )
658            !
659#if defined key_agrif
660!!            CALL agrif_interp_ice( 'U', jter, nn_nevp )
661            CALL agrif_interp_ice( 'U' )
662#endif
663            IF( ln_bdy )   CALL bdy_ice_dyn( 'U' )
664            !
665            DO_2D( 0, 0, 0, 0 )
666               !                 !--- tau_io/(v_oce - v_ice)
667               zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  &
668                  &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) )
669               !                 !--- Ocean-to-Ice stress
670               ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) )
671               !
672               !                 !--- tau_bottom/v_ice
673               zvel  = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) )
674               zTauB = ztauy_base(ji,jj) / zvel
675               !                 !--- OceanBottom-to-Ice stress
676               ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj)
677               !
678               !                 !--- Coriolis at v-points (energy conserving formulation)
679               zCorV(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  &
680                  &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  &
681                  &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) )
682               !
683               !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
684               zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj)
685               !
686               !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
687               !                                         1 = sliding friction : TauB < RHS
688               rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
689               !
690               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
691                  zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) )
692                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity
693                     &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
694                     &                                    ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
695                     &            + ( 1._wp - rswitch ) * (  v_ice_b(ji,jj)                                                   &
696                     &                                     + v_ice  (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0
697                     &                                    ) / ( zbetav + 1._wp )                                              & 
698                     &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
699                     &           )   * zmsk00y(ji,jj)
700               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
701                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                                       & ! previous velocity
702                     &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
703                     &                                    ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast
704                     &            + ( 1._wp - rswitch ) *   v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0
705                     &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
706                     &           )   * zmsk00y(ji,jj)
707               ENDIF
708!extra code for test case boundary conditions
709               IF (mjg(jj)<25 .or. mjg(jj)>975 .or. mig(ji)<25 .or. mig(ji)>975) THEN
710                  v_ice(ji,jj) = zinvw*(ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj))
711               END IF
712            END_2D
713            CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp )
714            !
715#if defined key_agrif
716!!            CALL agrif_interp_ice( 'V', jter, nn_nevp )
717            CALL agrif_interp_ice( 'V' )
718#endif
719            IF( ln_bdy )   CALL bdy_ice_dyn( 'V' )
720            !
721         ENDIF
722
723         ! convergence test
724         IF( nn_rhg_chkcvg == 2 )   CALL rhg_cvg( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice )
725         !
726         !                                                ! ==================== !
727      END DO                                              !  end loop over jter  !
728      !                                                   ! ==================== !
729      IF( ln_aEVP )   CALL iom_put( 'beta_evp' , zbeta )
730      !
731      !------------------------------------------------------------------------------!
732      ! 4) Recompute delta, shear and div (inputs for mechanical redistribution)
733      !------------------------------------------------------------------------------!
734      DO_2D( 1, 0, 1, 0 )
735
736         ! shear at F points
737         zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   &
738            &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   &
739            &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)
740
741      END_2D
742     
743      DO_2D( 0, 0, 0, 0 )   ! no vector loop
744         
745         ! tension**2 at T points
746         zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
747            &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
748            &   ) * r1_e1e2t(ji,jj)
749         zdt2 = zdt * zdt
750
751         zten_i(ji,jj) = zdt
752         
753         ! shear**2 at T points (doc eq. A16)
754         zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  &
755            &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  &
756            &   ) * 0.25_wp * r1_e1e2t(ji,jj)
757         
758         ! shear at T points
759         pshear_i(ji,jj) = SQRT( zdt2 + zds2 )
760
761         ! divergence at T points
762         pdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
763            &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
764            &             ) * r1_e1e2t(ji,jj)
765         
766         ! delta at T points
767         zfac            = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 ) ! delta 
768         rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zfac ) ) ! 0 if delta=0
769         pdelta_i(ji,jj) = zfac + rn_creepl * rswitch ! delta+creepl
770
771      END_2D
772      CALL lbc_lnk_multi( 'icedyn_rhg_evp', pshear_i, 'T', 1._wp, pdivu_i, 'T', 1._wp, pdelta_i, 'T', 1._wp, zten_i, 'T', 1._wp, &
773         &                                  zs1     , 'T', 1._wp, zs2    , 'T', 1._wp, zs12    , 'F', 1._wp )
774     
775      ! --- Store the stress tensor for the next time step --- !
776      pstress1_i (:,:) = zs1 (:,:)
777      pstress2_i (:,:) = zs2 (:,:)
778      pstress12_i(:,:) = zs12(:,:)
779      !
780
781      !------------------------------------------------------------------------------!
782      ! 5) diagnostics
783      !------------------------------------------------------------------------------!
784      ! --- ice-ocean, ice-atm. & ice-oceanbottom(landfast) stresses --- !
785      IF(  iom_use('utau_oi') .OR. iom_use('vtau_oi') .OR. iom_use('utau_ai') .OR. iom_use('vtau_ai') .OR. &
786         & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN
787         !
788         CALL lbc_lnk_multi( 'icedyn_rhg_evp', ztaux_oi, 'U', -1.0_wp, ztauy_oi, 'V', -1.0_wp, ztaux_ai, 'U', -1.0_wp, ztauy_ai, 'V', -1.0_wp, &
789            &                                  ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp )
790         !
791         CALL iom_put( 'utau_oi' , ztaux_oi * zmsk00 )
792         CALL iom_put( 'vtau_oi' , ztauy_oi * zmsk00 )
793         CALL iom_put( 'utau_ai' , ztaux_ai * zmsk00 )
794         CALL iom_put( 'vtau_ai' , ztauy_ai * zmsk00 )
795         CALL iom_put( 'utau_bi' , ztaux_bi * zmsk00 )
796         CALL iom_put( 'vtau_bi' , ztauy_bi * zmsk00 )
797      ENDIF
798       
799      ! --- divergence, shear and strength --- !
800      IF( iom_use('icediv') )   CALL iom_put( 'icediv' , pdivu_i  * zmsk00 )   ! divergence
801      IF( iom_use('iceshe') )   CALL iom_put( 'iceshe' , pshear_i * zmsk00 )   ! shear
802      IF( iom_use('icestr') )   CALL iom_put( 'icestr' , strength * zmsk00 )   ! strength
803
804      ! --- Stress tensor invariants (SIMIP diags) --- !
805      IF( iom_use('normstr') .OR. iom_use('sheastr') ) THEN
806         !
807         ALLOCATE( zsig_I(jpi,jpj) , zsig_II(jpi,jpj) )
808         !         
809         DO_2D( 1, 1, 1, 1 )
810           
811            ! Ice stresses
812            ! sigma1, sigma2, sigma12 are some useful recombination of the stresses (Hunke and Dukowicz MWR 2002, Bouillon et al., OM2013)
813            ! These are NOT stress tensor components, neither stress invariants, neither stress principal components
814            ! I know, this can be confusing...
815            zfac             =   strength(ji,jj) / ( pdelta_i(ji,jj) + rn_creepl ) 
816            zsig1            =   zfac * ( pdivu_i(ji,jj) - pdelta_i(ji,jj) )
817            zsig2            =   zfac * z1_ecc2 * zten_i(ji,jj)
818            zsig12           =   zfac * z1_ecc2 * pshear_i(ji,jj)
819           
820            ! Stress invariants (sigma_I, sigma_II, Coon 1974, Feltham 2008)
821            zsig_I (ji,jj)   =   zsig1 * 0.5_wp                                           ! 1st stress invariant, aka average normal stress, aka negative pressure
822            zsig_II(ji,jj)   =   SQRT ( MAX( 0._wp, zsig2 * zsig2 * 0.25_wp + zsig12 ) )  ! 2nd  ''       '', aka maximum shear stress
823               
824         END_2D         
825         !
826         ! Stress tensor invariants (normal and shear stress N/m) - SIMIP diags - definitions following Coon (1974) and Feltham (2008)
827         IF( iom_use('normstr') )   CALL iom_put( 'normstr', zsig_I (:,:) * zmsk00(:,:) ) ! Normal stress
828         IF( iom_use('sheastr') )   CALL iom_put( 'sheastr', zsig_II(:,:) * zmsk00(:,:) ) ! Maximum shear stress
829         
830         DEALLOCATE ( zsig_I, zsig_II )
831         
832      ENDIF
833
834      ! --- Normalized stress tensor principal components --- !
835      ! This are used to plot the normalized yield curve, see Lemieux & Dupont, 2020
836      ! Recommendation 1 : we use ice strength, not replacement pressure
837      ! Recommendation 2 : need to use deformations at PREVIOUS iterate for viscosities
838      IF( iom_use('sig1_pnorm') .OR. iom_use('sig2_pnorm') ) THEN
839         !
840         ALLOCATE( zsig1_p(jpi,jpj) , zsig2_p(jpi,jpj) , zsig_I(jpi,jpj) , zsig_II(jpi,jpj) )         
841         !         
842         DO_2D( 1, 1, 1, 1 )
843           
844            ! Ice stresses computed with **viscosities** (delta, p/delta) at **previous** iterates
845            !                        and **deformations** at current iterates
846            !                        following Lemieux & Dupont (2020)
847            zfac             =   zp_delt(ji,jj)
848            zsig1            =   zfac * ( pdivu_i(ji,jj) - ( zdelta(ji,jj) + rn_creepl ) )
849            zsig2            =   zfac * z1_ecc2 * zten_i(ji,jj)
850            zsig12           =   zfac * z1_ecc2 * pshear_i(ji,jj)
851           
852            ! Stress invariants (sigma_I, sigma_II, Coon 1974, Feltham 2008), T-point
853            zsig_I(ji,jj)    =   zsig1 * 0.5_wp                                            ! 1st stress invariant, aka average normal stress, aka negative pressure
854            zsig_II(ji,jj)   =   SQRT ( MAX( 0._wp, zsig2 * zsig2 * 0.25_wp + zsig12 ) )   ! 2nd  ''       '', aka maximum shear stress
855           
856            ! Normalized  principal stresses (used to display the ellipse)
857            z1_strength      =   1._wp / MAX( 1._wp, strength(ji,jj) )
858            zsig1_p(ji,jj)   =   ( zsig_I(ji,jj) + zsig_II(ji,jj) ) * z1_strength
859            zsig2_p(ji,jj)   =   ( zsig_I(ji,jj) - zsig_II(ji,jj) ) * z1_strength
860         END_2D             
861         !
862         CALL iom_put( 'sig1_pnorm' , zsig1_p ) 
863         CALL iom_put( 'sig2_pnorm' , zsig2_p ) 
864
865         DEALLOCATE( zsig1_p , zsig2_p , zsig_I, zsig_II )
866         
867      ENDIF
868
869      ! --- SIMIP --- !
870      IF(  iom_use('dssh_dx') .OR. iom_use('dssh_dy') .OR. &
871         & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN
872         !
873         CALL lbc_lnk_multi( 'icedyn_rhg_evp', zspgU, 'U', -1.0_wp, zspgV, 'V', -1.0_wp, &
874            &                                  zCorU, 'U', -1.0_wp, zCorV, 'V', -1.0_wp, zfU, 'U', -1.0_wp, zfV, 'V', -1.0_wp )
875
876         CALL iom_put( 'dssh_dx' , zspgU * zmsk00 )   ! Sea-surface tilt term in force balance (x)
877         CALL iom_put( 'dssh_dy' , zspgV * zmsk00 )   ! Sea-surface tilt term in force balance (y)
878         CALL iom_put( 'corstrx' , zCorU * zmsk00 )   ! Coriolis force term in force balance (x)
879         CALL iom_put( 'corstry' , zCorV * zmsk00 )   ! Coriolis force term in force balance (y)
880         CALL iom_put( 'intstrx' , zfU   * zmsk00 )   ! Internal force term in force balance (x)
881         CALL iom_put( 'intstry' , zfV   * zmsk00 )   ! Internal force term in force balance (y)
882      ENDIF
883
884      IF(  iom_use('xmtrpice') .OR. iom_use('ymtrpice') .OR. &
885         & iom_use('xmtrpsnw') .OR. iom_use('ymtrpsnw') .OR. iom_use('xatrp') .OR. iom_use('yatrp') ) THEN
886         !
887         ALLOCATE( zdiag_xmtrp_ice(jpi,jpj) , zdiag_ymtrp_ice(jpi,jpj) , &
888            &      zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp(jpi,jpj) , zdiag_yatrp(jpi,jpj) )
889         !
890         DO_2D( 0, 0, 0, 0 )
891            ! 2D ice mass, snow mass, area transport arrays (X, Y)
892            zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj)
893            zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj)
894
895            zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component
896            zdiag_ymtrp_ice(ji,jj) = rhoi * zfac_y * ( vt_i(ji,jj+1) + vt_i(ji,jj) ) !        ''           Y-   ''
897
898            zdiag_xmtrp_snw(ji,jj) = rhos * zfac_x * ( vt_s(ji+1,jj) + vt_s(ji,jj) ) ! snow mass transport, X-component
899            zdiag_ymtrp_snw(ji,jj) = rhos * zfac_y * ( vt_s(ji,jj+1) + vt_s(ji,jj) ) !          ''          Y-   ''
900
901            zdiag_xatrp(ji,jj)     = zfac_x * ( at_i(ji+1,jj) + at_i(ji,jj) )        ! area transport,      X-component
902            zdiag_yatrp(ji,jj)     = zfac_y * ( at_i(ji,jj+1) + at_i(ji,jj) )        !        ''            Y-   ''
903
904         END_2D
905
906         CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1.0_wp, zdiag_ymtrp_ice, 'V', -1.0_wp, &
907            &                                  zdiag_xmtrp_snw, 'U', -1.0_wp, zdiag_ymtrp_snw, 'V', -1.0_wp, &
908            &                                  zdiag_xatrp    , 'U', -1.0_wp, zdiag_yatrp    , 'V', -1.0_wp )
909
910         CALL iom_put( 'xmtrpice' , zdiag_xmtrp_ice )   ! X-component of sea-ice mass transport (kg/s)
911         CALL iom_put( 'ymtrpice' , zdiag_ymtrp_ice )   ! Y-component of sea-ice mass transport
912         CALL iom_put( 'xmtrpsnw' , zdiag_xmtrp_snw )   ! X-component of snow mass transport (kg/s)
913         CALL iom_put( 'ymtrpsnw' , zdiag_ymtrp_snw )   ! Y-component of snow mass transport
914         CALL iom_put( 'xatrp'    , zdiag_xatrp     )   ! X-component of ice area transport
915         CALL iom_put( 'yatrp'    , zdiag_yatrp     )   ! Y-component of ice area transport
916
917         DEALLOCATE( zdiag_xmtrp_ice , zdiag_ymtrp_ice , &
918            &        zdiag_xmtrp_snw , zdiag_ymtrp_snw , zdiag_xatrp , zdiag_yatrp )
919
920      ENDIF
921      !
922      ! --- convergence tests --- !
923      IF( nn_rhg_chkcvg == 1 .OR. nn_rhg_chkcvg == 2 ) THEN
924         IF( iom_use('uice_cvg') ) THEN
925            IF( ln_aEVP ) THEN   ! output: beta * ( u(t=nn_nevp) - u(t=nn_nevp-1) )
926               CALL iom_put( 'uice_cvg', MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * zbeta(:,:) * umask(:,:,1) , &
927                  &                           ABS( v_ice(:,:) - zv_ice(:,:) ) * zbeta(:,:) * vmask(:,:,1) ) * zmsk15(:,:) )
928            ELSE                 ! output: nn_nevp * ( u(t=nn_nevp) - u(t=nn_nevp-1) )
929               CALL iom_put( 'uice_cvg', REAL( nn_nevp ) * MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * umask(:,:,1) , &
930                  &                                             ABS( v_ice(:,:) - zv_ice(:,:) ) * vmask(:,:,1) ) * zmsk15(:,:) )
931            ENDIF
932         ENDIF
933      ENDIF     
934      !
935      DEALLOCATE( zmsk00, zmsk15 )
936      !
937   END SUBROUTINE ice_dyn_rhg_evp
938
939
940   SUBROUTINE rhg_cvg( kt, kiter, kitermax, pu, pv, pub, pvb )
941      !!----------------------------------------------------------------------
942      !!                    ***  ROUTINE rhg_cvg  ***
943      !!                     
944      !! ** Purpose :   check convergence of oce rheology
945      !!
946      !! ** Method  :   create a file ice_cvg.nc containing the convergence of ice velocity
947      !!                during the sub timestepping of rheology so as:
948      !!                  uice_cvg = MAX( u(t+1) - u(t) , v(t+1) - v(t) )
949      !!                This routine is called every sub-iteration, so it is cpu expensive
950      !!
951      !! ** Note    :   for the first sub-iteration, uice_cvg is set to 0 (too large otherwise)   
952      !!----------------------------------------------------------------------
953      INTEGER ,                 INTENT(in) ::   kt, kiter, kitermax       ! ocean time-step index
954      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pu, pv, pub, pvb          ! now and before velocities
955      !!
956      INTEGER           ::   it, idtime, istatus
957      INTEGER           ::   ji, jj          ! dummy loop indices
958      REAL(wp)          ::   zresm           ! local real
959      CHARACTER(len=20) ::   clname
960      REAL(wp), DIMENSION(jpi,jpj) ::   zres           ! check convergence
961      !!----------------------------------------------------------------------
962
963      ! create file
964      IF( kt == nit000 .AND. kiter == 1 ) THEN
965         !
966         IF( lwp ) THEN
967            WRITE(numout,*)
968            WRITE(numout,*) 'rhg_cvg : ice rheology convergence control'
969            WRITE(numout,*) '~~~~~~~'
970         ENDIF
971         !
972         IF( lwm ) THEN
973            clname = 'ice_cvg.nc'
974            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
975            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, ncvgid )
976            istatus = NF90_DEF_DIM( ncvgid, 'time'  , NF90_UNLIMITED, idtime )
977            istatus = NF90_DEF_VAR( ncvgid, 'uice_cvg', NF90_DOUBLE   , (/ idtime /), nvarid )
978            istatus = NF90_ENDDEF(ncvgid)
979         ENDIF
980         !
981      ENDIF
982
983      ! time
984      it = ( kt - 1 ) * kitermax + kiter
985     
986      ! convergence
987      IF( kiter == 1 ) THEN ! remove the first iteration for calculations of convergence (always very large)
988         zresm = 0._wp
989      ELSE
990         DO_2D( 1, 1, 1, 1 )
991            zres(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), &
992               &               ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * zmsk15(ji,jj)
993         END_2D
994
995         ! cut of the boundary of the box (forced velocities)
996         IF (mjg(jj)<=30 .or. mjg(jj)>970 .or. mig(ji)<=30 .or. mig(ji)>970) THEN
997            zres(ji,jj) = 0._wp
998         END IF
999
1000         zresm = MAXVAL( zres )
1001         CALL mpp_max( 'icedyn_rhg_evp', zresm )   ! max over the global domain
1002      ENDIF
1003
1004      IF( lwm ) THEN
1005         ! write variables
1006         istatus = NF90_PUT_VAR( ncvgid, nvarid, (/zresm/), (/it/), (/1/) )
1007         ! close file
1008         IF( kt == nitend - nn_fsbc + 1 )   istatus = NF90_CLOSE(ncvgid)
1009      ENDIF
1010     
1011   END SUBROUTINE rhg_cvg
1012
1013
1014   SUBROUTINE rhg_evp_rst( cdrw, kt )
1015      !!---------------------------------------------------------------------
1016      !!                   ***  ROUTINE rhg_evp_rst  ***
1017      !!                     
1018      !! ** Purpose :   Read or write RHG file in restart file
1019      !!
1020      !! ** Method  :   use of IOM library
1021      !!----------------------------------------------------------------------
1022      CHARACTER(len=*) , INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
1023      INTEGER, OPTIONAL, INTENT(in) ::   kt     ! ice time-step
1024      !
1025      INTEGER  ::   iter            ! local integer
1026      INTEGER  ::   id1, id2, id3   ! local integers
1027      !!----------------------------------------------------------------------
1028      !
1029      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialize
1030         !                                   ! ---------------
1031         IF( ln_rstart ) THEN                   !* Read the restart file
1032            !
1033            id1 = iom_varid( numrir, 'stress1_i' , ldstop = .FALSE. )
1034            id2 = iom_varid( numrir, 'stress2_i' , ldstop = .FALSE. )
1035            id3 = iom_varid( numrir, 'stress12_i', ldstop = .FALSE. )
1036            !
1037            IF( MIN( id1, id2, id3 ) > 0 ) THEN      ! fields exist
1038               CALL iom_get( numrir, jpdom_auto, 'stress1_i' , stress1_i , cd_type = 'T' )
1039               CALL iom_get( numrir, jpdom_auto, 'stress2_i' , stress2_i , cd_type = 'T' )
1040               CALL iom_get( numrir, jpdom_auto, 'stress12_i', stress12_i, cd_type = 'F' )
1041            ELSE                                     ! start rheology from rest
1042               IF(lwp) WRITE(numout,*)
1043               IF(lwp) WRITE(numout,*) '   ==>>>   previous run without rheology, set stresses to 0'
1044               stress1_i (:,:) = 0._wp
1045               stress2_i (:,:) = 0._wp
1046               stress12_i(:,:) = 0._wp
1047            ENDIF
1048         ELSE                                   !* Start from rest
1049            IF(lwp) WRITE(numout,*)
1050            IF(lwp) WRITE(numout,*) '   ==>>>   start from rest: set stresses to 0'
1051            stress1_i (:,:) = 0._wp
1052            stress2_i (:,:) = 0._wp
1053            stress12_i(:,:) = 0._wp
1054         ENDIF
1055         !
1056      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
1057         !                                   ! -------------------
1058         IF(lwp) WRITE(numout,*) '---- rhg-rst ----'
1059         iter = kt + nn_fsbc - 1             ! ice restarts are written at kt == nitrst - nn_fsbc + 1
1060         !
1061         CALL iom_rstput( iter, nitrst, numriw, 'stress1_i' , stress1_i  )
1062         CALL iom_rstput( iter, nitrst, numriw, 'stress2_i' , stress2_i  )
1063         CALL iom_rstput( iter, nitrst, numriw, 'stress12_i', stress12_i )
1064         !
1065      ENDIF
1066      !
1067   END SUBROUTINE rhg_evp_rst
1068
1069   
1070#else
1071   !!----------------------------------------------------------------------
1072   !!   Default option         Empty module           NO SI3 sea-ice model
1073   !!----------------------------------------------------------------------
1074#endif
1075
1076   !!==============================================================================
1077END MODULE icedyn_rhg_evp
Note: See TracBrowser for help on using the repository browser.