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_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/tests/ICE_RHEO/MY_SRC – NEMO

source: NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/tests/ICE_RHEO/MY_SRC/icedyn_rhg_evp.F90 @ 14644

Last change on this file since 14644 was 14644, checked in by sparonuz, 3 years ago

Merge trunk -r14642:HEAD

File size: 63.2 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( '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( '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( 'icedyn_rhg_evp', ztaux_oi, 'U', -1.0_wp, ztauy_oi, 'V', -1.0_wp,   &
789            &                            ztaux_ai, 'U', -1.0_wp, ztauy_ai, 'V', -1.0_wp,   &
790            &                            ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp )
791         !
792         CALL iom_put( 'utau_oi' , ztaux_oi * zmsk00 )
793         CALL iom_put( 'vtau_oi' , ztauy_oi * zmsk00 )
794         CALL iom_put( 'utau_ai' , ztaux_ai * zmsk00 )
795         CALL iom_put( 'vtau_ai' , ztauy_ai * zmsk00 )
796         CALL iom_put( 'utau_bi' , ztaux_bi * zmsk00 )
797         CALL iom_put( 'vtau_bi' , ztauy_bi * zmsk00 )
798      ENDIF
799       
800      ! --- divergence, shear and strength --- !
801      IF( iom_use('icediv') )   CALL iom_put( 'icediv' , pdivu_i  * zmsk00 )   ! divergence
802      IF( iom_use('iceshe') )   CALL iom_put( 'iceshe' , pshear_i * zmsk00 )   ! shear
803      IF( iom_use('icestr') )   CALL iom_put( 'icestr' , strength * zmsk00 )   ! strength
804
805      ! --- Stress tensor invariants (SIMIP diags) --- !
806      IF( iom_use('normstr') .OR. iom_use('sheastr') ) THEN
807         !
808         ALLOCATE( zsig_I(jpi,jpj) , zsig_II(jpi,jpj) )
809         !         
810         DO_2D( 1, 1, 1, 1 )
811           
812            ! Ice stresses
813            ! sigma1, sigma2, sigma12 are some useful recombination of the stresses (Hunke and Dukowicz MWR 2002, Bouillon et al., OM2013)
814            ! These are NOT stress tensor components, neither stress invariants, neither stress principal components
815            ! I know, this can be confusing...
816            zfac             =   strength(ji,jj) / ( pdelta_i(ji,jj) + rn_creepl ) 
817            zsig1            =   zfac * ( pdivu_i(ji,jj) - pdelta_i(ji,jj) )
818            zsig2            =   zfac * z1_ecc2 * zten_i(ji,jj)
819            zsig12           =   zfac * z1_ecc2 * pshear_i(ji,jj)
820           
821            ! Stress invariants (sigma_I, sigma_II, Coon 1974, Feltham 2008)
822            zsig_I (ji,jj)   =   zsig1 * 0.5_wp                                           ! 1st stress invariant, aka average normal stress, aka negative pressure
823            zsig_II(ji,jj)   =   SQRT ( MAX( 0._wp, zsig2 * zsig2 * 0.25_wp + zsig12 ) )  ! 2nd  ''       '', aka maximum shear stress
824               
825         END_2D         
826         !
827         ! Stress tensor invariants (normal and shear stress N/m) - SIMIP diags - definitions following Coon (1974) and Feltham (2008)
828         IF( iom_use('normstr') )   CALL iom_put( 'normstr', zsig_I (:,:) * zmsk00(:,:) ) ! Normal stress
829         IF( iom_use('sheastr') )   CALL iom_put( 'sheastr', zsig_II(:,:) * zmsk00(:,:) ) ! Maximum shear stress
830         
831         DEALLOCATE ( zsig_I, zsig_II )
832         
833      ENDIF
834
835      ! --- Normalized stress tensor principal components --- !
836      ! This are used to plot the normalized yield curve, see Lemieux & Dupont, 2020
837      ! Recommendation 1 : we use ice strength, not replacement pressure
838      ! Recommendation 2 : need to use deformations at PREVIOUS iterate for viscosities
839      IF( iom_use('sig1_pnorm') .OR. iom_use('sig2_pnorm') ) THEN
840         !
841         ALLOCATE( zsig1_p(jpi,jpj) , zsig2_p(jpi,jpj) , zsig_I(jpi,jpj) , zsig_II(jpi,jpj) )         
842         !         
843         DO_2D( 1, 1, 1, 1 )
844           
845            ! Ice stresses computed with **viscosities** (delta, p/delta) at **previous** iterates
846            !                        and **deformations** at current iterates
847            !                        following Lemieux & Dupont (2020)
848            zfac             =   zp_delt(ji,jj)
849            zsig1            =   zfac * ( pdivu_i(ji,jj) - ( zdelta(ji,jj) + rn_creepl ) )
850            zsig2            =   zfac * z1_ecc2 * zten_i(ji,jj)
851            zsig12           =   zfac * z1_ecc2 * pshear_i(ji,jj)
852           
853            ! Stress invariants (sigma_I, sigma_II, Coon 1974, Feltham 2008), T-point
854            zsig_I(ji,jj)    =   zsig1 * 0.5_wp                                            ! 1st stress invariant, aka average normal stress, aka negative pressure
855            zsig_II(ji,jj)   =   SQRT ( MAX( 0._wp, zsig2 * zsig2 * 0.25_wp + zsig12 ) )   ! 2nd  ''       '', aka maximum shear stress
856           
857            ! Normalized  principal stresses (used to display the ellipse)
858            z1_strength      =   1._wp / MAX( 1._wp, strength(ji,jj) )
859            zsig1_p(ji,jj)   =   ( zsig_I(ji,jj) + zsig_II(ji,jj) ) * z1_strength
860            zsig2_p(ji,jj)   =   ( zsig_I(ji,jj) - zsig_II(ji,jj) ) * z1_strength
861         END_2D             
862         !
863         CALL iom_put( 'sig1_pnorm' , zsig1_p ) 
864         CALL iom_put( 'sig2_pnorm' , zsig2_p ) 
865
866         DEALLOCATE( zsig1_p , zsig2_p , zsig_I, zsig_II )
867         
868      ENDIF
869
870      ! --- SIMIP --- !
871      IF(  iom_use('dssh_dx') .OR. iom_use('dssh_dy') .OR. &
872         & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN
873         !
874         CALL lbc_lnk( 'icedyn_rhg_evp', zspgU, 'U', -1.0_wp, zspgV, 'V', -1.0_wp, &
875            &                            zCorU, 'U', -1.0_wp, zCorV, 'V', -1.0_wp, zfU, 'U', -1.0_wp, zfV, 'V', -1.0_wp )
876
877         CALL iom_put( 'dssh_dx' , zspgU * zmsk00 )   ! Sea-surface tilt term in force balance (x)
878         CALL iom_put( 'dssh_dy' , zspgV * zmsk00 )   ! Sea-surface tilt term in force balance (y)
879         CALL iom_put( 'corstrx' , zCorU * zmsk00 )   ! Coriolis force term in force balance (x)
880         CALL iom_put( 'corstry' , zCorV * zmsk00 )   ! Coriolis force term in force balance (y)
881         CALL iom_put( 'intstrx' , zfU   * zmsk00 )   ! Internal force term in force balance (x)
882         CALL iom_put( 'intstry' , zfV   * zmsk00 )   ! Internal force term in force balance (y)
883      ENDIF
884
885      IF(  iom_use('xmtrpice') .OR. iom_use('ymtrpice') .OR. &
886         & iom_use('xmtrpsnw') .OR. iom_use('ymtrpsnw') .OR. iom_use('xatrp') .OR. iom_use('yatrp') ) THEN
887         !
888         ALLOCATE( zdiag_xmtrp_ice(jpi,jpj) , zdiag_ymtrp_ice(jpi,jpj) , &
889            &      zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp(jpi,jpj) , zdiag_yatrp(jpi,jpj) )
890         !
891         DO_2D( 0, 0, 0, 0 )
892            ! 2D ice mass, snow mass, area transport arrays (X, Y)
893            zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj)
894            zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj)
895
896            zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component
897            zdiag_ymtrp_ice(ji,jj) = rhoi * zfac_y * ( vt_i(ji,jj+1) + vt_i(ji,jj) ) !        ''           Y-   ''
898
899            zdiag_xmtrp_snw(ji,jj) = rhos * zfac_x * ( vt_s(ji+1,jj) + vt_s(ji,jj) ) ! snow mass transport, X-component
900            zdiag_ymtrp_snw(ji,jj) = rhos * zfac_y * ( vt_s(ji,jj+1) + vt_s(ji,jj) ) !          ''          Y-   ''
901
902            zdiag_xatrp(ji,jj)     = zfac_x * ( at_i(ji+1,jj) + at_i(ji,jj) )        ! area transport,      X-component
903            zdiag_yatrp(ji,jj)     = zfac_y * ( at_i(ji,jj+1) + at_i(ji,jj) )        !        ''            Y-   ''
904
905         END_2D
906
907         CALL lbc_lnk( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1.0_wp, zdiag_ymtrp_ice, 'V', -1.0_wp, &
908            &                            zdiag_xmtrp_snw, 'U', -1.0_wp, zdiag_ymtrp_snw, 'V', -1.0_wp, &
909            &                            zdiag_xatrp    , 'U', -1.0_wp, zdiag_yatrp    , 'V', -1.0_wp )
910
911         CALL iom_put( 'xmtrpice' , zdiag_xmtrp_ice )   ! X-component of sea-ice mass transport (kg/s)
912         CALL iom_put( 'ymtrpice' , zdiag_ymtrp_ice )   ! Y-component of sea-ice mass transport
913         CALL iom_put( 'xmtrpsnw' , zdiag_xmtrp_snw )   ! X-component of snow mass transport (kg/s)
914         CALL iom_put( 'ymtrpsnw' , zdiag_ymtrp_snw )   ! Y-component of snow mass transport
915         CALL iom_put( 'xatrp'    , zdiag_xatrp     )   ! X-component of ice area transport
916         CALL iom_put( 'yatrp'    , zdiag_yatrp     )   ! Y-component of ice area transport
917
918         DEALLOCATE( zdiag_xmtrp_ice , zdiag_ymtrp_ice , &
919            &        zdiag_xmtrp_snw , zdiag_ymtrp_snw , zdiag_xatrp , zdiag_yatrp )
920
921      ENDIF
922      !
923      ! --- convergence tests --- !
924      IF( nn_rhg_chkcvg == 1 .OR. nn_rhg_chkcvg == 2 ) THEN
925         IF( iom_use('uice_cvg') ) THEN
926            IF( ln_aEVP ) THEN   ! output: beta * ( u(t=nn_nevp) - u(t=nn_nevp-1) )
927               CALL iom_put( 'uice_cvg', MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * zbeta(:,:) * umask(:,:,1) , &
928                  &                           ABS( v_ice(:,:) - zv_ice(:,:) ) * zbeta(:,:) * vmask(:,:,1) ) * zmsk15(:,:) )
929            ELSE                 ! output: nn_nevp * ( u(t=nn_nevp) - u(t=nn_nevp-1) )
930               CALL iom_put( 'uice_cvg', REAL( nn_nevp ) * MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * umask(:,:,1) , &
931                  &                                             ABS( v_ice(:,:) - zv_ice(:,:) ) * vmask(:,:,1) ) * zmsk15(:,:) )
932            ENDIF
933         ENDIF
934      ENDIF     
935      !
936      DEALLOCATE( zmsk00, zmsk15 )
937      !
938   END SUBROUTINE ice_dyn_rhg_evp
939
940
941   SUBROUTINE rhg_cvg( kt, kiter, kitermax, pu, pv, pub, pvb )
942      !!----------------------------------------------------------------------
943      !!                    ***  ROUTINE rhg_cvg  ***
944      !!                     
945      !! ** Purpose :   check convergence of oce rheology
946      !!
947      !! ** Method  :   create a file ice_cvg.nc containing the convergence of ice velocity
948      !!                during the sub timestepping of rheology so as:
949      !!                  uice_cvg = MAX( u(t+1) - u(t) , v(t+1) - v(t) )
950      !!                This routine is called every sub-iteration, so it is cpu expensive
951      !!
952      !! ** Note    :   for the first sub-iteration, uice_cvg is set to 0 (too large otherwise)   
953      !!----------------------------------------------------------------------
954      INTEGER ,                 INTENT(in) ::   kt, kiter, kitermax       ! ocean time-step index
955      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pu, pv, pub, pvb          ! now and before velocities
956      !!
957      INTEGER           ::   it, idtime, istatus
958      INTEGER           ::   ji, jj          ! dummy loop indices
959      REAL(wp)          ::   zresm           ! local real
960      CHARACTER(len=20) ::   clname
961      REAL(wp), DIMENSION(jpi,jpj) ::   zres           ! check convergence
962      !!----------------------------------------------------------------------
963
964      ! create file
965      IF( kt == nit000 .AND. kiter == 1 ) THEN
966         !
967         IF( lwp ) THEN
968            WRITE(numout,*)
969            WRITE(numout,*) 'rhg_cvg : ice rheology convergence control'
970            WRITE(numout,*) '~~~~~~~'
971         ENDIF
972         !
973         IF( lwm ) THEN
974            clname = 'ice_cvg.nc'
975            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
976            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, ncvgid )
977            istatus = NF90_DEF_DIM( ncvgid, 'time'  , NF90_UNLIMITED, idtime )
978            istatus = NF90_DEF_VAR( ncvgid, 'uice_cvg', NF90_DOUBLE   , (/ idtime /), nvarid )
979            istatus = NF90_ENDDEF(ncvgid)
980         ENDIF
981         !
982      ENDIF
983
984      ! time
985      it = ( kt - 1 ) * kitermax + kiter
986     
987      ! convergence
988      IF( kiter == 1 ) THEN ! remove the first iteration for calculations of convergence (always very large)
989         zresm = 0._wp
990      ELSE
991         DO_2D( 1, 1, 1, 1 )
992            zres(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), &
993               &               ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * zmsk15(ji,jj)
994         END_2D
995
996         ! cut of the boundary of the box (forced velocities)
997         IF (mjg(jj)<=30 .or. mjg(jj)>970 .or. mig(ji)<=30 .or. mig(ji)>970) THEN
998            zres(ji,jj) = 0._wp
999         END IF
1000
1001         zresm = MAXVAL( zres )
1002         CALL mpp_max( 'icedyn_rhg_evp', zresm )   ! max over the global domain
1003      ENDIF
1004
1005      IF( lwm ) THEN
1006         ! write variables
1007         istatus = NF90_PUT_VAR( ncvgid, nvarid, (/zresm/), (/it/), (/1/) )
1008         ! close file
1009         IF( kt == nitend - nn_fsbc + 1 )   istatus = NF90_CLOSE(ncvgid)
1010      ENDIF
1011     
1012   END SUBROUTINE rhg_cvg
1013
1014
1015   SUBROUTINE rhg_evp_rst( cdrw, kt )
1016      !!---------------------------------------------------------------------
1017      !!                   ***  ROUTINE rhg_evp_rst  ***
1018      !!                     
1019      !! ** Purpose :   Read or write RHG file in restart file
1020      !!
1021      !! ** Method  :   use of IOM library
1022      !!----------------------------------------------------------------------
1023      CHARACTER(len=*) , INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
1024      INTEGER, OPTIONAL, INTENT(in) ::   kt     ! ice time-step
1025      !
1026      INTEGER  ::   iter            ! local integer
1027      INTEGER  ::   id1, id2, id3   ! local integers
1028      !!----------------------------------------------------------------------
1029      !
1030      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialize
1031         !                                   ! ---------------
1032         IF( ln_rstart ) THEN                   !* Read the restart file
1033            !
1034            id1 = iom_varid( numrir, 'stress1_i' , ldstop = .FALSE. )
1035            id2 = iom_varid( numrir, 'stress2_i' , ldstop = .FALSE. )
1036            id3 = iom_varid( numrir, 'stress12_i', ldstop = .FALSE. )
1037            !
1038            IF( MIN( id1, id2, id3 ) > 0 ) THEN      ! fields exist
1039               CALL iom_get( numrir, jpdom_auto, 'stress1_i' , stress1_i , cd_type = 'T' )
1040               CALL iom_get( numrir, jpdom_auto, 'stress2_i' , stress2_i , cd_type = 'T' )
1041               CALL iom_get( numrir, jpdom_auto, 'stress12_i', stress12_i, cd_type = 'F' )
1042            ELSE                                     ! start rheology from rest
1043               IF(lwp) WRITE(numout,*)
1044               IF(lwp) WRITE(numout,*) '   ==>>>   previous run without rheology, set stresses to 0'
1045               stress1_i (:,:) = 0._wp
1046               stress2_i (:,:) = 0._wp
1047               stress12_i(:,:) = 0._wp
1048            ENDIF
1049         ELSE                                   !* Start from rest
1050            IF(lwp) WRITE(numout,*)
1051            IF(lwp) WRITE(numout,*) '   ==>>>   start from rest: set stresses to 0'
1052            stress1_i (:,:) = 0._wp
1053            stress2_i (:,:) = 0._wp
1054            stress12_i(:,:) = 0._wp
1055         ENDIF
1056         !
1057      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
1058         !                                   ! -------------------
1059         IF(lwp) WRITE(numout,*) '---- rhg-rst ----'
1060         iter = kt + nn_fsbc - 1             ! ice restarts are written at kt == nitrst - nn_fsbc + 1
1061         !
1062         CALL iom_rstput( iter, nitrst, numriw, 'stress1_i' , stress1_i  )
1063         CALL iom_rstput( iter, nitrst, numriw, 'stress2_i' , stress2_i  )
1064         CALL iom_rstput( iter, nitrst, numriw, 'stress12_i', stress12_i )
1065         !
1066      ENDIF
1067      !
1068   END SUBROUTINE rhg_evp_rst
1069
1070   
1071#else
1072   !!----------------------------------------------------------------------
1073   !!   Default option         Empty module           NO SI3 sea-ice model
1074   !!----------------------------------------------------------------------
1075#endif
1076
1077   !!==============================================================================
1078END MODULE icedyn_rhg_evp
Note: See TracBrowser for help on using the repository browser.