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_r13296_HPC-07_mocavero_mpi3/src/ICE – NEMO

source: NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icedyn_rhg_evp.F90 @ 13630

Last change on this file since 13630 was 13630, checked in by mocavero, 4 years ago

Add neighborhood collectives calls in the NEMO src - ticket #2496

  • Property svn:keywords set to Id
File size: 62.5 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$
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      !
140      REAL(wp), DIMENSION(jpi,jpj) ::   zdelta, zp_delt                 ! delta and P/delta at T points
141      REAL(wp), DIMENSION(jpi,jpj) ::   zbeta                           ! beta coef from Kimmritz 2017
142      !
143      REAL(wp), DIMENSION(jpi,jpj) ::   zdt_m                           ! (dt / ice-snow_mass) on T points
144      REAL(wp), DIMENSION(jpi,jpj) ::   zaU  , zaV                      ! ice fraction on U/V points
145      REAL(wp), DIMENSION(jpi,jpj) ::   zmU_t, zmV_t                    ! (ice-snow_mass / dt) on U/V points
146      REAL(wp), DIMENSION(jpi,jpj) ::   zmf                             ! coriolis parameter at T points
147      REAL(wp), DIMENSION(jpi,jpj) ::   v_oceU, u_oceV, v_iceU, u_iceV  ! ocean/ice u/v component on V/U points
148      !
149      REAL(wp), DIMENSION(jpi,jpj) ::   zds                             ! shear
150      REAL(wp), DIMENSION(jpi,jpj) ::   zs1, zs2, zs12                  ! stress tensor components
151      REAL(wp), DIMENSION(jpi,jpj) ::   zsshdyn                         ! array used for the calculation of ice surface slope:
152      !                                                                 !    ocean surface (ssh_m) if ice is not embedded
153      !                                                                 !    ice bottom surface if ice is embedded   
154      REAL(wp), DIMENSION(jpi,jpj) ::   zfU  , zfV                      ! internal stresses
155      REAL(wp), DIMENSION(jpi,jpj) ::   zspgU, zspgV                    ! surface pressure gradient at U/V points
156      REAL(wp), DIMENSION(jpi,jpj) ::   zCorU, zCorV                    ! Coriolis stress array
157      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_ai, ztauy_ai              ! ice-atm. stress at U-V points
158      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_oi, ztauy_oi              ! ice-ocean stress at U-V points
159      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_bi, ztauy_bi              ! ice-OceanBottom stress at U-V points (landfast)
160      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_base, ztauy_base          ! ice-bottom stress at U-V points (landfast)
161      !
162      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk01x, zmsk01y                ! dummy arrays
163      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00x, zmsk00y                ! mask for ice presence
164      REAL(wp), DIMENSION(jpi,jpj) ::   zfmask                          ! mask at F points for the ice
165
166      REAL(wp), PARAMETER          ::   zepsi  = 1.0e-20_wp             ! tolerance parameter
167      REAL(wp), PARAMETER          ::   zmmin  = 1._wp                  ! ice mass (kg/m2)  below which ice velocity becomes very small
168      REAL(wp), PARAMETER          ::   zamin  = 0.001_wp               ! ice concentration below which ice velocity becomes very small
169      !! --- check convergence
170      REAL(wp), DIMENSION(jpi,jpj) ::   zu_ice, zv_ice
171      !! --- diags
172      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zsig1, zsig2, zsig3
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_2D( 1, 1, 1, 1 )
187         zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice
188         zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less
189      END_2D
190      !
191      !!gm for Clem:  OPTIMIZATION:  I think zfmask can be computed one for all at the initialization....
192      !------------------------------------------------------------------------------!
193      ! 0) mask at F points for the ice
194      !------------------------------------------------------------------------------!
195      ! ocean/land mask
196      DO_2D( 1, 0, 1, 0 )
197         zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1)
198      END_2D
199#if defined key_mpi3
200      CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zfmask, 'F', 1._wp)
201#else
202      CALL lbc_lnk( 'icedyn_rhg_evp', zfmask, 'F', 1._wp)
203#endif
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#if defined key_mpi3
229      CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zfmask, 'F', 1._wp )
230#else
231      CALL lbc_lnk( 'icedyn_rhg_evp', zfmask, 'F', 1._wp )
232#endif
233
234      !------------------------------------------------------------------------------!
235      ! 1) define some variables and initialize arrays
236      !------------------------------------------------------------------------------!
237      zrhoco = rho0 * rn_cio 
238
239      ! ecc2: square of yield ellipse eccenticrity
240      ecc2    = rn_ecc * rn_ecc
241      z1_ecc2 = 1._wp / ecc2
242
243      ! alpha parameters (Bouillon 2009)
244      IF( .NOT. ln_aEVP ) THEN
245         zdtevp   = rDt_ice / REAL( nn_nevp )
246         zalph1 =   2._wp * rn_relast * REAL( nn_nevp )
247         zalph2 = zalph1 * z1_ecc2
248
249         z1_alph1 = 1._wp / ( zalph1 + 1._wp )
250         z1_alph2 = 1._wp / ( zalph2 + 1._wp )
251      ELSE
252         zdtevp   = rdt_ice
253         ! zalpha parameters set later on adaptatively
254      ENDIF
255      z1_dtevp = 1._wp / zdtevp
256         
257      ! Initialise stress tensor
258      zs1 (:,:) = pstress1_i (:,:) 
259      zs2 (:,:) = pstress2_i (:,:)
260      zs12(:,:) = pstress12_i(:,:)
261
262      ! Ice strength
263      CALL ice_strength
264
265      ! landfast param from Lemieux(2016): add isotropic tensile strength (following Konig Beatty and Holland, 2010)
266      IF( ln_landfast_L16 ) THEN   ;   zkt = rn_lf_tensile
267      ELSE                         ;   zkt = 0._wp
268      ENDIF
269      !
270      !------------------------------------------------------------------------------!
271      ! 2) Wind / ocean stress, mass terms, coriolis terms
272      !------------------------------------------------------------------------------!
273      ! sea surface height
274      !    embedded sea ice: compute representative ice top surface
275      !    non-embedded sea ice: use ocean surface for slope calculation
276      zsshdyn(:,:) = ice_var_sshdyn( ssh_m, snwice_mass, snwice_mass_b)
277
278      DO_2D( 0, 0, 0, 0 )
279
280         ! ice fraction at U-V points
281         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)
282         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)
283
284         ! Ice/snow mass at U-V points
285         zm1 = ( rhos * vt_s(ji  ,jj  ) + rhoi * vt_i(ji  ,jj  ) )
286         zm2 = ( rhos * vt_s(ji+1,jj  ) + rhoi * vt_i(ji+1,jj  ) )
287         zm3 = ( rhos * vt_s(ji  ,jj+1) + rhoi * vt_i(ji  ,jj+1) )
288         zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
289         zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
290
291         ! Ocean currents at U-V points
292         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)
293         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)
294
295         ! Coriolis at T points (m*f)
296         zmf(ji,jj)      = zm1 * ff_t(ji,jj)
297
298         ! dt/m at T points (for alpha and beta coefficients)
299         zdt_m(ji,jj)    = zdtevp / MAX( zm1, zmmin )
300         
301         ! m/dt
302         zmU_t(ji,jj)    = zmassU * z1_dtevp
303         zmV_t(ji,jj)    = zmassV * z1_dtevp
304         
305         ! Drag ice-atm.
306         ztaux_ai(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj)
307         ztauy_ai(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj)
308
309         ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points
310         zspgU(ji,jj)    = - zmassU * grav * ( zsshdyn(ji+1,jj) - zsshdyn(ji,jj) ) * r1_e1u(ji,jj)
311         zspgV(ji,jj)    = - zmassV * grav * ( zsshdyn(ji,jj+1) - zsshdyn(ji,jj) ) * r1_e2v(ji,jj)
312
313         ! masks
314         zmsk00x(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) )  ! 0 if no ice
315         zmsk00y(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) )  ! 0 if no ice
316
317         ! switches
318         IF( zmassU <= zmmin .AND. zaU(ji,jj) <= zamin ) THEN   ;   zmsk01x(ji,jj) = 0._wp
319         ELSE                                                   ;   zmsk01x(ji,jj) = 1._wp   ;   ENDIF
320         IF( zmassV <= zmmin .AND. zaV(ji,jj) <= zamin ) THEN   ;   zmsk01y(ji,jj) = 0._wp
321         ELSE                                                   ;   zmsk01y(ji,jj) = 1._wp   ;   ENDIF
322
323      END_2D
324      CALL lbc_lnk_multi( 'icedyn_rhg_evp', zmf, 'T', 1.0_wp, zdt_m, 'T', 1.0_wp )
325      !
326      !                                  !== Landfast ice parameterization ==!
327      !
328      IF( ln_landfast_L16 ) THEN         !-- Lemieux 2016
329         DO_2D( 0, 0, 0, 0 )
330            ! ice thickness at U-V points
331            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)
332            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)
333            ! ice-bottom stress at U points
334            zvCr = zaU(ji,jj) * rn_lf_depfra * hu(ji,jj,Kmm)
335            ztaux_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) )
336            ! ice-bottom stress at V points
337            zvCr = zaV(ji,jj) * rn_lf_depfra * hv(ji,jj,Kmm)
338            ztauy_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) )
339            ! ice_bottom stress at T points
340            zvCr = at_i(ji,jj) * rn_lf_depfra * ht(ji,jj)
341            tau_icebfr(ji,jj) = - rn_lf_bfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) )
342         END_2D
343#if defined key_mpi3
344         CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1.0_wp )
345#else
346         CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1.0_wp )
347#endif
348         !
349      ELSE                               !-- no landfast
350         DO_2D( 0, 0, 0, 0 )
351            ztaux_base(ji,jj) = 0._wp
352            ztauy_base(ji,jj) = 0._wp
353         END_2D
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_2D( nn_hls, nn_hls, nn_hls, nn_hls )
368               zu_ice(ji,jj) = u_ice(ji,jj) * umask(ji,jj,1) ! velocity at previous time step
369               zv_ice(ji,jj) = v_ice(ji,jj) * vmask(ji,jj,1)
370            END_2D
371         ENDIF
372
373         ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- !
374         DO_2D( 1, 0, 1, 0 )
375
376            ! shear at F points
377            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)   &
378               &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   &
379               &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)
380
381         END_2D
382
383         DO_2D( 0, 0, 0, 0 )
384
385            ! shear**2 at T points (doc eq. A16)
386            zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  &
387               &   + 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)  &
388               &   ) * 0.25_wp * r1_e1e2t(ji,jj)
389           
390            ! divergence at T points
391            zdiv  = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
392               &    + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
393               &    ) * r1_e1e2t(ji,jj)
394            zdiv2 = zdiv * zdiv
395           
396            ! tension at T points
397            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)   &
398               &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
399               &   ) * r1_e1e2t(ji,jj)
400            zdt2 = zdt * zdt
401           
402            ! delta at T points
403            zdelta(ji,jj) = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 ) 
404
405         END_2D
406#if defined key_mpi3
407         CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zdelta, 'T', 1.0_wp )
408#else
409         CALL lbc_lnk( 'icedyn_rhg_evp', zdelta, 'T', 1.0_wp )
410#endif
411         ! P/delta at T points
412         DO_2D( 1, 1, 1, 1 )
413            zp_delt(ji,jj) = strength(ji,jj) / ( zdelta(ji,jj) + rn_creepl )
414         END_2D
415
416         DO_2D( 0, 1, 0, 1 )   ! loop ends at jpi,jpj so that no lbc_lnk are needed for zs1 and zs2
417
418            ! divergence at T points (duplication to avoid communications)
419            zdiv  = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
420               &    + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
421               &    ) * r1_e1e2t(ji,jj)
422           
423            ! tension at T points (duplication to avoid communications)
424            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)   &
425               &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
426               &   ) * r1_e1e2t(ji,jj)
427           
428            ! alpha for aEVP
429            !   gamma = 0.5*P/(delta+creepl) * (c*pi)**2/Area * dt/m
430            !   alpha = beta = sqrt(4*gamma)
431            IF( ln_aEVP ) THEN
432               zalph1   = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) )
433               z1_alph1 = 1._wp / ( zalph1 + 1._wp )
434               zalph2   = zalph1
435               z1_alph2 = z1_alph1
436               ! explicit:
437               ! z1_alph1 = 1._wp / zalph1
438               ! z1_alph2 = 1._wp / zalph1
439               ! zalph1 = zalph1 - 1._wp
440               ! zalph2 = zalph1
441            ENDIF
442           
443            ! stress at T points (zkt/=0 if landfast)
444            zs1(ji,jj) = ( zs1(ji,jj)*zalph1 + zp_delt(ji,jj) * ( zdiv*(1._wp + zkt) - zdelta(ji,jj)*(1._wp - zkt) ) ) * z1_alph1
445            zs2(ji,jj) = ( zs2(ji,jj)*zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2
446         
447         END_2D
448         ! Save beta at T-points for further computations
449         IF( ln_aEVP ) THEN
450            DO_2D( 1, 1, 1, 1 )
451               zbeta(ji,jj) = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) )
452            END_2D
453         ENDIF
454         
455         DO_2D( 1, 0, 1, 0 )
456
457            ! alpha for aEVP
458            IF( ln_aEVP ) THEN
459               zalph2   = MAX( zbeta(ji,jj), zbeta(ji+1,jj), zbeta(ji,jj+1), zbeta(ji+1,jj+1) )
460               z1_alph2 = 1._wp / ( zalph2 + 1._wp )
461               ! explicit:
462               ! z1_alph2 = 1._wp / zalph2
463               ! zalph2 = zalph2 - 1._wp
464            ENDIF
465           
466            ! P/delta at F points
467            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) )
468           
469            ! stress at F points (zkt/=0 if landfast)
470            zs12(ji,jj)= ( zs12(ji,jj) * zalph2 + zp_delf * ( zds(ji,jj) * z1_ecc2 * (1._wp + zkt) ) * 0.5_wp ) * z1_alph2
471
472         END_2D
473
474         ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- !
475         DO_2D( 0, 0, 0, 0 )
476            !                   !--- U points
477            zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj)                                             &
478               &                  + ( zs2(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) - zs2(ji,jj) * e2t(ji,jj) * e2t(ji,jj)    &
479               &                    ) * r1_e2u(ji,jj)                                                                      &
480               &                  + ( zs12(ji,jj) * e1f(ji,jj) * e1f(ji,jj) - zs12(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1)  &
481               &                    ) * 2._wp * r1_e1u(ji,jj)                                                              &
482               &                  ) * r1_e1e2u(ji,jj)
483            !
484            !                !--- V points
485            zfV(ji,jj) = 0.5_wp * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj)                                             &
486               &                  - ( zs2(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) - zs2(ji,jj) * e1t(ji,jj) * e1t(ji,jj)    &
487               &                    ) * r1_e1v(ji,jj)                                                                      &
488               &                  + ( zs12(ji,jj) * e2f(ji,jj) * e2f(ji,jj) - zs12(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj)  &
489               &                    ) * 2._wp * r1_e2v(ji,jj)                                                              &
490               &                  ) * r1_e1e2v(ji,jj)
491            !
492            !                !--- ice currents at U-V point
493            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)
494            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)
495            !
496         END_2D
497         !
498         ! --- Computation of ice velocity --- !
499         !  Bouillon et al. 2013 (eq 47-48) => unstable unless alpha, beta vary as in Kimmritz 2016 & 2017
500         !  Bouillon et al. 2009 (eq 34-35) => stable
501         IF( MOD(jter,2) == 0 ) THEN ! even iterations
502            !
503            DO_2D( 0, 0, 0, 0 )
504               !                 !--- tau_io/(v_oce - v_ice)
505               zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  &
506                  &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) )
507               !                 !--- Ocean-to-Ice stress
508               ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) )
509               !
510               !                 !--- tau_bottom/v_ice
511               zvel  = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) )
512               zTauB = ztauy_base(ji,jj) / zvel
513               !                 !--- OceanBottom-to-Ice stress
514               ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj)
515               !
516               !                 !--- Coriolis at V-points (energy conserving formulation)
517               zCorV(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  &
518                  &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  &
519                  &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) )
520               !
521               !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
522               zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj)
523               !
524               !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
525               !                                         1 = sliding friction : TauB < RHS
526               rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
527               !
528               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
529                  zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) )
530                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity
531                     &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
532                     &                                    ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
533                     &            + ( 1._wp - rswitch ) * (  v_ice_b(ji,jj)                                                   & 
534                     &                                     + v_ice  (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0
535                     &                                    ) / ( zbetav + 1._wp )                                              &
536                     &             ) * 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
537                     &           )   * zmsk00y(ji,jj)
538               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
539                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                                       & ! previous velocity
540                     &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
541                     &                                    ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast
542                     &            + ( 1._wp - rswitch ) *   v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0
543                     &             ) * 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
544                     &            )  * zmsk00y(ji,jj)
545               ENDIF
546            END_2D
547#if defined key_mpi3
548            CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp )
549#else
550            CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp )
551#endif
552            !
553#if defined key_agrif
554!!            CALL agrif_interp_ice( 'V', jter, nn_nevp )
555            CALL agrif_interp_ice( 'V' )
556#endif
557            IF( ln_bdy )   CALL bdy_ice_dyn( 'V' )
558            !
559            DO_2D( 0, 0, 0, 0 )
560               !                 !--- tau_io/(u_oce - u_ice)
561               zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  &
562                  &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) )
563               !                 !--- Ocean-to-Ice stress
564               ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) )
565               !
566               !                 !--- tau_bottom/u_ice
567               zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) )
568               zTauB = ztaux_base(ji,jj) / zvel
569               !                 !--- OceanBottom-to-Ice stress
570               ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj)
571               !
572               !                 !--- Coriolis at U-points (energy conserving formulation)
573               zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  &
574                  &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  &
575                  &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) )
576               !
577               !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
578               zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj)
579               !
580               !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
581               !                                         1 = sliding friction : TauB < RHS
582               rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
583               !
584               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
585                  zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) )
586                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity
587                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
588                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
589                     &            + ( 1._wp - rswitch ) * (  u_ice_b(ji,jj)                                                   &
590                     &                                     + u_ice  (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0
591                     &                                    ) / ( zbetau + 1._wp )                                              &
592                     &             ) * 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
593                     &           )   * zmsk00x(ji,jj)
594               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
595                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity
596                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
597                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast
598                     &            + ( 1._wp - rswitch ) *   u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0
599                     &             ) * 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
600                     &           )   * zmsk00x(ji,jj)
601               ENDIF
602            END_2D
603#if defined key_mpi3
604            CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp )
605#else
606            CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp )
607#endif
608            !
609#if defined key_agrif
610!!            CALL agrif_interp_ice( 'U', jter, nn_nevp )
611            CALL agrif_interp_ice( 'U' )
612#endif
613            IF( ln_bdy )   CALL bdy_ice_dyn( 'U' )
614            !
615         ELSE ! odd iterations
616            !
617            DO_2D( 0, 0, 0, 0 )
618               !                 !--- tau_io/(u_oce - u_ice)
619               zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  &
620                  &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) )
621               !                 !--- Ocean-to-Ice stress
622               ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) )
623               !
624               !                 !--- tau_bottom/u_ice
625               zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) )
626               zTauB = ztaux_base(ji,jj) / zvel
627               !                 !--- OceanBottom-to-Ice stress
628               ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj)
629               !
630               !                 !--- Coriolis at U-points (energy conserving formulation)
631               zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  &
632                  &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  &
633                  &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) )
634               !
635               !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
636               zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj)
637               !
638               !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
639               !                                         1 = sliding friction : TauB < RHS
640               rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
641               !
642               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
643                  zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) )
644                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity
645                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
646                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
647                     &            + ( 1._wp - rswitch ) * (  u_ice_b(ji,jj)                                                   &
648                     &                                     + u_ice  (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0
649                     &                                    ) / ( zbetau + 1._wp )                                              &
650                     &             ) * 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
651                     &           )   * zmsk00x(ji,jj)
652               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
653                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity
654                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
655                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast
656                     &            + ( 1._wp - rswitch ) *   u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0
657                     &             ) * 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
658                     &           )   * zmsk00x(ji,jj)
659               ENDIF
660            END_2D
661#if defined key_mpi3
662            CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp )
663#else
664            CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp )
665#endif
666            !
667#if defined key_agrif
668!!            CALL agrif_interp_ice( 'U', jter, nn_nevp )
669            CALL agrif_interp_ice( 'U' )
670#endif
671            IF( ln_bdy )   CALL bdy_ice_dyn( 'U' )
672            !
673            DO_2D( 0, 0, 0, 0 )
674               !                 !--- tau_io/(v_oce - v_ice)
675               zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  &
676                  &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) )
677               !                 !--- Ocean-to-Ice stress
678               ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) )
679               !
680               !                 !--- tau_bottom/v_ice
681               zvel  = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) )
682               zTauB = ztauy_base(ji,jj) / zvel
683               !                 !--- OceanBottom-to-Ice stress
684               ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj)
685               !
686               !                 !--- Coriolis at v-points (energy conserving formulation)
687               zCorV(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  &
688                  &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  &
689                  &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) )
690               !
691               !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
692               zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj)
693               !
694               !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
695               !                                         1 = sliding friction : TauB < RHS
696               rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
697               !
698               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
699                  zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) )
700                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity
701                     &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
702                     &                                    ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
703                     &            + ( 1._wp - rswitch ) * (  v_ice_b(ji,jj)                                                   &
704                     &                                     + v_ice  (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0
705                     &                                    ) / ( zbetav + 1._wp )                                              & 
706                     &             ) * 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
707                     &           )   * zmsk00y(ji,jj)
708               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
709                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * v_ice(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) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast
712                     &            + ( 1._wp - rswitch ) *   v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0
713                     &             ) * 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
714                     &           )   * zmsk00y(ji,jj)
715               ENDIF
716            END_2D
717#if defined key_mpi3
718            CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp )
719#else
720            CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp )
721#endif
722            !
723#if defined key_agrif
724!!            CALL agrif_interp_ice( 'V', jter, nn_nevp )
725            CALL agrif_interp_ice( 'V' )
726#endif
727            IF( ln_bdy )   CALL bdy_ice_dyn( 'V' )
728            !
729         ENDIF
730
731         ! convergence test
732         IF( nn_rhg_chkcvg == 2 )   CALL rhg_cvg( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice )
733         !
734         !                                                ! ==================== !
735      END DO                                              !  end loop over jter  !
736      !                                                   ! ==================== !
737      IF( ln_aEVP )   CALL iom_put( 'beta_evp' , zbeta )
738      !
739      !------------------------------------------------------------------------------!
740      ! 4) Recompute delta, shear and div (inputs for mechanical redistribution)
741      !------------------------------------------------------------------------------!
742      DO_2D( 1, 0, 1, 0 )
743
744         ! shear at F points
745         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)   &
746            &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   &
747            &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)
748
749      END_2D
750     
751      DO_2D( 0, 0, 0, 0 )   ! no vector loop
752         
753         ! tension**2 at T points
754         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)   &
755            &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
756            &   ) * r1_e1e2t(ji,jj)
757         zdt2 = zdt * zdt
758         
759         ! shear**2 at T points (doc eq. A16)
760         zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  &
761            &   + 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)  &
762            &   ) * 0.25_wp * r1_e1e2t(ji,jj)
763         
764         ! shear at T points
765         pshear_i(ji,jj) = SQRT( zdt2 + zds2 )
766
767         ! divergence at T points
768         pdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
769            &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
770            &             ) * r1_e1e2t(ji,jj)
771         
772         ! delta at T points
773         zdelta(ji,jj)   = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 ) 
774         rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta(ji,jj) ) ) ! 0 if delta=0
775         pdelta_i(ji,jj) = zdelta(ji,jj) + rn_creepl * rswitch
776
777      END_2D
778#if defined key_mpi3
779      CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', pshear_i, 'T', 1.0_wp, pdivu_i, 'T', 1.0_wp, pdelta_i, 'T', 1.0_wp )
780#else
781      CALL lbc_lnk_multi( 'icedyn_rhg_evp', pshear_i, 'T', 1.0_wp, pdivu_i, 'T', 1.0_wp, pdelta_i, 'T', 1.0_wp )
782#endif
783     
784      ! --- Store the stress tensor for the next time step --- !
785#if defined key_mpi3
786      CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zs1, 'T', 1.0_wp, zs2, 'T', 1.0_wp, zs12, 'F', 1.0_wp )
787#else
788      CALL lbc_lnk_multi( 'icedyn_rhg_evp', zs1, 'T', 1.0_wp, zs2, 'T', 1.0_wp, zs12, 'F', 1.0_wp )
789#endif
790      pstress1_i (:,:) = zs1 (:,:)
791      pstress2_i (:,:) = zs2 (:,:)
792      pstress12_i(:,:) = zs12(:,:)
793      !
794
795      !------------------------------------------------------------------------------!
796      ! 5) diagnostics
797      !------------------------------------------------------------------------------!
798      ! --- ice-ocean, ice-atm. & ice-oceanbottom(landfast) stresses --- !
799      IF(  iom_use('utau_oi') .OR. iom_use('vtau_oi') .OR. iom_use('utau_ai') .OR. iom_use('vtau_ai') .OR. &
800         & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN
801         !
802#if defined key_mpi3
803         CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', ztaux_oi, 'U', -1.0_wp, ztauy_oi, 'V', -1.0_wp, ztaux_ai, 'U', -1.0_wp, ztauy_ai, 'V', -1.0_wp, &
804            &                                  ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp )
805#else
806         CALL lbc_lnk_multi( 'icedyn_rhg_evp', ztaux_oi, 'U', -1.0_wp, ztauy_oi, 'V', -1.0_wp, ztaux_ai, 'U', -1.0_wp, ztauy_ai, 'V', -1.0_wp, &
807            &                                  ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp )
808#endif
809         !
810         CALL iom_put( 'utau_oi' , ztaux_oi * zmsk00 )
811         CALL iom_put( 'vtau_oi' , ztauy_oi * zmsk00 )
812         CALL iom_put( 'utau_ai' , ztaux_ai * zmsk00 )
813         CALL iom_put( 'vtau_ai' , ztauy_ai * zmsk00 )
814         CALL iom_put( 'utau_bi' , ztaux_bi * zmsk00 )
815         CALL iom_put( 'vtau_bi' , ztauy_bi * zmsk00 )
816      ENDIF
817       
818      ! --- divergence, shear and strength --- !
819      IF( iom_use('icediv') )   CALL iom_put( 'icediv' , pdivu_i  * zmsk00 )   ! divergence
820      IF( iom_use('iceshe') )   CALL iom_put( 'iceshe' , pshear_i * zmsk00 )   ! shear
821      IF( iom_use('icestr') )   CALL iom_put( 'icestr' , strength * zmsk00 )   ! strength
822
823      ! --- stress tensor --- !
824      IF( iom_use('isig1') .OR. iom_use('isig2') .OR. iom_use('isig3') .OR. iom_use('normstr') .OR. iom_use('sheastr') ) THEN
825         !
826         ALLOCATE( zsig1(jpi,jpj) , zsig2(jpi,jpj) , zsig3(jpi,jpj) )
827         !         
828         DO_2D( 0, 0, 0, 0 )
829            zdum1 = ( zmsk00(ji-1,jj) * pstress12_i(ji-1,jj) + zmsk00(ji  ,jj-1) * pstress12_i(ji  ,jj-1) +  &  ! stress12_i at T-point
830               &      zmsk00(ji  ,jj) * pstress12_i(ji  ,jj) + zmsk00(ji-1,jj-1) * pstress12_i(ji-1,jj-1) )  &
831               &    / MAX( 1._wp, zmsk00(ji-1,jj) + zmsk00(ji,jj-1) + zmsk00(ji,jj) + zmsk00(ji-1,jj-1) )
832
833            zshear = SQRT( pstress2_i(ji,jj) * pstress2_i(ji,jj) + 4._wp * zdum1 * zdum1 ) ! shear stress 
834
835            zdum2 = zmsk00(ji,jj) / MAX( 1._wp, strength(ji,jj) )
836
837!!               zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) + zshear ) ! principal stress (y-direction, see Hunke & Dukowicz 2002)
838!!               zsig2(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) - zshear ) ! principal stress (x-direction, see Hunke & Dukowicz 2002)
839!!               zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 ) ! quadratic relation linking compressive stress to shear stress
840!!                                                                                                               ! (scheme converges if this value is ~1, see Bouillon et al 2009 (eq. 11))
841            zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) )          ! compressive stress, see Bouillon et al. 2015
842            zsig2(ji,jj) = 0.5_wp * zdum2 * ( zshear )                     ! shear stress
843            zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 )
844         END_2D
845#if defined key_mpi3
846         CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zsig1, 'T', 1.0_wp, zsig2, 'T', 1.0_wp, zsig3, 'T', 1.0_wp )
847#else
848         CALL lbc_lnk_multi( 'icedyn_rhg_evp', zsig1, 'T', 1.0_wp, zsig2, 'T', 1.0_wp, zsig3, 'T', 1.0_wp )
849#endif
850         !
851         CALL iom_put( 'isig1' , zsig1 )
852         CALL iom_put( 'isig2' , zsig2 )
853         CALL iom_put( 'isig3' , zsig3 )
854         !
855         ! Stress tensor invariants (normal and shear stress N/m)
856         IF( iom_use('normstr') )   CALL iom_put( 'normstr' ,       ( zs1(:,:) + zs2(:,:) )                       * zmsk00(:,:) ) ! Normal stress
857         IF( iom_use('sheastr') )   CALL iom_put( 'sheastr' , SQRT( ( zs1(:,:) - zs2(:,:) )**2 + 4*zs12(:,:)**2 ) * zmsk00(:,:) ) ! Shear stress
858
859         DEALLOCATE( zsig1 , zsig2 , zsig3 )
860      ENDIF
861
862      ! --- SIMIP --- !
863      IF(  iom_use('dssh_dx') .OR. iom_use('dssh_dy') .OR. &
864         & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN
865         !
866#if defined key_mpi3
867         CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zspgU, 'U', -1.0_wp, zspgV, 'V', -1.0_wp, &
868            &                                  zCorU, 'U', -1.0_wp, zCorV, 'V', -1.0_wp, zfU, 'U', -1.0_wp, zfV, 'V', -1.0_wp )
869#else
870         CALL lbc_lnk_multi( 'icedyn_rhg_evp', zspgU, 'U', -1.0_wp, zspgV, 'V', -1.0_wp, &
871            &                                  zCorU, 'U', -1.0_wp, zCorV, 'V', -1.0_wp, zfU, 'U', -1.0_wp, zfV, 'V', -1.0_wp )
872#endif
873
874         CALL iom_put( 'dssh_dx' , zspgU * zmsk00 )   ! Sea-surface tilt term in force balance (x)
875         CALL iom_put( 'dssh_dy' , zspgV * zmsk00 )   ! Sea-surface tilt term in force balance (y)
876         CALL iom_put( 'corstrx' , zCorU * zmsk00 )   ! Coriolis force term in force balance (x)
877         CALL iom_put( 'corstry' , zCorV * zmsk00 )   ! Coriolis force term in force balance (y)
878         CALL iom_put( 'intstrx' , zfU   * zmsk00 )   ! Internal force term in force balance (x)
879         CALL iom_put( 'intstry' , zfV   * zmsk00 )   ! Internal force term in force balance (y)
880      ENDIF
881
882      IF(  iom_use('xmtrpice') .OR. iom_use('ymtrpice') .OR. &
883         & iom_use('xmtrpsnw') .OR. iom_use('ymtrpsnw') .OR. iom_use('xatrp') .OR. iom_use('yatrp') ) THEN
884         !
885         ALLOCATE( zdiag_xmtrp_ice(jpi,jpj) , zdiag_ymtrp_ice(jpi,jpj) , &
886            &      zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp(jpi,jpj) , zdiag_yatrp(jpi,jpj) )
887         !
888         DO_2D( 0, 0, 0, 0 )
889            ! 2D ice mass, snow mass, area transport arrays (X, Y)
890            zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj)
891            zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj)
892
893            zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component
894            zdiag_ymtrp_ice(ji,jj) = rhoi * zfac_y * ( vt_i(ji,jj+1) + vt_i(ji,jj) ) !        ''           Y-   ''
895
896            zdiag_xmtrp_snw(ji,jj) = rhos * zfac_x * ( vt_s(ji+1,jj) + vt_s(ji,jj) ) ! snow mass transport, X-component
897            zdiag_ymtrp_snw(ji,jj) = rhos * zfac_y * ( vt_s(ji,jj+1) + vt_s(ji,jj) ) !          ''          Y-   ''
898
899            zdiag_xatrp(ji,jj)     = zfac_x * ( at_i(ji+1,jj) + at_i(ji,jj) )        ! area transport,      X-component
900            zdiag_yatrp(ji,jj)     = zfac_y * ( at_i(ji,jj+1) + at_i(ji,jj) )        !        ''            Y-   ''
901
902         END_2D
903
904#if defined key_mpi3
905         CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1.0_wp, zdiag_ymtrp_ice, 'V', -1.0_wp, &
906            &                                  zdiag_xmtrp_snw, 'U', -1.0_wp, zdiag_ymtrp_snw, 'V', -1.0_wp, &
907            &                                  zdiag_xatrp    , 'U', -1.0_wp, zdiag_yatrp    , 'V', -1.0_wp )
908#else
909         CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1.0_wp, zdiag_ymtrp_ice, 'V', -1.0_wp, &
910            &                                  zdiag_xmtrp_snw, 'U', -1.0_wp, zdiag_ymtrp_snw, 'V', -1.0_wp, &
911            &                                  zdiag_xatrp    , 'U', -1.0_wp, zdiag_yatrp    , 'V', -1.0_wp )
912#endif
913
914         CALL iom_put( 'xmtrpice' , zdiag_xmtrp_ice )   ! X-component of sea-ice mass transport (kg/s)
915         CALL iom_put( 'ymtrpice' , zdiag_ymtrp_ice )   ! Y-component of sea-ice mass transport
916         CALL iom_put( 'xmtrpsnw' , zdiag_xmtrp_snw )   ! X-component of snow mass transport (kg/s)
917         CALL iom_put( 'ymtrpsnw' , zdiag_ymtrp_snw )   ! Y-component of snow mass transport
918         CALL iom_put( 'xatrp'    , zdiag_xatrp     )   ! X-component of ice area transport
919         CALL iom_put( 'yatrp'    , zdiag_yatrp     )   ! Y-component of ice area transport
920
921         DEALLOCATE( zdiag_xmtrp_ice , zdiag_ymtrp_ice , &
922            &        zdiag_xmtrp_snw , zdiag_ymtrp_snw , zdiag_xatrp , zdiag_yatrp )
923
924      ENDIF
925      !
926      ! --- convergence tests --- !
927      IF( nn_rhg_chkcvg == 1 .OR. nn_rhg_chkcvg == 2 ) THEN
928         IF( iom_use('uice_cvg') ) THEN
929            IF( ln_aEVP ) THEN   ! output: beta * ( u(t=nn_nevp) - u(t=nn_nevp-1) )
930               CALL iom_put( 'uice_cvg', MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * zbeta(:,:) * umask(:,:,1) , &
931                  &                           ABS( v_ice(:,:) - zv_ice(:,:) ) * zbeta(:,:) * vmask(:,:,1) ) * zmsk15(:,:) )
932            ELSE                 ! output: nn_nevp * ( u(t=nn_nevp) - u(t=nn_nevp-1) )
933               CALL iom_put( 'uice_cvg', REAL( nn_nevp ) * MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * umask(:,:,1) , &
934                  &                                             ABS( v_ice(:,:) - zv_ice(:,:) ) * vmask(:,:,1) ) * zmsk15(:,:) )
935            ENDIF
936         ENDIF
937      ENDIF     
938      !
939      DEALLOCATE( zmsk00, zmsk15 )
940      !
941   END SUBROUTINE ice_dyn_rhg_evp
942
943
944   SUBROUTINE rhg_cvg( kt, kiter, kitermax, pu, pv, pub, pvb )
945      !!----------------------------------------------------------------------
946      !!                    ***  ROUTINE rhg_cvg  ***
947      !!                     
948      !! ** Purpose :   check convergence of oce rheology
949      !!
950      !! ** Method  :   create a file ice_cvg.nc containing the convergence of ice velocity
951      !!                during the sub timestepping of rheology so as:
952      !!                  uice_cvg = MAX( u(t+1) - u(t) , v(t+1) - v(t) )
953      !!                This routine is called every sub-iteration, so it is cpu expensive
954      !!
955      !! ** Note    :   for the first sub-iteration, uice_cvg is set to 0 (too large otherwise)   
956      !!----------------------------------------------------------------------
957      INTEGER ,                 INTENT(in) ::   kt, kiter, kitermax       ! ocean time-step index
958      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pu, pv, pub, pvb          ! now and before velocities
959      !!
960      INTEGER           ::   it, idtime, istatus
961      INTEGER           ::   ji, jj          ! dummy loop indices
962      REAL(wp)          ::   zresm           ! local real
963      CHARACTER(len=20) ::   clname
964      REAL(wp), DIMENSION(jpi,jpj) ::   zres           ! check convergence
965      !!----------------------------------------------------------------------
966
967      ! create file
968      IF( kt == nit000 .AND. kiter == 1 ) THEN
969         !
970         IF( lwp ) THEN
971            WRITE(numout,*)
972            WRITE(numout,*) 'rhg_cvg : ice rheology convergence control'
973            WRITE(numout,*) '~~~~~~~'
974         ENDIF
975         !
976         IF( lwm ) THEN
977            clname = 'ice_cvg.nc'
978            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
979            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, ncvgid )
980            istatus = NF90_DEF_DIM( ncvgid, 'time'  , NF90_UNLIMITED, idtime )
981            istatus = NF90_DEF_VAR( ncvgid, 'uice_cvg', NF90_DOUBLE   , (/ idtime /), nvarid )
982            istatus = NF90_ENDDEF(ncvgid)
983         ENDIF
984         !
985      ENDIF
986
987      ! time
988      it = ( kt - 1 ) * kitermax + kiter
989     
990      ! convergence
991      IF( kiter == 1 ) THEN ! remove the first iteration for calculations of convergence (always very large)
992         zresm = 0._wp
993      ELSE
994         DO_2D( 1, 1, 1, 1 )
995            zres(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), &
996               &               ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * zmsk15(ji,jj)
997         END_2D
998         zresm = MAXVAL( zres )
999         CALL mpp_max( 'icedyn_rhg_evp', zresm )   ! max over the global domain
1000      ENDIF
1001
1002      IF( lwm ) THEN
1003         ! write variables
1004         istatus = NF90_PUT_VAR( ncvgid, nvarid, (/zresm/), (/it/), (/1/) )
1005         ! close file
1006         IF( kt == nitend )   istatus = NF90_CLOSE(ncvgid)
1007      ENDIF
1008     
1009   END SUBROUTINE rhg_cvg
1010
1011
1012   SUBROUTINE rhg_evp_rst( cdrw, kt )
1013      !!---------------------------------------------------------------------
1014      !!                   ***  ROUTINE rhg_evp_rst  ***
1015      !!                     
1016      !! ** Purpose :   Read or write RHG file in restart file
1017      !!
1018      !! ** Method  :   use of IOM library
1019      !!----------------------------------------------------------------------
1020      CHARACTER(len=*) , INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
1021      INTEGER, OPTIONAL, INTENT(in) ::   kt     ! ice time-step
1022      !
1023      INTEGER  ::   iter            ! local integer
1024      INTEGER  ::   id1, id2, id3   ! local integers
1025      !!----------------------------------------------------------------------
1026      !
1027      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialize
1028         !                                   ! ---------------
1029         IF( ln_rstart ) THEN                   !* Read the restart file
1030            !
1031            id1 = iom_varid( numrir, 'stress1_i' , ldstop = .FALSE. )
1032            id2 = iom_varid( numrir, 'stress2_i' , ldstop = .FALSE. )
1033            id3 = iom_varid( numrir, 'stress12_i', ldstop = .FALSE. )
1034            !
1035            IF( MIN( id1, id2, id3 ) > 0 ) THEN      ! fields exist
1036               CALL iom_get( numrir, jpdom_auto, 'stress1_i' , stress1_i , cd_type = 'T' )
1037               CALL iom_get( numrir, jpdom_auto, 'stress2_i' , stress2_i , cd_type = 'T' )
1038               CALL iom_get( numrir, jpdom_auto, 'stress12_i', stress12_i, cd_type = 'F' )
1039            ELSE                                     ! start rheology from rest
1040               IF(lwp) WRITE(numout,*)
1041               IF(lwp) WRITE(numout,*) '   ==>>>   previous run without rheology, set stresses to 0'
1042               stress1_i (:,:) = 0._wp
1043               stress2_i (:,:) = 0._wp
1044               stress12_i(:,:) = 0._wp
1045            ENDIF
1046         ELSE                                   !* Start from rest
1047            IF(lwp) WRITE(numout,*)
1048            IF(lwp) WRITE(numout,*) '   ==>>>   start from rest: set stresses to 0'
1049            stress1_i (:,:) = 0._wp
1050            stress2_i (:,:) = 0._wp
1051            stress12_i(:,:) = 0._wp
1052         ENDIF
1053         !
1054      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
1055         !                                   ! -------------------
1056         IF(lwp) WRITE(numout,*) '---- rhg-rst ----'
1057         iter = kt + nn_fsbc - 1             ! ice restarts are written at kt == nitrst - nn_fsbc + 1
1058         !
1059         CALL iom_rstput( iter, nitrst, numriw, 'stress1_i' , stress1_i  )
1060         CALL iom_rstput( iter, nitrst, numriw, 'stress2_i' , stress2_i  )
1061         CALL iom_rstput( iter, nitrst, numriw, 'stress12_i', stress12_i )
1062         !
1063      ENDIF
1064      !
1065   END SUBROUTINE rhg_evp_rst
1066
1067   
1068#else
1069   !!----------------------------------------------------------------------
1070   !!   Default option         Empty module           NO SI3 sea-ice model
1071   !!----------------------------------------------------------------------
1072#endif
1073
1074   !!==============================================================================
1075END MODULE icedyn_rhg_evp
Note: See TracBrowser for help on using the repository browser.