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/UKMO/NEMO_4.0.4_GO8_package/src/ICE – NEMO

source: NEMO/branches/UKMO/NEMO_4.0.4_GO8_package/src/ICE/icedyn_rhg_evp.F90

Last change on this file was 15736, checked in by edblockley, 2 years ago

Adding lbc_lnk required for new zshear array

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