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 trunk/NEMOGCM/NEMO/LIM_SRC_2 – NEMO

Context Navigation

source: trunk/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90 @ 2715

Last change on this file since 2715 was 2715, checked in by rblod, 13 years ago
First attempt to put dynamic allocation on the trunk
Property svn:keywords set to `Id`
File size: 34.8 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: