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.
limrhg_2.F90 in branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_2 – NEMO

source: branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90 @ 7910

Last change on this file since 7910 was 7910, checked in by timgraham, 7 years ago

All wrk_alloc removed

  • Property svn:keywords set to Id
File size: 35.0 KB
RevLine 
[821]1MODULE limrhg_2
[3]2   !!======================================================================
[821]3   !!                     ***  MODULE  limrhg_2  ***
[3]4   !!   Ice rheology :  performs sea ice rheology
5   !!======================================================================
[2528]6   !! History :  0.0  !  1993-12  (M.A. Morales Maqueda.)  Original code
7   !!            1.0  !  1994-12  (H. Goosse)
8   !!            2.0  !  2003-12  (C. Ethe, G. Madec)  F90, mpp
9   !!             -   !  2006-08  (G. Madec)  surface module, ice-stress at I-point
10   !!             -   !  2009-09  (G. Madec)  Huge verctor optimisation
11   !!            3.3  !  2009-05  (G.Garric, C. Bricaud) addition of the lim2_evp case
[888]12   !!----------------------------------------------------------------------
[2528]13#if defined   key_lim2   &&   defined key_lim2_vp
[3]14   !!----------------------------------------------------------------------
[2528]15   !!   'key_lim2'                AND                   LIM-2 sea-ice model
16   !!   'key_lim2_vp'                                       VP ice rheology
[77]17   !!----------------------------------------------------------------------
[821]18   !!   lim_rhg_2   : computes ice velocities
[3]19   !!----------------------------------------------------------------------
[888]20   USE par_oce        ! ocean parameter
[1711]21   USE dom_oce        ! ocean space and time domain
22   USE sbc_oce        ! surface boundary condition: ocean variables
[888]23   USE sbc_ice        ! surface boundary condition: ice variables
[2528]24   USE dom_ice_2      ! LIM2: ice domain
[888]25   USE phycst         ! physical constant
[2528]26   USE ice_2          ! LIM2: ice variables
27   USE lbclnk         ! lateral boundary condition - MPP exchanges
[888]28   USE lib_mpp        ! MPP library
29   USE in_out_manager ! I/O manager
30   USE prtctl         ! Print control
[3625]31   USE oce     , ONLY : snwice_mass, snwice_mass_b
32   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
[3680]33#if defined key_agrif
34   USE agrif_lim2_interp ! nesting
35#endif
[3]36
37   IMPLICIT NONE
38   PRIVATE
39
[2715]40   PUBLIC   lim_rhg_2         ! routine called by lim_dyn
[3]41
[2528]42   REAL(wp) ::   rzero   = 0._wp   ! constant value: zero
43   REAL(wp) ::   rone    = 1._wp   !            and  one
[888]44
45   !! * Substitutions
46#  include "vectopt_loop_substitute.h90"
[3]47   !!----------------------------------------------------------------------
[2528]48   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
[1156]49   !! $Id$
[2528]50   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
[3]51   !!----------------------------------------------------------------------
52CONTAINS
53
[821]54   SUBROUTINE lim_rhg_2( k_j1, k_jpj )
[3]55      !!-------------------------------------------------------------------
[821]56      !!                 ***  SUBROUTINR lim_rhg_2  ***
[77]57      !!
[12]58      !! ** purpose :   determines the velocity field of sea ice by using
59      !!  atmospheric (wind stress) and oceanic (water stress and surface
60      !!  tilt) forcings. Ice-ice interaction is described by a non-linear
[391]61      !!  viscous-plastic law including shear strength and a bulk rheology.
[3]62      !!
[1470]63      !! ** Action  : - compute u_ice, v_ice the sea-ice velocity defined
[888]64      !!              at I-point
65      !!-------------------------------------------------------------------
66      INTEGER, INTENT(in) ::   k_j1    ! southern j-index for ice computation
67      INTEGER, INTENT(in) ::   k_jpj   ! northern j-index for ice computation
[719]68      !!
[12]69      INTEGER ::   ji, jj              ! dummy loop indices
[888]70      INTEGER ::   iter, jter          ! temporary integers
71      CHARACTER (len=50) ::   charout
[2528]72      REAL(wp) ::   ze11  , ze12  , ze22  , ze21               ! local scalars
73      REAL(wp) ::   zt11  , zt12  , zt21  , zt22               !   -      -
74      REAL(wp) ::   zvis11, zvis21, zvis12, zvis22             !   -      -
75      REAL(wp) ::   zgphsx, ztagnx, zgsshx, zunw, zur, zusw    !   -      -
76      REAL(wp) ::   zgphsy, ztagny, zgsshy, zvnw, zvr          !   -      -
[888]77      REAL(wp) ::   zresm,  za, zac, zmod
78      REAL(wp) ::   zmpzas, zstms, zindu, zusdtp, zmassdt, zcorlal
79      REAL(wp) ::   ztrace2, zdeter, zdelta, zmask, zdgp, zdgi, zdiag
80      REAL(wp) ::   za1, zb1, zc1, zd1
81      REAL(wp) ::   za2, zb2, zc2, zd2, zden
82      REAL(wp) ::   zs11_11, zs11_12, zs11_21, zs11_22
83      REAL(wp) ::   zs12_11, zs12_12, zs12_21, zs12_22
84      REAL(wp) ::   zs21_11, zs21_12, zs21_21, zs21_22
85      REAL(wp) ::   zs22_11, zs22_12, zs22_21, zs22_22
[3625]86      REAL(wp) ::   zintb, zintn
[7910]87      REAL(wp), DIMENSION(jpi,jpj) ::   zfrld, zmass, zcorl
88      REAL(wp), DIMENSION(jpi,jpj) ::   za1ct, za2ct, zresr
89      REAL(wp), DIMENSION(jpi,jpj) ::   zc1u, zc1v, zc2u, zc2v
90      REAL(wp), DIMENSION(jpi,jpj) ::   zsang, zpice
91      REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zu0, zv0
92      REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zu_n, zv_n
93      REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zu_a, zv_a
94      REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zviszeta, zviseta
95      REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zzfrld, zztms
96      REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zi1, zi2, zmasst, zpresh
[888]97      !!-------------------------------------------------------------------
[3]98     
[3294]99
[77]100      !  Store initial velocities
[888]101      !  ----------------
[2528]102      zztms(:,0    ) = 0._wp        ;   zzfrld(:,0    ) = 0._wp
103      zztms(:,jpj+1) = 0._wp        ;   zzfrld(:,jpj+1) = 0._wp
104      zu0  (:,0    ) = 0._wp        ;   zv0   (:,0    ) = 0._wp
105      zu0  (:,jpj+1) = 0._wp        ;   zv0   (:,jpj+1) = 0._wp
106      zztms(:,1:jpj) = tms  (:,:)   ;   zzfrld(:,1:jpj) = frld (:,:)
107      zu0  (:,1:jpj) = u_ice(:,:)   ;   zv0   (:,1:jpj) = v_ice(:,:)
108      zu_a (:, :   ) = zu0  (:,:)   ;   zv_a  (:, :   ) = zv0  (:,:)
109      zu_n (:, :   ) = zu0  (:,:)   ;   zv_n  (:, :   ) = zv0  (:,:)
[3]110
[888]111!i
[2528]112      zi1   (:,:) = 0._wp
113      zi2   (:,:) = 0._wp
114      zpresh(:,:) = 0._wp
115      zmasst(:,:) = 0._wp
[888]116!i
117!!gm violant
[2528]118      zfrld(:,:) =0._wp
119      zcorl(:,:) =0._wp
120      zmass(:,:) =0._wp
121      za1ct(:,:) =0._wp
122      za2ct(:,:) =0._wp
[888]123!!gm end
124
[2528]125      zviszeta(:,:) = 0._wp
126      zviseta (:,:) = 0._wp
[888]127
[2528]128!i    zviszeta(:,0    ) = 0._wp    ;    zviseta(:,0    ) = 0._wp
129!i    zviszeta(:,jpj  ) = 0._wp    ;    zviseta(:,jpj  ) = 0._wp
130!i    zviszeta(:,jpj+1) = 0._wp    ;    zviseta(:,jpj+1) = 0._wp
[888]131
[3625]132      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==!
133          !
134          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1}
135          !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1}
136         zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp
137          !
138          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1}
139          !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1})
140         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp
141          !
142         zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:)  ) * r1_rau0
143          !
144         !
145      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==!
146         zpice(:,:) = ssh_m(:,:)
147      ENDIF
[3680]148#if defined key_agrif
149      ! load the boundary value of velocity in special array zuive and zvice
150      CALL agrif_rhg_lim2_load
151#endif
[888]152
[717]153      ! Ice mass, ice strength, and wind stress at the center            |
154      ! of the grid squares.                                             |
[77]155      !-------------------------------------------------------------------
[3]156
[77]157      DO jj = k_j1 , k_jpj-1
[3]158         DO ji = 1 , jpi
[888]159            ! only the sinus changes its sign with the hemisphere
[7646]160            zsang(ji,jj)  = SIGN( 1._wp, ff_t(ji,jj) ) * sangvg   ! only the sinus changes its sign with the hemisphere
[888]161            !
162            zmasst(ji,jj) = tms(ji,jj) * ( rhosn * hsnm(ji,jj) + rhoic * hicm(ji,jj) )
[3]163            zpresh(ji,jj) = tms(ji,jj) *  pstarh * hicm(ji,jj) * EXP( -c_rhg * frld(ji,jj) )
[888]164!!gm  :: stress given at I-point (F-point for the ocean) only compute the ponderation with the ice fraction (1-frld)
[2528]165            zi1(ji,jj)    = tms(ji,jj) * ( 1._wp - frld(ji,jj) )
166            zi2(ji,jj)    = tms(ji,jj) * ( 1._wp - frld(ji,jj) )
[3]167         END DO
168      END DO
169
[717]170
[3]171      !---------------------------------------------------------------------------
[717]172      !  Wind stress, coriolis and mass terms at the corners of the grid squares |
173      !  Gradient of ice strenght.                                               |
174      !---------------------------------------------------------------------------
[3]175         
[77]176      DO jj = k_j1+1, k_jpj-1
[1774]177         DO ji = 2, jpi    ! NO vector opt.
[888]178            zstms = zztms(ji,jj  ) * wght(ji,jj,2,2) + zztms(ji-1,jj  ) * wght(ji,jj,1,2)   &
179               &  + zztms(ji,jj-1) * wght(ji,jj,2,1) + zztms(ji-1,jj-1) * wght(ji,jj,1,1)
[2528]180            zusw  = 1._wp / MAX( zstms, epsd )
[3]181
[888]182            zt11 = zztms(ji  ,jj  ) * zzfrld(ji  ,jj  ) 
183            zt12 = zztms(ji-1,jj  ) * zzfrld(ji-1,jj  ) 
184            zt21 = zztms(ji  ,jj-1) * zzfrld(ji  ,jj-1) 
185            zt22 = zztms(ji-1,jj-1) * zzfrld(ji-1,jj-1)
[3]186
[717]187            ! Leads area.
188            zfrld(ji,jj) =  (  zt11 * wght(ji,jj,2,2) + zt12 * wght(ji,jj,1,2)   &
189               &             + zt21 * wght(ji,jj,2,1) + zt22 * wght(ji,jj,1,1) ) * zusw
[3]190
[888]191            ! Mass and coriolis coeff. at I-point
192            zmass(ji,jj) = ( zmasst(ji,jj  ) * wght(ji,jj,2,2) + zmasst(ji-1,jj  ) * wght(ji,jj,1,2)   &
193               &           + zmasst(ji,jj-1) * wght(ji,jj,2,1) + zmasst(ji-1,jj-1) * wght(ji,jj,1,1) ) * zusw
[1569]194            zcorl(ji,jj) = zmass(ji,jj) &
[7646]195               &           *( ff_t(ji,jj  ) * wght(ji,jj,2,2) + ff_t(ji-1,jj  )*wght(ji,jj,1,2)   &
196               &            + ff_t(ji,jj-1) * wght(ji,jj,2,1) + ff_t(ji-1,jj-1)*wght(ji,jj,1,1) ) * zusw
[717]197
[700]198            ! Wind stress.
[1469]199            ! always provide stress at I-point
[888]200            ztagnx = ( zi1(ji,jj  ) * wght(ji,jj,2,2) + zi1(ji-1,jj  ) * wght(ji,jj,1,2)   &
[1469]201               &     + zi1(ji,jj-1) * wght(ji,jj,2,1) + zi1(ji-1,jj-1) * wght(ji,jj,1,1) ) * zusw * utau_ice(ji,jj)
[888]202            ztagny = ( zi2(ji,jj  ) * wght(ji,jj,2,2) + zi2(ji-1,jj  ) * wght(ji,jj,1,2)   &
[1469]203               &     + zi2(ji,jj-1) * wght(ji,jj,2,1) + zi2(ji-1,jj-1) * wght(ji,jj,1,1) ) * zusw * vtau_ice(ji,jj)
[700]204
[3]205            ! Gradient of ice strength
206            zgphsx =   ( alambd(ji,jj,2,2,2,1) - alambd(ji,jj,2,1,2,1) ) * zpresh(ji  ,jj-1)   &
207               &     + ( alambd(ji,jj,2,2,2,2) - alambd(ji,jj,2,1,2,2) ) * zpresh(ji  ,jj  )   &
208               &     - ( alambd(ji,jj,2,2,1,1) + alambd(ji,jj,2,1,1,1) ) * zpresh(ji-1,jj-1)   &
209               &     - ( alambd(ji,jj,2,2,1,2) + alambd(ji,jj,2,1,1,2) ) * zpresh(ji-1,jj  )
210
211            zgphsy = - ( alambd(ji,jj,1,1,2,1) + alambd(ji,jj,1,2,2,1) ) * zpresh(ji  ,jj-1)   &
212               &     - ( alambd(ji,jj,1,1,1,1) + alambd(ji,jj,1,2,1,1) ) * zpresh(ji-1,jj-1)   &
213               &     + ( alambd(ji,jj,1,1,2,2) - alambd(ji,jj,1,2,2,2) ) * zpresh(ji  ,jj  )   &
214               &     + ( alambd(ji,jj,1,1,1,2) - alambd(ji,jj,1,2,1,2) ) * zpresh(ji-1,jj  )
215
[1711]216            ! Gradient of the sea surface height
[3625]217            zgsshx =  (   (zpice(ji  ,jj  ) - zpice(ji-1,jj  ))/e1u(ji-1,jj  )   &
218               &       +  (zpice(ji  ,jj-1) - zpice(ji-1,jj-1))/e1u(ji-1,jj-1)   ) * 0.5_wp
219            zgsshy =  (   (zpice(ji  ,jj  ) - zpice(ji  ,jj-1))/e2v(ji  ,jj-1)   &
220               &       +  (zpice(ji-1,jj  ) - zpice(ji-1,jj-1))/e2v(ji-1,jj-1)   ) * 0.5_wp
[1711]221
[3]222            ! Computation of the velocity field taking into account the ice-ice interaction.                                 
[888]223            ! Terms that are independent of the ice velocity field.
[1711]224            za1ct(ji,jj) = ztagnx - zmass(ji,jj) * grav * zgsshx - zgphsx
225            za2ct(ji,jj) = ztagny - zmass(ji,jj) * grav * zgsshy - zgphsy
[3]226         END DO
227      END DO
228
229
230      ! SOLUTION OF THE MOMENTUM EQUATION.
231      !------------------------------------------
232      !                                                   ! ==================== !
233      DO iter = 1 , 2 * nbiter                            !    loop over iter    !
234         !                                                ! ==================== !       
235         zindu = MOD( iter , 2 )
[2528]236         zusdtp = ( zindu * 2._wp + ( 1._wp - zindu ) * 1._wp )  * REAL( nbiter ) / rdt_ice
[3]237
238         ! Computation of free drift field for free slip boundary conditions.
239
[888]240         DO jj = k_j1, k_jpj-1
241            DO ji = 1, fs_jpim1
242               !- Rate of strain tensor.
243               zt11 =   akappa(ji,jj,1,1) * ( zu_a(ji+1,jj) + zu_a(ji+1,jj+1) - zu_a(ji,jj  ) - zu_a(ji  ,jj+1) )  &
244                  &   + akappa(ji,jj,1,2) * ( zv_a(ji+1,jj) + zv_a(ji+1,jj+1) + zv_a(ji,jj  ) + zv_a(ji  ,jj+1) )
245               zt12 = - akappa(ji,jj,2,2) * ( zu_a(ji  ,jj) + zu_a(ji+1,jj  ) - zu_a(ji,jj+1) - zu_a(ji+1,jj+1) )  &
246                  &   - akappa(ji,jj,2,1) * ( zv_a(ji  ,jj) + zv_a(ji+1,jj  ) + zv_a(ji,jj+1) + zv_a(ji+1,jj+1) )
247               zt22 = - akappa(ji,jj,2,2) * ( zv_a(ji  ,jj) + zv_a(ji+1,jj  ) - zv_a(ji,jj+1) - zv_a(ji+1,jj+1) )  &
248                  &   + akappa(ji,jj,2,1) * ( zu_a(ji  ,jj) + zu_a(ji+1,jj  ) + zu_a(ji,jj+1) + zu_a(ji+1,jj+1) )
249               zt21 =   akappa(ji,jj,1,1) * ( zv_a(ji+1,jj) + zv_a(ji+1,jj+1) - zv_a(ji,jj  ) - zv_a(ji  ,jj+1) )  &
250                  &   - akappa(ji,jj,1,2) * ( zu_a(ji+1,jj) + zu_a(ji+1,jj+1) + zu_a(ji,jj  ) + zu_a(ji  ,jj+1) )
[3]251
[888]252               !- Rate of strain tensor.
253               zdgp = zt11 + zt22
254               zdgi = zt12 + zt21
255               ztrace2 = zdgp * zdgp 
[2528]256               zdeter  = zt11 * zt22 - 0.25_wp * zdgi * zdgi
[3]257
[888]258               !  Creep limit depends on the size of the grid.
[5123]259               zdelta = MAX( SQRT( ztrace2 + ( ztrace2 - 4._wp * zdeter ) * usecc2 ),  rn_creepl)
[3]260
[888]261               !-  Computation of viscosities.
262               zviszeta(ji,jj) = MAX( zpresh(ji,jj) / zdelta, etamn )
263               zviseta (ji,jj) = zviszeta(ji,jj) * usecc2
264            END DO
265         END DO
[3]266
[888]267         !-  Determination of zc1u, zc2u, zc1v and zc2v.
268         DO jj = k_j1+1, k_jpj-1
[1347]269            DO ji = 2, fs_jpim1   ! NO vector opt.
[888]270               !* zc1u , zc2v
[2528]271               zvis11 = 2._wp * zviseta (ji-1,jj-1) + dm
272               zvis12 =         zviseta (ji-1,jj-1) + dm
273               zvis21 =         zviseta (ji-1,jj-1)
274               zvis22 =         zviszeta(ji-1,jj-1) - zviseta(ji-1,jj-1)
[888]275               zdiag  = zvis22 * ( akappa(ji-1,jj-1,1,1) + akappa(ji-1,jj-1,2,1) )
276               zs11_11 =  zvis11 * akappa(ji-1,jj-1,1,1) + zdiag
277               zs12_11 =  zvis12 * akappa(ji-1,jj-1,2,2) - zvis21 * akappa(ji-1,jj-1,1,2)
278               zs21_11 = -zvis12 * akappa(ji-1,jj-1,1,2) + zvis21 * akappa(ji-1,jj-1,2,2)
279               zs22_11 =  zvis11 * akappa(ji-1,jj-1,2,1) + zdiag
[3]280
[2528]281               zvis11 = 2._wp * zviseta (ji,jj-1) + dm
282               zvis22 =         zviszeta(ji,jj-1) - zviseta(ji,jj-1)
283               zvis12 =         zviseta (ji,jj-1) + dm
284               zvis21 =         zviseta (ji,jj-1)
[888]285               zdiag = zvis22 * ( -akappa(ji,jj-1,1,1) + akappa(ji,jj-1,2,1) )
286               zs11_21 = -zvis11 * akappa(ji,jj-1,1,1) + zdiag
287               zs12_21 =  zvis12 * akappa(ji,jj-1,2,2) - zvis21 * akappa(ji,jj-1,1,2)
288               zs22_21 =  zvis11 * akappa(ji,jj-1,2,1) + zdiag
289               zs21_21 = -zvis12 * akappa(ji,jj-1,1,2) + zvis21 * akappa(ji,jj-1,2,2)
[3]290
[2528]291               zvis11 = 2._wp * zviseta (ji-1,jj) + dm
292               zvis22 =         zviszeta(ji-1,jj) - zviseta(ji-1,jj)
293               zvis12 =         zviseta (ji-1,jj) + dm
294               zvis21 =         zviseta (ji-1,jj)
295               zdiag  = zvis22 * ( akappa(ji-1,jj,1,1) + akappa(ji-1,jj,2,1) )
[888]296               zs11_12 =  zvis11 * akappa(ji-1,jj,1,1) + zdiag
297               zs12_12 = -zvis12 * akappa(ji-1,jj,2,2) - zvis21 * akappa(ji-1,jj,1,2)
298               zs22_12 =  zvis11 * akappa(ji-1,jj,2,1) + zdiag
299               zs21_12 = -zvis12 * akappa(ji-1,jj,1,2) - zvis21 * akappa(ji-1,jj,2,2)
[3]300
[2528]301               zvis11 = 2._wp * zviseta (ji,jj) + dm
302               zvis22 =         zviszeta(ji,jj) - zviseta(ji,jj)
303               zvis12 =         zviseta (ji,jj) + dm
304               zvis21 =         zviseta (ji,jj)
[888]305               zdiag = zvis22 * ( -akappa(ji,jj,1,1) + akappa(ji,jj,2,1) )
306               zs11_22 = -zvis11 * akappa(ji,jj,1,1) + zdiag
307               zs12_22 = -zvis12 * akappa(ji,jj,2,2) - zvis21 * akappa(ji,jj,1,2)
308               zs22_22 =  zvis11 * akappa(ji,jj,2,1) + zdiag
309               zs21_22 = -zvis12 * akappa(ji,jj,1,2) - zvis21 * akappa(ji,jj,2,2)
[3]310
[888]311               zc1u(ji,jj) = + alambd(ji,jj,2,2,2,1) * zs11_21 + alambd(ji,jj,2,2,2,2) * zs11_22   &
312                  &          - alambd(ji,jj,2,2,1,1) * zs11_11 - alambd(ji,jj,2,2,1,2) * zs11_12   &
313                  &          - alambd(ji,jj,1,1,2,1) * zs12_21 - alambd(ji,jj,1,1,1,1) * zs12_11   &
314                  &          + alambd(ji,jj,1,1,2,2) * zs12_22 + alambd(ji,jj,1,1,1,2) * zs12_12   &
315                  &          + alambd(ji,jj,1,2,1,1) * zs21_11 + alambd(ji,jj,1,2,2,1) * zs21_21   &
316                  &          + alambd(ji,jj,1,2,1,2) * zs21_12 + alambd(ji,jj,1,2,2,2) * zs21_22   &
317                  &          - alambd(ji,jj,2,1,1,1) * zs22_11 - alambd(ji,jj,2,1,2,1) * zs22_21   &
318                  &          - alambd(ji,jj,2,1,1,2) * zs22_12 - alambd(ji,jj,2,1,2,2) * zs22_22
[3]319
[888]320               zc2u(ji,jj) = + alambd(ji,jj,2,2,2,1) * zs21_21 + alambd(ji,jj,2,2,2,2) * zs21_22   &
321                  &          - alambd(ji,jj,2,2,1,1) * zs21_11 - alambd(ji,jj,2,2,1,2) * zs21_12   &
322                  &          - alambd(ji,jj,1,1,2,1) * zs22_21 - alambd(ji,jj,1,1,1,1) * zs22_11   &
323                  &          + alambd(ji,jj,1,1,2,2) * zs22_22 + alambd(ji,jj,1,1,1,2) * zs22_12   &
324                  &          - alambd(ji,jj,1,2,1,1) * zs11_11 - alambd(ji,jj,1,2,2,1) * zs11_21   &
325                  &          - alambd(ji,jj,1,2,1,2) * zs11_12 - alambd(ji,jj,1,2,2,2) * zs11_22   &
326                  &          + alambd(ji,jj,2,1,1,1) * zs12_11 + alambd(ji,jj,2,1,2,1) * zs12_21   &
327                  &          + alambd(ji,jj,2,1,1,2) * zs12_12 + alambd(ji,jj,2,1,2,2) * zs12_22
[3]328
[888]329               !* zc1v , zc2v.
[2528]330               zvis11 = 2._wp * zviseta (ji-1,jj-1) + dm
331               zvis22 =         zviszeta(ji-1,jj-1) - zviseta(ji-1,jj-1)
332               zvis12 =         zviseta (ji-1,jj-1) + dm
333               zvis21 =         zviseta (ji-1,jj-1)
[888]334               zdiag = zvis22 * ( akappa(ji-1,jj-1,1,2) + akappa(ji-1,jj-1,2,2) )
335               zs11_11 =  zvis11 * akappa(ji-1,jj-1,1,2) + zdiag
336               zs12_11 = -zvis12 * akappa(ji-1,jj-1,2,1) + zvis21 * akappa(ji-1,jj-1,1,1)
337               zs22_11 =  zvis11 * akappa(ji-1,jj-1,2,2) + zdiag
338               zs21_11 =  zvis12 * akappa(ji-1,jj-1,1,1) - zvis21 * akappa(ji-1,jj-1,2,1)
[3]339 
[2528]340               zvis11 = 2._wp * zviseta (ji,jj-1) + dm
341               zvis22 =         zviszeta(ji,jj-1) - zviseta(ji,jj-1)
342               zvis12 =         zviseta (ji,jj-1) + dm
343               zvis21 =         zviseta (ji,jj-1)
[888]344               zdiag = zvis22 * ( akappa(ji,jj-1,1,2) + akappa(ji,jj-1,2,2) )
345               zs11_21 =  zvis11 * akappa(ji,jj-1,1,2) + zdiag
346               zs12_21 = -zvis12 * akappa(ji,jj-1,2,1) - zvis21 * akappa(ji,jj-1,1,1)
347               zs22_21 =  zvis11 * akappa(ji,jj-1,2,2) + zdiag
348               zs21_21 = -zvis12 * akappa(ji,jj-1,1,1) - zvis21 * akappa(ji,jj-1,2,1)
[3]349
[2528]350               zvis11 = 2._wp * zviseta (ji-1,jj) + dm
351               zvis22 =         zviszeta(ji-1,jj) - zviseta(ji-1,jj)
352               zvis12 =         zviseta (ji-1,jj) + dm
353               zvis21 =         zviseta (ji-1,jj)
[888]354               zdiag = zvis22 * ( akappa(ji-1,jj,1,2) - akappa(ji-1,jj,2,2) )
355               zs11_12 =  zvis11 * akappa(ji-1,jj,1,2) + zdiag
356               zs12_12 = -zvis12 * akappa(ji-1,jj,2,1) + zvis21 * akappa(ji-1,jj,1,1)
357               zs22_12 = -zvis11 * akappa(ji-1,jj,2,2) + zdiag
358               zs21_12 =  zvis12 * akappa(ji-1,jj,1,1) - zvis21 * akappa(ji-1,jj,2,1)
[3]359
[2528]360               zvis11 = 2._wp * zviseta (ji,jj) + dm
361               zvis22 =         zviszeta(ji,jj) - zviseta(ji,jj)
362               zvis12 =         zviseta (ji,jj) + dm
363               zvis21 =         zviseta (ji,jj)
[888]364               zdiag = zvis22 * ( akappa(ji,jj,1,2) - akappa(ji,jj,2,2) )
365               zs11_22 =  zvis11 * akappa(ji,jj,1,2) + zdiag
366               zs12_22 = -zvis12 * akappa(ji,jj,2,1) - zvis21 * akappa(ji,jj,1,1)
367               zs22_22 = -zvis11 * akappa(ji,jj,2,2) + zdiag
368               zs21_22 = -zvis12 * akappa(ji,jj,1,1) - zvis21 * akappa(ji,jj,2,1)
[3]369
[888]370               zc1v(ji,jj) = + alambd(ji,jj,2,2,2,1) * zs11_21 + alambd(ji,jj,2,2,2,2) * zs11_22   &
371                  &          - alambd(ji,jj,2,2,1,1) * zs11_11 - alambd(ji,jj,2,2,1,2) * zs11_12   &
372                  &          - alambd(ji,jj,1,1,2,1) * zs12_21 - alambd(ji,jj,1,1,1,1) * zs12_11   &
373                  &          + alambd(ji,jj,1,1,2,2) * zs12_22 + alambd(ji,jj,1,1,1,2) * zs12_12   &
374                  &          + alambd(ji,jj,1,2,1,1) * zs21_11 + alambd(ji,jj,1,2,2,1) * zs21_21   &
375                  &          + alambd(ji,jj,1,2,1,2) * zs21_12 + alambd(ji,jj,1,2,2,2) * zs21_22   &
376                  &          - alambd(ji,jj,2,1,1,1) * zs22_11 - alambd(ji,jj,2,1,2,1) * zs22_21   &
377                  &          - alambd(ji,jj,2,1,1,2) * zs22_12 - alambd(ji,jj,2,1,2,2) * zs22_22
[3]378
[888]379               zc2v(ji,jj) = + alambd(ji,jj,2,2,2,1) * zs21_21 + alambd(ji,jj,2,2,2,2) * zs21_22   &
380                  &          - alambd(ji,jj,2,2,1,1) * zs21_11 - alambd(ji,jj,2,2,1,2) * zs21_12   &
381                  &          - alambd(ji,jj,1,1,2,1) * zs22_21 - alambd(ji,jj,1,1,1,1) * zs22_11   &
382                  &          + alambd(ji,jj,1,1,2,2) * zs22_22 + alambd(ji,jj,1,1,1,2) * zs22_12   &
383                  &          - alambd(ji,jj,1,2,1,1) * zs11_11 - alambd(ji,jj,1,2,2,1) * zs11_21   &
384                  &          - alambd(ji,jj,1,2,1,2) * zs11_12 - alambd(ji,jj,1,2,2,2) * zs11_22   &
385                  &          + alambd(ji,jj,2,1,1,1) * zs12_11 + alambd(ji,jj,2,1,2,1) * zs12_21   &
386                  &          + alambd(ji,jj,2,1,1,2) * zs12_12 + alambd(ji,jj,2,1,2,2) * zs12_22
[3]387            END DO
[888]388         END DO
[3]389
[888]390         ! GAUSS-SEIDEL method
391         !                                                      ! ================ !
392iflag:   DO jter = 1 , nbitdr                                   !    Relaxation    !
393            !                                                   ! ================ !
[77]394            DO jj = k_j1+1, k_jpj-1
[1347]395               DO ji = 2, fs_jpim1   ! NO vector opt.
[888]396                  !
397                  ze11 =   akappa(ji,jj-1,1,1) * zu_a(ji+1,jj) + akappa(ji,jj-1,1,2) * zv_a(ji+1,jj)
398                  ze12 = + akappa(ji,jj-1,2,2) * zu_a(ji+1,jj) - akappa(ji,jj-1,2,1) * zv_a(ji+1,jj)
399                  ze22 = + akappa(ji,jj-1,2,2) * zv_a(ji+1,jj) + akappa(ji,jj-1,2,1) * zu_a(ji+1,jj)
400                  ze21 =   akappa(ji,jj-1,1,1) * zv_a(ji+1,jj) - akappa(ji,jj-1,1,2) * zu_a(ji+1,jj)
[2528]401                  zvis11 = 2._wp * zviseta (ji,jj-1) + dm
402                  zvis22 =         zviszeta(ji,jj-1) - zviseta(ji,jj-1)
403                  zvis12 =         zviseta (ji,jj-1) + dm
404                  zvis21 =         zviseta (ji,jj-1)
[3]405                  zdiag = zvis22 * ( ze11 + ze22 )
[888]406                  zs11_21 =  zvis11 * ze11 + zdiag
407                  zs12_21 =  zvis12 * ze12 + zvis21 * ze21
408                  zs22_21 =  zvis11 * ze22 + zdiag
409                  zs21_21 =  zvis12 * ze21 + zvis21 * ze12
[3]410
[888]411                  ze11 =   akappa(ji-1,jj,1,1) * ( zu_a(ji  ,jj+1) - zu_a(ji-1,jj+1) )   &
412                     &   + akappa(ji-1,jj,1,2) * ( zv_a(ji  ,jj+1) + zv_a(ji-1,jj+1) )
413                  ze12 = + akappa(ji-1,jj,2,2) * ( zu_a(ji-1,jj+1) + zu_a(ji  ,jj+1) )   &
414                     &   - akappa(ji-1,jj,2,1) * ( zv_a(ji-1,jj+1) + zv_a(ji  ,jj+1) )
415                  ze22 = + akappa(ji-1,jj,2,2) * ( zv_a(ji-1,jj+1) + zv_a(ji  ,jj+1) )   &
416                     &   + akappa(ji-1,jj,2,1) * ( zu_a(ji-1,jj+1) + zu_a(ji  ,jj+1) )
417                  ze21 =   akappa(ji-1,jj,1,1) * ( zv_a(ji  ,jj+1) - zv_a(ji-1,jj+1) )   &
418                     &   - akappa(ji-1,jj,1,2) * ( zu_a(ji  ,jj+1) + zu_a(ji-1,jj+1) )
[2528]419                  zvis11 = 2._wp * zviseta (ji-1,jj) + dm
420                  zvis22 =         zviszeta(ji-1,jj) - zviseta(ji-1,jj)
421                  zvis12 =         zviseta (ji-1,jj) + dm
422                  zvis21 =         zviseta (ji-1,jj)
[3]423                  zdiag = zvis22 * ( ze11 + ze22 )
[888]424                  zs11_12 =  zvis11 * ze11 + zdiag
425                  zs12_12 =  zvis12 * ze12 + zvis21 * ze21
426                  zs22_12 =  zvis11 * ze22 + zdiag
427                  zs21_12 =  zvis12 * ze21 + zvis21 * ze12
[3]428
[888]429                  ze11 =   akappa(ji,jj,1,1) * ( zu_a(ji+1,jj) + zu_a(ji+1,jj+1) - zu_a(ji  ,jj+1) )   &
430                     &   + akappa(ji,jj,1,2) * ( zv_a(ji+1,jj) + zv_a(ji+1,jj+1) + zv_a(ji  ,jj+1) )
431                  ze12 = - akappa(ji,jj,2,2) * ( zu_a(ji+1,jj) - zu_a(ji  ,jj+1) - zu_a(ji+1,jj+1) )   &
432                     &   - akappa(ji,jj,2,1) * ( zv_a(ji+1,jj) + zv_a(ji  ,jj+1) + zv_a(ji+1,jj+1) )
433                  ze22 = - akappa(ji,jj,2,2) * ( zv_a(ji+1,jj) - zv_a(ji  ,jj+1) - zv_a(ji+1,jj+1) )   &
434                     &   + akappa(ji,jj,2,1) * ( zu_a(ji+1,jj) + zu_a(ji  ,jj+1) + zu_a(ji+1,jj+1) )
435                  ze21 =   akappa(ji,jj,1,1) * ( zv_a(ji+1,jj) + zv_a(ji+1,jj+1) - zv_a(ji  ,jj+1) )   &
436                     &   - akappa(ji,jj,1,2) * ( zu_a(ji+1,jj) + zu_a(ji+1,jj+1) + zu_a(ji  ,jj+1) )
[2528]437                  zvis11 = 2._wp * zviseta (ji,jj) + dm
438                  zvis22 =         zviszeta(ji,jj) - zviseta(ji,jj)
439                  zvis12 =         zviseta (ji,jj) + dm
440                  zvis21 =         zviseta (ji,jj)
[3]441                  zdiag = zvis22 * ( ze11 + ze22 )
[888]442                  zs11_22 =  zvis11 * ze11 + zdiag
443                  zs12_22 =  zvis12 * ze12 + zvis21 * ze21
444                  zs22_22 =  zvis11 * ze22 + zdiag
445                  zs21_22 =  zvis12 * ze21 + zvis21 * ze12
[3]446
[888]447            ! 2nd part
448                  ze11 =   akappa(ji-1,jj-1,1,1) * ( zu_a(ji  ,jj-1) - zu_a(ji-1,jj-1) - zu_a(ji-1,jj) )   &
449                     &   + akappa(ji-1,jj-1,1,2) * ( zv_a(ji  ,jj-1) + zv_a(ji-1,jj-1) + zv_a(ji-1,jj) )
450                  ze12 = - akappa(ji-1,jj-1,2,2) * ( zu_a(ji-1,jj-1) + zu_a(ji  ,jj-1) - zu_a(ji-1,jj) )   &
451                     &   - akappa(ji-1,jj-1,2,1) * ( zv_a(ji-1,jj-1) + zv_a(ji  ,jj-1) + zv_a(ji-1,jj) )
452                  ze22 = - akappa(ji-1,jj-1,2,2) * ( zv_a(ji-1,jj-1) + zv_a(ji  ,jj-1) - zv_a(ji-1,jj) )   &
453                     &   + akappa(ji-1,jj-1,2,1) * ( zu_a(ji-1,jj-1) + zu_a(ji  ,jj-1) + zu_a(ji-1,jj) )
454                  ze21 =   akappa(ji-1,jj-1,1,1) * ( zv_a(ji  ,jj-1) - zv_a(ji-1,jj-1) - zv_a(ji-1,jj) )   &
455                     &  -  akappa(ji-1,jj-1,1,2) * ( zu_a(ji  ,jj-1) + zu_a(ji-1,jj-1) + zu_a(ji-1,jj) )
[2528]456                  zvis11 = 2._wp * zviseta (ji-1,jj-1) + dm
457                  zvis22 =         zviszeta(ji-1,jj-1) - zviseta(ji-1,jj-1)
458                  zvis12 =         zviseta (ji-1,jj-1) + dm
459                  zvis21 =         zviseta (ji-1,jj-1)
[3]460                  zdiag = zvis22 * ( ze11 + ze22 )
[888]461                  zs11_11 =  zvis11 * ze11 + zdiag
462                  zs12_11 =  zvis12 * ze12 + zvis21 * ze21
463                  zs22_11 =  zvis11 * ze22 + zdiag
464                  zs21_11 =  zvis12 * ze21 + zvis21 * ze12
[3]465
[888]466                  ze11 =   akappa(ji,jj-1,1,1) * ( zu_a(ji+1,jj-1) - zu_a(ji  ,jj-1) )   &
467                     &   + akappa(ji,jj-1,1,2) * ( zv_a(ji+1,jj-1) + zv_a(ji  ,jj-1) )
468                  ze12 = - akappa(ji,jj-1,2,2) * ( zu_a(ji  ,jj-1) + zu_a(ji+1,jj-1) )   &
469                     &   - akappa(ji,jj-1,2,1) * ( zv_a(ji  ,jj-1) + zv_a(ji+1,jj-1) )
470                  ze22 = - akappa(ji,jj-1,2,2) * ( zv_a(ji  ,jj-1) + zv_a(ji+1,jj-1) )   &
471                     &   + akappa(ji,jj-1,2,1) * ( zu_a(ji  ,jj-1) + zu_a(ji+1,jj-1) )
472                  ze21 =   akappa(ji,jj-1,1,1) * ( zv_a(ji+1,jj-1) - zv_a(ji  ,jj-1) )   &
473                     &   - akappa(ji,jj-1,1,2) * ( zu_a(ji+1,jj-1) + zu_a(ji  ,jj-1) )
[2528]474                  zvis11 = 2._wp * zviseta (ji,jj-1) + dm
475                  zvis22 =         zviszeta(ji,jj-1) - zviseta(ji,jj-1)
476                  zvis12 =         zviseta (ji,jj-1) + dm
477                  zvis21 =         zviseta (ji,jj-1)
[3]478                  zdiag = zvis22 * ( ze11 + ze22 )
[888]479                  zs11_21 =  zs11_21 + zvis11 * ze11 + zdiag
480                  zs12_21 =  zs12_21 + zvis12 * ze12 + zvis21 * ze21
481                  zs22_21 =  zs22_21 + zvis11 * ze22 + zdiag
482                  zs21_21 =  zs21_21 + zvis12 * ze21 + zvis21 * ze12
[3]483
[888]484                  ze11 = - akappa(ji-1,jj,1,1) * zu_a(ji-1,jj) + akappa(ji-1,jj,1,2) * zv_a(ji-1,jj)
485                  ze12 = - akappa(ji-1,jj,2,2) * zu_a(ji-1,jj) - akappa(ji-1,jj,2,1) * zv_a(ji-1,jj)
486                  ze22 = - akappa(ji-1,jj,2,2) * zv_a(ji-1,jj) + akappa(ji-1,jj,2,1) * zu_a(ji-1,jj)
487                  ze21 = - akappa(ji-1,jj,1,1) * zv_a(ji-1,jj) - akappa(ji-1,jj,1,2) * zu_a(ji-1,jj)
[2528]488                  zvis11 = 2._wp * zviseta (ji-1,jj) + dm
489                  zvis22 =         zviszeta(ji-1,jj) - zviseta(ji-1,jj)
490                  zvis12 =         zviseta (ji-1,jj) + dm
491                  zvis21 =         zviseta (ji-1,jj)
[3]492                  zdiag = zvis22 * ( ze11 + ze22 )
[888]493                  zs11_12 =  zs11_12 + zvis11 * ze11 + zdiag
494                  zs12_12 =  zs12_12 + zvis12 * ze12 + zvis21 * ze21
495                  zs22_12 =  zs22_12 + zvis11 * ze22 + zdiag
496                  zs21_12 =  zs21_12 + zvis12 * ze21 + zvis21 * ze12
[3]497
[888]498                  zd1 = + alambd(ji,jj,2,2,2,1) * zs11_21 + alambd(ji,jj,2,2,2,2) * zs11_22  &
499                     &  - alambd(ji,jj,2,2,1,1) * zs11_11 - alambd(ji,jj,2,2,1,2) * zs11_12  &
500                     &  - alambd(ji,jj,1,1,2,1) * zs12_21 - alambd(ji,jj,1,1,1,1) * zs12_11  &
501                     &  + alambd(ji,jj,1,1,2,2) * zs12_22 + alambd(ji,jj,1,1,1,2) * zs12_12  &
502                     &  + alambd(ji,jj,1,2,1,1) * zs21_11 + alambd(ji,jj,1,2,2,1) * zs21_21  &
503                     &  + alambd(ji,jj,1,2,1,2) * zs21_12 + alambd(ji,jj,1,2,2,2) * zs21_22  &
504                     &  - alambd(ji,jj,2,1,1,1) * zs22_11 - alambd(ji,jj,2,1,2,1) * zs22_21  &
505                     &  - alambd(ji,jj,2,1,1,2) * zs22_12 - alambd(ji,jj,2,1,2,2) * zs22_22
[3]506
[888]507                  zd2 = + alambd(ji,jj,2,2,2,1) * zs21_21 + alambd(ji,jj,2,2,2,2) * zs21_22  &
508                     &  - alambd(ji,jj,2,2,1,1) * zs21_11 - alambd(ji,jj,2,2,1,2) * zs21_12  &
509                     &  - alambd(ji,jj,1,1,2,1) * zs22_21 - alambd(ji,jj,1,1,1,1) * zs22_11  &
510                     &  + alambd(ji,jj,1,1,2,2) * zs22_22 + alambd(ji,jj,1,1,1,2) * zs22_12  &
511                     &  - alambd(ji,jj,1,2,1,1) * zs11_11 - alambd(ji,jj,1,2,2,1) * zs11_21  &
512                     &  - alambd(ji,jj,1,2,1,2) * zs11_12 - alambd(ji,jj,1,2,2,2) * zs11_22  &
513                     &  + alambd(ji,jj,2,1,1,1) * zs12_11 + alambd(ji,jj,2,1,2,1) * zs12_21  &
514                     &  + alambd(ji,jj,2,1,1,2) * zs12_12 + alambd(ji,jj,2,1,2,2) * zs12_22
[3]515
[1470]516                  zur     = zu_a(ji,jj) - u_oce(ji,jj)
517                  zvr     = zv_a(ji,jj) - v_oce(ji,jj)
[888]518!!!!
[2528]519                  zmod    = SQRT( zur*zur + zvr*zvr ) * ( 1._wp - zfrld(ji,jj) )
[888]520                  za      = rhoco * zmod
521!!!!
[2528]522!!gm chg resul    za      = rhoco * SQRT( zur*zur + zvr*zvr ) * ( 1._wp - zfrld(ji,jj) )
[888]523                  zac     = za * cangvg
524                  zmpzas  = alpha * zcorl(ji,jj) + za * zsang(ji,jj)
525                  zmassdt = zusdtp * zmass(ji,jj)
[2528]526                  zcorlal = ( 1._wp - alpha ) * zcorl(ji,jj)
[3]527
[888]528                  za1 =  zmassdt * zu0(ji,jj) + zcorlal * zv0(ji,jj) + za1ct(ji,jj)   &
[1470]529                     &        + za * ( cangvg * u_oce(ji,jj) - zsang(ji,jj) * v_oce(ji,jj) )
[888]530                  za2 =  zmassdt * zv0(ji,jj) - zcorlal * zu0(ji,jj) + za2ct(ji,jj)   &
[1470]531                     &        + za * ( cangvg * v_oce(ji,jj) + zsang(ji,jj) * u_oce(ji,jj) )
[888]532                  zb1    = zmassdt + zac - zc1u(ji,jj)
533                  zb2    = zmpzas        - zc2u(ji,jj)
534                  zc1    = zmpzas        + zc1v(ji,jj)
535                  zc2    = zmassdt + zac - zc2v(ji,jj)
536                  zdeter = zc1 * zb2 + zc2 * zb1
537                  zden   = SIGN( rone, zdeter) / MAX( epsd , ABS( zdeter ) )
538                  zunw   = (  ( za1 + zd1 ) * zc2 + ( za2 + zd2 ) * zc1 ) * zden
539                  zvnw   = (  ( za2 + zd2 ) * zb1 - ( za1 + zd1 ) * zb2 ) * zden
[2528]540                  zmask  = ( 1._wp - MAX( rzero, SIGN( rone , 1._wp - zmass(ji,jj) ) ) ) * tmu(ji,jj)
[3]541
[888]542                  zu_n(ji,jj) = ( zu_a(ji,jj) + om * ( zunw - zu_a(ji,jj) ) * tmu(ji,jj) ) * zmask
543                  zv_n(ji,jj) = ( zv_a(ji,jj) + om * ( zvnw - zv_a(ji,jj) ) * tmu(ji,jj) ) * zmask
[3]544               END DO
545            END DO
546
[888]547            CALL lbc_lnk( zu_n(:,1:jpj), 'I', -1. )
548            CALL lbc_lnk( zv_n(:,1:jpj), 'I', -1. )
[3]549
[3680]550#if defined key_agrif
551            ! copy the boundary value from u_ice_nst and v_ice_nst to u_ice and v_ice
552            ! before next interations
553            CALL agrif_rhg_lim2(zu_n,zv_n)
554#endif
555
[888]556            ! Test of Convergence
[77]557            DO jj = k_j1+1 , k_jpj-1
[888]558               zresr(:,jj) = MAX( ABS( zu_a(:,jj) - zu_n(:,jj) ) , ABS( zv_a(:,jj) - zv_n(:,jj) ) )
[3]559            END DO
[888]560            zresm = MAXVAL( zresr(1:jpi,k_j1+1:k_jpj-1) )
561!!!! this should be faster on scalar processor
562!           zresm = MAXVAL(  MAX( ABS( zu_a(1:jpi,k_j1+1:k_jpj-1) - zu_n(1:jpi,k_j1+1:k_jpj-1) ),   &
563!              &                  ABS( zv_a(1:jpi,k_j1+1:k_jpj-1) - zv_n(1:jpi,k_j1+1:k_jpj-1) ) )  )
564!!!!
[77]565            IF( lk_mpp )   CALL mpp_max( zresm )   ! max over the global domain
[3]566
[888]567            DO jj = k_j1, k_jpj
568               zu_a(:,jj) = zu_n(:,jj)
569               zv_a(:,jj) = zv_n(:,jj)
570            END DO
[3]571
[888]572            IF( zresm <= resl )   EXIT   iflag
[3]573
[888]574            !                                                   ! ================ !
575         END DO    iflag                                        !  end Relaxation  !
576         !                                                      ! ================ !
577
578         IF( zindu == 0 ) THEN      ! even iteration
579            DO jj = k_j1 , k_jpj-1
580               zu0(:,jj) = zu_a(:,jj)
581               zv0(:,jj) = zv_a(:,jj)
582            END DO
583         ENDIF
584         !                                                ! ==================== !
[3]585      END DO                                              !  end loop over iter  !
586      !                                                   ! ==================== !
587
[1470]588      u_ice(:,:) = zu_a(:,1:jpj)
589      v_ice(:,:) = zv_a(:,1:jpj)
[888]590
[258]591      IF(ln_ctl) THEN
592         WRITE(charout,FMT="('lim_rhg  : res =',D23.16, ' iter =',I4)") zresm, jter
593         CALL prt_ctl_info(charout)
[1470]594         CALL prt_ctl(tab2d_1=u_ice, clinfo1=' lim_rhg  : u_ice :', tab2d_2=v_ice, clinfo2=' v_ice :')
[3]595      ENDIF
596
[3294]597
[821]598   END SUBROUTINE lim_rhg_2
[77]599
[3]600#else
[77]601   !!----------------------------------------------------------------------
[2528]602   !!   Default option        Dummy module      NO VP & LIM-2 sea-ice model
[77]603   !!----------------------------------------------------------------------
[3]604CONTAINS
[821]605   SUBROUTINE lim_rhg_2( k1 , k2 )       ! Dummy routine
606      WRITE(*,*) 'lim_rhg_2: You should not have seen this print! error?', k1, k2
607   END SUBROUTINE lim_rhg_2
[3]608#endif
609
[77]610   !!==============================================================================
[821]611END MODULE limrhg_2
Note: See TracBrowser for help on using the repository browser.