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.

agrif_user.F90 in NEMO/trunk/src/NST – NEMO

Context Navigation

source: NEMO/trunk/src/NST/agrif_user.F90 @ 14109

Last change on this file since 14109 was 14086, checked in by cetlod, 4 years ago
Adding AGRIF branches into the trunk
Property svn:keywords set to `Id`
File size: 51.9 KB

Rev	Line
[9096]	1	#undef UPD_HIGH /* MIX HIGH UPDATE */
[14086]	2	#define DIV_CONS /* DIVERGENCE CONS */
[393]	3	#if defined key_agrif
[12377]	4	!! * Substitutions
	5	# include "do_loop_substitute.h90"
[10068]	6	!!----------------------------------------------------------------------
	7	!! NEMO/NST 4.0 , NEMO Consortium (2018)
	8	!! $Id$
	9	!! Software governed by the CeCILL license (see ./LICENSE)
	10	!!----------------------------------------------------------------------
[12377]	11	SUBROUTINE agrif_user
	12	END SUBROUTINE agrif_user
[3680]	13
[13286]	14
[12377]	15	SUBROUTINE agrif_before_regridding
	16	END SUBROUTINE agrif_before_regridding
[3680]	17
[13286]	18
[12377]	19	SUBROUTINE Agrif_InitWorkspace
	20	END SUBROUTINE Agrif_InitWorkspace
[1156]	21
[13286]	22
[12377]	23	SUBROUTINE Agrif_InitValues
[10068]	24	!!----------------------------------------------------------------------
	25	!! * ROUTINE Agrif_InitValues *
	26	!!----------------------------------------------------------------------
[12377]	27	USE nemogcm
[10068]	28	!!----------------------------------------------------------------------
[12377]	29	!
	30	CALL nemo_init !* Initializations of each fine grid
	31	Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices
	32	!
	33	! !* Agrif initialization
	34	CALL Agrif_InitValues_cont
[2715]	35	# if defined key_top
[12377]	36	CALL Agrif_InitValues_cont_top
[7646]	37	# endif
[9570]	38	# if defined key_si3
[12377]	39	CALL Agrif_InitValues_cont_ice
[7761]	40	# endif
[12377]	41	!
	42	END SUBROUTINE Agrif_initvalues
[2031]	43
[13286]	44
[13216]	45	SUBROUTINE agrif_declare_var_ini
[10068]	46	!!----------------------------------------------------------------------
[13286]	47	!! * ROUTINE agrif_declare_var_ini *
[10068]	48	!!----------------------------------------------------------------------
[13216]	49	USE agrif_util
	50	USE agrif_oce
	51	USE par_oce
	52	USE zdf_oce
	53	USE oce
	54	USE dom_oce
[12377]	55	!
	56	IMPLICIT NONE
	57	!
[14086]	58	INTEGER :: ind1, ind2, ind3, imaxrho
[13286]	59	INTEGER :: its
[13216]	60	External :: nemo_mapping
[10068]	61	!!----------------------------------------------------------------------
[3680]	62
[13216]	63	! In case of East-West periodicity, prevent AGRIF interpolation at east and west boundaries
	64	! The procnames will not be called at these boundaries
	65	IF (jperio == 1) THEN
	66	CALL Agrif_Set_NearCommonBorderX(.TRUE.)
	67	CALL Agrif_Set_DistantCommonBorderX(.TRUE.)
	68	ENDIF
	69
	70	IF ( .NOT. lk_south ) THEN
	71	CALL Agrif_Set_NearCommonBorderY(.TRUE.)
	72	ENDIF
	73
[14086]	74	IF ( .NOT. lk_north ) THEN
	75	CALL Agrif_Set_DistantCommonBorderY(.TRUE.)
	76	ENDIF
	77
[10068]	78	! 1. Declaration of the type of variable which have to be interpolated
	79	!---------------------------------------------------------------------
[14086]	80	ind1 = nbghostcells
[13286]	81	ind2 = nn_hls + 2 + nbghostcells_x
	82	ind3 = nn_hls + 2 + nbghostcells_y_s
[14086]	83	imaxrho = MAX(Agrif_irhox(), Agrif_irhoy())
[3680]	84
[14086]	85	CALL agrif_declare_variable((/2,2,0 /),(/ind2 ,ind3,0 /),(/'x','y','N' /),(/1,1,1 /),(/jpi,jpj,jpk /), e3t_id)
	86	CALL agrif_declare_variable((/2,2,0 /),(/ind2 ,ind3,0 /),(/'x','y','N' /),(/1,1,1 /),(/jpi,jpj,jpk /),e3t0_interp_id)
	87	CALL agrif_declare_variable((/2,2 /),(/ind2 ,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), mbkt_id)
	88	CALL agrif_declare_variable((/2,2 /),(/ind2 ,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), ht0_id)
[13216]	89
	90	! Initial or restart velues
[13286]	91	its = jpts+1
	92	CALL agrif_declare_variable((/2,2,0,0/),(/ind2 ,ind3 ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,its/), tsini_id)
	93	CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3 ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2 /), uini_id)
	94	CALL agrif_declare_variable((/2,1,0,0/),(/ind2 ,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2 /), vini_id)
	95	CALL agrif_declare_variable((/2,2 /),(/ind2 ,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /),sshini_id)
[13216]	96	!
[14086]	97	! Update location
	98	CALL agrif_declare_variable((/2,2/),(/ind2 ,ind3 /),(/'x','y'/),(/1,1/),(/jpi,jpj/), batupd_id)
[13216]	99
[10068]	100	! 2. Type of interpolation
	101	!-------------------------
[14086]	102	CALL Agrif_Set_bcinterp( e3t_id,interp =AGRIF_constant)
	103	CALL Agrif_Set_bcinterp(e3t0_interp_id,interp =AGRIF_linear )
	104	CALL Agrif_Set_interp (e3t0_interp_id,interp =AGRIF_linear )
	105	CALL Agrif_Set_bcinterp( mbkt_id,interp =AGRIF_constant)
	106	CALL Agrif_Set_interp ( mbkt_id,interp =AGRIF_constant)
	107	CALL Agrif_Set_bcinterp( ht0_id,interp =AGRIF_constant)
	108	CALL Agrif_Set_interp ( ht0_id,interp =AGRIF_constant)
[13216]	109
	110	! Initial fields
[13286]	111	CALL Agrif_Set_bcinterp( tsini_id,interp =AGRIF_linear )
	112	CALL Agrif_Set_interp ( tsini_id,interp =AGRIF_linear )
	113	CALL Agrif_Set_bcinterp( uini_id,interp =AGRIF_linear )
	114	CALL Agrif_Set_interp ( uini_id,interp =AGRIF_linear )
	115	CALL Agrif_Set_bcinterp( vini_id,interp =AGRIF_linear )
	116	CALL Agrif_Set_interp ( vini_id,interp =AGRIF_linear )
	117	CALL Agrif_Set_bcinterp(sshini_id,interp =AGRIF_linear )
	118	CALL Agrif_Set_interp (sshini_id,interp =AGRIF_linear )
[13216]	119
	120	! 3. Location of interpolation
[10068]	121	!-----------------------------
[14086]	122	! CALL Agrif_Set_bc( e3t_id, (/-nn_sponge_len*imaxrho,ind1-1/) )
[13216]	123	! JC: check near the boundary only until matching in sponge has been sorted out:
[13286]	124	CALL Agrif_Set_bc( e3t_id, (/0,ind1-1/) )
[13216]	125
	126	! extend the interpolation zone by 1 more point than necessary:
	127	! RB check here
[14086]	128	CALL Agrif_Set_bc( e3t0_interp_id, (/-nn_sponge_len*imaxrho-2,ind1/) )
	129	CALL Agrif_Set_bc( mbkt_id, (/-nn_sponge_len*imaxrho-2,ind1/) )
	130	CALL Agrif_Set_bc( ht0_id, (/-nn_sponge_len*imaxrho-2,ind1/) )
	131	CALL Agrif_Set_bc( tsini_id, (/0,ind1-1/) ) ! if west, rhox=3 and nbghost=3: columns 2 to 4
	132	CALL Agrif_Set_bc( uini_id, (/0,ind1-1/) )
	133	CALL Agrif_Set_bc( vini_id, (/0,ind1-1/) )
	134	CALL Agrif_Set_bc( sshini_id, (/0,ind1-1/) )
[3680]	135
[10068]	136	! 4. Update type
	137	!---------------
[9031]	138	# if defined UPD_HIGH
[14086]	139	CALL Agrif_Set_Updatetype(batupd_id, update = Agrif_Update_Full_Weighting)
[9031]	140	#else
[14086]	141	CALL Agrif_Set_Updatetype(batupd_id, update = Agrif_Update_Average)
	142	#endif
	143
[13216]	144	! CALL Agrif_Set_ExternalMapping(nemo_mapping)
	145	!
	146	END SUBROUTINE agrif_declare_var_ini
[3680]	147
	148
[14086]	149	SUBROUTINE Agrif_Init_Domain
[10068]	150	!!----------------------------------------------------------------------
[13286]	151	!! * ROUTINE Agrif_Init_Domain *
[10068]	152	!!----------------------------------------------------------------------
[13216]	153	USE agrif_oce_update
[12377]	154	USE agrif_oce_interp
	155	USE agrif_oce_sponge
[13216]	156	USE Agrif_Util
	157	USE oce
[12377]	158	USE dom_oce
[13216]	159	USE zdf_oce
	160	USE nemogcm
	161	USE agrif_oce
	162	!
	163	USE lbclnk
[12377]	164	USE lib_mpp
[13216]	165	USE in_out_manager
[12377]	166	!
	167	IMPLICIT NONE
	168	!
[13216]	169	!
[12377]	170	LOGICAL :: check_namelist
	171	CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4
	172	REAL(wp), DIMENSION(jpi,jpj) :: zk ! workspace
[13216]	173	INTEGER :: ji, jj, jk
[14086]	174	INTEGER :: jpk_parent, ierr
[10068]	175	!!----------------------------------------------------------------------
[13216]	176
	177	! CALL Agrif_Declare_Var_ini
[390]	178
[13216]	179	IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
[636]	180
[12377]	181	! Build consistent parent bathymetry and number of levels
	182	! on the child grid
	183	Agrif_UseSpecialValue = .FALSE.
[13286]	184	ht0_parent( :,:) = 0._wp
[12377]	185	mbkt_parent(:,:) = 0
	186	!
[14086]	187	! CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 )
	188	! CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt)
[13216]	189	CALL Agrif_Init_Variable(ht0_id , procname=interpht0 )
	190	CALL Agrif_Init_Variable(mbkt_id, procname=interpmbkt)
[12377]	191	!
	192	! Assume step wise change of bathymetry near interface
	193	! TODO: Switch to linear interpolation of bathymetry in the s-coordinate case
	194	! and no refinement
[13295]	195	DO_2D( 1, 0, 1, 0 )
[13286]	196	mbku_parent(ji,jj) = MIN( mbkt_parent(ji+1,jj ), mbkt_parent(ji,jj) )
	197	mbkv_parent(ji,jj) = MIN( mbkt_parent(ji ,jj+1), mbkt_parent(ji,jj) )
[12377]	198	END_2D
	199	IF ( ln_sco.AND.Agrif_Parent(ln_sco) ) THEN
[13295]	200	DO_2D( 1, 0, 1, 0 )
[14086]	201	hu0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji+1,jj) ) * ssumask(ji,jj)
	202	hv0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji,jj+1) ) * ssvmask(ji,jj)
[12377]	203	END_2D
	204	ELSE
[13295]	205	DO_2D( 1, 0, 1, 0 )
[13286]	206	hu0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji+1,jj) )
	207	hv0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji,jj+1) )
[12377]	208	END_2D
	209	ENDIF
	210	!
[13286]	211	CALL lbc_lnk_multi( 'Agrif_Init_Domain', hu0_parent, 'U', 1.0_wp, hv0_parent, 'V', 1.0_wp )
[13295]	212	DO_2D( 0, 0, 0, 0 )
[13286]	213	zk(ji,jj) = REAL( mbku_parent(ji,jj), wp )
	214	END_2D
[14086]	215	CALL lbc_lnk( 'Agrif_InitValues_Domain', zk, 'U', 1.0_wp )
[13286]	216	mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )
[13295]	217	DO_2D( 0, 0, 0, 0 )
[13286]	218	zk(ji,jj) = REAL( mbkv_parent(ji,jj), wp )
	219	END_2D
[14086]	220	CALL lbc_lnk( 'Agrif_InitValues_Domain', zk, 'V', 1.0_wp )
	221	mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )
	222	!
	223	! Build "intermediate" parent vertical grid on child domain
	224	IF ( ln_vert_remap ) THEN
[628]	225
[14086]	226	jpk_parent = Agrif_parent( jpk )
	227	ALLOCATE(e3t0_parent(jpi,jpj,jpk_parent), &
	228	& e3u0_parent(jpi,jpj,jpk_parent), &
	229	& e3v0_parent(jpi,jpj,jpk_parent), STAT = ierr)
	230	IF( ierr > 0 ) CALL ctl_warn('Agrif_Init_Domain: allocation of arrays failed')
	231
	232	! Retrieve expected parent scale factors on child grid:
	233	Agrif_UseSpecialValue = .FALSE.
	234	e3t0_parent(:,:,:) = 0._wp
	235	CALL Agrif_Init_Variable(e3t0_interp_id, procname=interpe3t0_vremap)
	236	!
	237	! Deduce scale factors at U and V points:
	238	DO_3D( 0, 0, 0, 0, 1, jpk_parent )
	239	e3u0_parent(ji,jj,jk) = 0.5_wp * (e3t0_parent(ji,jj,jk) + e3t0_parent(ji+1,jj ,jk))
	240	e3v0_parent(ji,jj,jk) = 0.5_wp * (e3t0_parent(ji,jj,jk) + e3t0_parent(ji ,jj+1,jk))
	241	END_3D
	242
	243	! Assume a step at the bottom except if (pure) s-coordinates
	244	IF ( .NOT.Agrif_Parent(ln_sco) ) THEN
	245	DO_2D( 1, 0, 1, 0 )
	246	jk = mbku_parent(ji,jj)
	247	e3u0_parent(ji,jj,jk) = MIN(e3t0_parent(ji,jj,jk), e3t0_parent(ji+1,jj ,jk))
	248	jk = mbkv_parent(ji,jj)
	249	e3v0_parent(ji,jj,jk) = MIN(e3t0_parent(ji,jj,jk), e3t0_parent(ji ,jj+1,jk))
	250	END_2D
	251	ENDIF
	252
	253	CALL lbc_lnk_multi( 'Agrif_Init_Domain', e3u0_parent, 'U', 1.0_wp, e3v0_parent, 'V', 1.0_wp )
[13216]	254	ENDIF
	255
	256	! check if masks and bathymetries match
	257	IF(ln_chk_bathy) THEN
	258	Agrif_UseSpecialValue = .FALSE.
	259	!
	260	IF(lwp) WRITE(numout,*) ' '
	261	IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level()
	262	!
	263	kindic_agr = 0
[14086]	264	IF( .NOT. ln_vert_remap ) THEN
[13216]	265	!
	266	! check if tmask and vertical scale factors agree with parent in sponge area:
	267	CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t)
	268	!
	269	ELSE
	270	!
	271	! In case of vertical interpolation, check only that total depths agree between child and parent:
[14086]	272
	273	CALL Agrif_check_bat( kindic_agr )
[13216]	274
[14086]	275	CALL mpp_sum( 'agrif_InitValues_Domain', kindic_agr )
[13216]	276	IF( kindic_agr /= 0 ) THEN
	277	CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.')
	278	ELSE
	279	IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.'
	280	IF(lwp) WRITE(numout,*) ' '
	281	ENDIF
	282	ENDIF
	283	ENDIF
	284	!
[14086]	285	WHERE (ssumask(:,:) == 0._wp) mbku_parent(:,:) = 0
	286	WHERE (ssvmask(:,:) == 0._wp) mbkv_parent(:,:) = 0
	287	WHERE (ssmask(:,:) == 0._wp) mbkt_parent(:,:) = 0
	288	!
[13216]	289	END SUBROUTINE Agrif_Init_Domain
	290
	291
	292	SUBROUTINE Agrif_InitValues_cont
[13286]	293	!!----------------------------------------------------------------------
	294	!! * ROUTINE Agrif_InitValues_cont *
	295	!!
	296	!! ** Purpose :: Declaration of variables to be interpolated
	297	!!----------------------------------------------------------------------
[13216]	298	USE agrif_oce_update
	299	USE agrif_oce_interp
	300	USE agrif_oce_sponge
	301	USE Agrif_Util
	302	USE oce
	303	USE dom_oce
	304	USE zdf_oce
	305	USE nemogcm
	306	USE agrif_oce
	307	!
	308	USE lbclnk
	309	USE lib_mpp
	310	USE in_out_manager
	311	!
	312	IMPLICIT NONE
	313	!
	314	LOGICAL :: check_namelist
	315	CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4
	316
	317	! 1. Declaration of the type of variable which have to be interpolated
	318	!---------------------------------------------------------------------
	319	CALL agrif_declare_var
	320
	321	! 2. First interpolations of potentially non zero fields
	322	!-------------------------------------------------------
[12377]	323	Agrif_SpecialValue = 0._wp
	324	Agrif_UseSpecialValue = .TRUE.
[14086]	325	l_vremap = ln_vert_remap
	326
	327	CALL Agrif_Bc_variable(ts_interp_id,calledweight=1.,procname=interptsn)
[12377]	328	CALL Agrif_Sponge
	329	tabspongedone_tsn = .FALSE.
[14086]	330	CALL Agrif_Bc_variable(ts_sponge_id,calledweight=1.,procname=interptsn_sponge)
[13216]	331	! reset tsa to zero
[12377]	332	ts(:,:,:,:,Krhs_a) = 0._wp
	333
[5930]	334	Agrif_UseSpecialValue = ln_spc_dyn
[13216]	335	use_sign_north = .TRUE.
	336	sign_north = -1.
[12377]	337	CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun)
	338	CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn)
	339	tabspongedone_u = .FALSE.
	340	tabspongedone_v = .FALSE.
	341	CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge)
	342	tabspongedone_u = .FALSE.
	343	tabspongedone_v = .FALSE.
	344	CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge)
[14086]	345	IF (nn_shift_bar>0) THEN
	346	CALL Agrif_Sponge_2d
	347	tabspongedone_u = .FALSE.
	348	tabspongedone_v = .FALSE.
	349	CALL Agrif_Bc_variable(unb_sponge_id,calledweight=1.,procname=interpunb_sponge)
	350	tabspongedone_u = .FALSE.
	351	tabspongedone_v = .FALSE.
	352	CALL Agrif_Bc_variable(vnb_sponge_id,calledweight=1.,procname=interpvnb_sponge)
	353	ENDIF
[13216]	354	use_sign_north = .FALSE.
[12377]	355	uu(:,:,:,Krhs_a) = 0._wp
	356	vv(:,:,:,Krhs_a) = 0._wp
[5656]	357
[12377]	358	Agrif_UseSpecialValue = .TRUE.
	359	CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
	360	hbdy(:,:) = 0._wp
	361	ssh(:,:,Krhs_a) = 0._wp
[5656]	362
[12377]	363	IF ( ln_dynspg_ts ) THEN
	364	Agrif_UseSpecialValue = ln_spc_dyn
[13216]	365	use_sign_north = .TRUE.
	366	sign_north = -1.
[14086]	367	CALL Agrif_Bc_variable( unb_interp_id,calledweight=1.,procname=interpunb )
	368	CALL Agrif_Bc_variable( vnb_interp_id,calledweight=1.,procname=interpvnb )
[13546]	369	CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) ! must be called before unb_id to define ubdy
	370	CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) ! must be called before vnb_id to define vbdy
[13216]	371	use_sign_north = .FALSE.
[12377]	372	ubdy(:,:) = 0._wp
	373	vbdy(:,:) = 0._wp
[14086]	374	ELSE
	375	Agrif_UseSpecialValue = ln_spc_dyn
	376	use_sign_north = .TRUE.
	377	sign_north = -1.
	378	CALL Agrif_Bc_variable( unb_interp_id,calledweight=1.,procname=interpunb )
	379	CALL Agrif_Bc_variable( vnb_interp_id,calledweight=1.,procname=interpvnb )
	380	use_sign_north = .FALSE.
	381	ubdy(:,:) = 0._wp
	382	vbdy(:,:) = 0._wp
[12377]	383	ENDIF
[13216]	384	Agrif_UseSpecialValue = .FALSE.
[14086]	385	l_vremap = .FALSE.
[3680]	386
[12377]	387	!-----------------
	388	check_namelist = .TRUE.
[3680]	389
[12377]	390	IF( check_namelist ) THEN
	391	! Check free surface scheme
	392	IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.&
	393	& ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN
	394	WRITE(cl_check1,*) Agrif_Parent( ln_dynspg_ts )
	395	WRITE(cl_check2,*) ln_dynspg_ts
	396	WRITE(cl_check3,*) Agrif_Parent( ln_dynspg_exp )
	397	WRITE(cl_check4,*) ln_dynspg_exp
	398	CALL ctl_stop( 'Incompatible free surface scheme between grids' , &
	399	& 'parent grid ln_dynspg_ts :'//cl_check1 , &
	400	& 'child grid ln_dynspg_ts :'//cl_check2 , &
	401	& 'parent grid ln_dynspg_exp :'//cl_check3 , &
	402	& 'child grid ln_dynspg_exp :'//cl_check4 , &
	403	& 'those logicals should be identical' )
	404	STOP
	405	ENDIF
	406
	407	! Check if identical linear free surface option
	408	IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.&
	409	& ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN
	410	WRITE(cl_check1,*) Agrif_Parent(ln_linssh )
	411	WRITE(cl_check2,*) ln_linssh
	412	CALL ctl_stop( 'Incompatible linearized fs option between grids', &
	413	& 'parent grid ln_linssh :'//cl_check1 , &
	414	& 'child grid ln_linssh :'//cl_check2 , &
	415	& 'those logicals should be identical' )
	416	STOP
	417	ENDIF
[9031]	418	ENDIF
	419
[12377]	420	END SUBROUTINE Agrif_InitValues_cont
	421
	422	SUBROUTINE agrif_declare_var
[10068]	423	!!----------------------------------------------------------------------
[12377]	424	!! * ROUTINE agrif_declare_var *
[10068]	425	!!----------------------------------------------------------------------
[12377]	426	USE agrif_util
	427	USE agrif_oce
	428	USE par_oce
	429	USE zdf_oce
	430	USE oce
	431	!
	432	IMPLICIT NONE
	433	!
[14086]	434	INTEGER :: ind1, ind2, ind3, imaxrho
[10068]	435	!!----------------------------------------------------------------------
[2715]	436
[12377]	437	! 1. Declaration of the type of variable which have to be interpolated
	438	!---------------------------------------------------------------------
[13286]	439	ind1 = nbghostcells
	440	ind2 = nn_hls + 2 + nbghostcells_x
	441	ind3 = nn_hls + 2 + nbghostcells_y_s
[14086]	442	imaxrho = MAX(Agrif_irhox(), Agrif_irhoy())
	443
	444	CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/) ,(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),ts_interp_id)
	445	CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/) ,(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),ts_update_id)
	446	CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/) ,(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),ts_sponge_id)
[13286]	447	CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_interp_id)
	448	CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_interp_id)
	449	CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_update_id)
	450	CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_update_id)
	451	CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_sponge_id)
	452	CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_sponge_id)
[14086]	453
	454	CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/) ,sshn_id)
	455	CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/), unb_interp_id)
	456	CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/), vnb_interp_id)
[13286]	457	CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_interp_id)
	458	CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_interp_id)
[14086]	459	CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/), unb_sponge_id)
	460	CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/), vnb_sponge_id)
[13286]	461	CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_update_id)
	462	CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_update_id)
[14086]	463	CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/), unb_update_id)
	464	CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/), vnb_update_id)
	465	CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/) ,ub2b_cor_id)
	466	CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/) ,vb2b_cor_id)
[13286]	467	! CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),glamt_id)
	468	! CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gphit_id)
[2715]	469
[5656]	470
[13216]	471	IF( ln_zdftke.OR.ln_zdfgls ) THEN ! logical not known at this point
[13286]	472	! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
	473	! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
	474	CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),avm_id)
[12377]	475	ENDIF
[13216]	476
[12377]	477	! 2. Type of interpolation
	478	!-------------------------
[14086]	479	CALL Agrif_Set_bcinterp( ts_interp_id,interp =AGRIF_linear)
	480	CALL Agrif_Set_bcinterp( ts_sponge_id,interp =AGRIF_linear)
[2715]	481
[14086]	482	#if defined DIV_CONS
	483	lk_tint2d_notinterp = .TRUE.
	484	CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_constant)
	485	CALL Agrif_Set_bcinterp(ub2b_cor_id,interp=AGRIF_constant)
	486	CALL Agrif_Set_bcinterp(vb2b_cor_id,interp=AGRIF_constant)
	487	CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_linearconserv)
	488	CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_linearconserv,interp2=Agrif_linear)
	489	#else
	490	lk_tint2d_notinterp = .FALSE.
	491	CALL Agrif_Set_bcinterp(sshn_id,interp =AGRIF_linear)
	492	CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
	493	CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
	494	#endif
[2715]	495
[14086]	496	CALL Agrif_Set_bcinterp(unb_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm )
	497	CALL Agrif_Set_bcinterp(vnb_interp_id,interp1=AGRIF_ppm ,interp2=Agrif_linear)
	498	CALL Agrif_Set_bcinterp(unb_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm )
	499	CALL Agrif_Set_bcinterp(vnb_sponge_id,interp1=AGRIF_ppm ,interp2=Agrif_linear)
[4326]	500
[14086]	501	CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm )
	502	CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm ,interp2=Agrif_linear)
	503
	504	CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm )
	505	CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm ,interp2=Agrif_linear)
	506
[13216]	507	IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )
	508
[5656]	509
[13286]	510	! CALL Agrif_Set_bcinterp(gphit_id,interp=AGRIF_constant)
	511	! CALL Agrif_Set_bcinterp(glamt_id,interp=AGRIF_constant)
	512
	513	! 3. Location of interpolation
[12377]	514	!-----------------------------
[14086]	515	CALL Agrif_Set_bc( ts_interp_id, (/0,ind1-1/) ) ! if west, rhox=3 and nbghost=3: columns 2 to 4
	516	CALL Agrif_Set_bc( un_interp_id, (/0,ind1-1/) )
	517	CALL Agrif_Set_bc( vn_interp_id, (/0,ind1-1/) )
[2715]	518
[14086]	519	CALL Agrif_Set_bc( ts_sponge_id, (/-nn_sponge_len*imaxrho-1,0/) ) ! if west, rhox=3, nn_sponge_len=2
	520	CALL Agrif_Set_bc( un_sponge_id, (/-nn_sponge_len*imaxrho-1,0/) ) ! and nbghost=3:
	521	CALL Agrif_Set_bc( vn_sponge_id, (/-nn_sponge_len*imaxrho-1,0/) ) ! columns 4 to 11
[4326]	522
[14086]	523	CALL Agrif_Set_bc( sshn_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
	524	CALL Agrif_Set_bc( unb_interp_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
	525	CALL Agrif_Set_bc( vnb_interp_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
	526	CALL Agrif_Set_bc(ub2b_interp_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
	527	CALL Agrif_Set_bc(vb2b_interp_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
	528	CALL Agrif_Set_bc( unb_sponge_id, (/-(nn_sponge_len+nn_shift_bar)imaxrho,-imaxrhonn_shift_bar/) )
	529	CALL Agrif_Set_bc( vnb_sponge_id, (/-(nn_sponge_len+nn_shift_bar)imaxrho,-imaxrhonn_shift_bar/) )
	530	CALL Agrif_Set_bc( ub2b_cor_id, (/-imaxrho*nn_shift_bar,ind1/) )
	531	CALL Agrif_Set_bc( vb2b_cor_id, (/-imaxrho*nn_shift_bar,ind1/) )
[13216]	532	IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) )
[13286]	533	!!$ CALL Agrif_Set_bc(glamt_id, (/0,ind1-1/) )
	534	!!$ CALL Agrif_Set_bc(gphit_id, (/0,ind1-1/) )
[2715]	535
[12377]	536	! 4. Update type
	537	!---------------
[2715]	538
[9031]	539	# if defined UPD_HIGH
[14086]	540	CALL Agrif_Set_Updatetype( ts_interp_id,update = Agrif_Update_Full_Weighting)
	541	CALL Agrif_Set_Updatetype( un_update_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)
	542	CALL Agrif_Set_Updatetype( vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )
[9031]	543
[14086]	544	CALL Agrif_Set_Updatetype( unb_update_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)
	545	CALL Agrif_Set_Updatetype( vnb_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )
[13286]	546	CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)
	547	CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )
	548	CALL Agrif_Set_Updatetype( sshn_id,update = Agrif_Update_Full_Weighting)
	549	CALL Agrif_Set_Updatetype( e3t_id,update = Agrif_Update_Full_Weighting)
[9031]	550
[13216]	551	! IF( ln_zdftke.OR.ln_zdfgls ) THEN
[12377]	552	! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting)
	553	! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting)
	554	! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting)
[13216]	555	! ENDIF
[9031]	556
	557	#else
[14086]	558	CALL Agrif_Set_Updatetype( ts_update_id,update = AGRIF_Update_Average)
	559	CALL Agrif_Set_Updatetype( un_update_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)
	560	CALL Agrif_Set_Updatetype( vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )
[3680]	561
[14086]	562	CALL Agrif_Set_Updatetype( unb_update_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)
	563	CALL Agrif_Set_Updatetype( vnb_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )
[13286]	564	CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)
	565	CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )
	566	CALL Agrif_Set_Updatetype( sshn_id,update = AGRIF_Update_Average)
	567	CALL Agrif_Set_Updatetype( e3t_id,update = AGRIF_Update_Average)
[5656]	568
[13216]	569	! IF( ln_zdftke.OR.ln_zdfgls ) THEN
[12377]	570	! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
	571	! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
	572	! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
[13216]	573	! ENDIF
[5656]	574
[9031]	575	#endif
[12377]	576	!
	577	END SUBROUTINE agrif_declare_var
[3680]	578
[9570]	579	#if defined key_si3
[13286]	580	SUBROUTINE Agrif_InitValues_cont_ice
	581	!!----------------------------------------------------------------------
	582	!! * ROUTINE Agrif_InitValues_cont_ice *
	583	!!----------------------------------------------------------------------
[12377]	584	USE Agrif_Util
	585	USE sbc_oce, ONLY : nn_fsbc ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc
	586	USE ice
	587	USE agrif_ice
	588	USE in_out_manager
	589	USE agrif_ice_interp
	590	USE lib_mpp
[13286]	591	!
	592	IMPLICIT NONE
	593	!
[10068]	594	!!----------------------------------------------------------------------
[12377]	595	! Controls
[7761]	596
[12377]	597	! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom)
	598	! the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child)
	599	! therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable
[13216]	600	! If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account
[12377]	601	IF( nn_fsbc > 1 ) CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly')
[7761]	602
[12377]	603	! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer
	604	IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 ) THEN
	605	CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')
	606	ENDIF
	607	! First Interpolations (using "after" ice subtime step => nbstep_ice=1)
	608	!----------------------------------------------------------------------
	609	nbstep_ice = ( Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) ! clem: to have calledweight=1 in interp (otherwise the western border of the zoom is wrong)
	610	CALL agrif_interp_ice('U') ! interpolation of ice velocities
	611	CALL agrif_interp_ice('V') ! interpolation of ice velocities
	612	CALL agrif_interp_ice('T') ! interpolation of ice tracers
	613	nbstep_ice = 0
	614	!
	615	END SUBROUTINE Agrif_InitValues_cont_ice
[7646]	616
[13286]	617
[12377]	618	SUBROUTINE agrif_declare_var_ice
[10068]	619	!!----------------------------------------------------------------------
	620	!! * ROUTINE agrif_declare_var_ice *
	621	!!----------------------------------------------------------------------
[12377]	622	USE Agrif_Util
	623	USE ice
[13216]	624	USE par_oce, ONLY : nbghostcells, nbghostcells_x, nbghostcells_y_s
[12377]	625	!
	626	IMPLICIT NONE
	627	!
	628	INTEGER :: ind1, ind2, ind3
[13286]	629	INTEGER :: ipl
	630	!!----------------------------------------------------------------------
[12377]	631	!
	632	! 1. Declaration of the type of variable which have to be interpolated (parent=>child)
	633	! agrif_declare_variable(position,1st point index,--,--,dimensions,name)
	634	! ex.: position=> 1,1 = not-centered (in i and j)
	635	! 2,2 = centered ( - )
	636	! index => 1,1 = one ghost line
	637	! 2,2 = two ghost lines
	638	!-------------------------------------------------------------------------------------
[13286]	639	ind1 = nbghostcells
	640	ind2 = nn_hls + 2 + nbghostcells_x
	641	ind3 = nn_hls + 2 + nbghostcells_y_s
[13472]	642	ipl = jpl*(9+nlay_s+nlay_i)
[13286]	643	CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_ice_id)
	644	CALL agrif_declare_variable((/1,2/) ,(/ind2-1,ind3/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), u_ice_id)
	645	CALL agrif_declare_variable((/2,1/) ,(/ind2,ind3-1/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), v_ice_id)
[13216]	646
[13286]	647	CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_iceini_id)
	648	CALL agrif_declare_variable((/1,2/) ,(/ind2-1,ind3/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), u_iceini_id)
	649	CALL agrif_declare_variable((/2,1/) ,(/ind2,ind3-1/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), v_iceini_id)
[7646]	650
[12377]	651	! 2. Set interpolations (normal & tangent to the grid cell for velocities)
	652	!-----------------------------------
	653	CALL Agrif_Set_bcinterp(tra_ice_id, interp = AGRIF_linear)
	654	CALL Agrif_Set_bcinterp(u_ice_id , interp1 = Agrif_linear,interp2 = AGRIF_ppm )
	655	CALL Agrif_Set_bcinterp(v_ice_id , interp1 = AGRIF_ppm ,interp2 = Agrif_linear)
[7646]	656
[13216]	657	CALL Agrif_Set_bcinterp(tra_iceini_id, interp = AGRIF_linear)
	658	CALL Agrif_Set_interp (tra_iceini_id, interp = AGRIF_linear)
[14086]	659	CALL Agrif_Set_bcinterp(u_iceini_id , interp = AGRIF_linear)
	660	CALL Agrif_Set_interp (u_iceini_id , interp = AGRIF_linear)
[13216]	661	CALL Agrif_Set_bcinterp(v_iceini_id , interp = AGRIF_linear)
	662	CALL Agrif_Set_interp (v_iceini_id , interp = AGRIF_linear)
	663
[12377]	664	! 3. Set location of interpolations
	665	!----------------------------------
	666	CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/))
	667	CALL Agrif_Set_bc(u_ice_id ,(/0,ind1/))
	668	CALL Agrif_Set_bc(v_ice_id ,(/0,ind1/))
[7646]	669
[13216]	670	CALL Agrif_Set_bc(tra_iceini_id,(/0,ind1/))
	671	CALL Agrif_Set_bc(u_iceini_id ,(/0,ind1/))
	672	CALL Agrif_Set_bc(v_iceini_id ,(/0,ind1/))
	673
[12377]	674	! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
	675	!--------------------------------------------------
[9134]	676	# if defined UPD_HIGH
[12377]	677	CALL Agrif_Set_Updatetype(tra_ice_id, update = Agrif_Update_Full_Weighting)
	678	CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)
	679	CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )
[13216]	680	# else
[12377]	681	CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average)
	682	CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)
	683	CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )
[13216]	684	# endif
[7646]	685
[12377]	686	END SUBROUTINE agrif_declare_var_ice
[7646]	687	#endif
	688
	689
[2715]	690	# if defined key_top
[12377]	691	SUBROUTINE Agrif_InitValues_cont_top
[10068]	692	!!----------------------------------------------------------------------
	693	!! * ROUTINE Agrif_InitValues_cont_top *
[12377]	694	!!----------------------------------------------------------------------
	695	USE Agrif_Util
	696	USE oce
	697	USE dom_oce
	698	USE nemogcm
	699	USE par_trc
	700	USE lib_mpp
	701	USE trc
	702	USE in_out_manager
	703	USE agrif_oce_sponge
	704	USE agrif_top_update
	705	USE agrif_top_interp
	706	USE agrif_top_sponge
[13286]	707	!
	708	IMPLICIT NONE
	709	!
	710	CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
	711	LOGICAL :: check_namelist
[10068]	712	!!----------------------------------------------------------------------
[1300]	713
[13286]	714	! 1. Declaration of the type of variable which have to be interpolated
	715	!---------------------------------------------------------------------
	716	CALL agrif_declare_var_top
[1300]	717
[13286]	718	! 2. First interpolations of potentially non zero fields
	719	!-------------------------------------------------------
	720	Agrif_SpecialValue=0._wp
	721	Agrif_UseSpecialValue = .TRUE.
	722	CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
	723	Agrif_UseSpecialValue = .FALSE.
	724	CALL Agrif_Sponge
	725	tabspongedone_trn = .FALSE.
	726	CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
	727	! reset tsa to zero
[14086]	728	tr(:,:,:,:,Krhs_a) = 0._wp
[3680]	729
[13286]	730	! 3. Some controls
	731	!-----------------
	732	check_namelist = .TRUE.
[3680]	733
[13286]	734	IF( check_namelist ) THEN
	735	! Check time steps
	736	IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
	737	WRITE(cl_check1,*) Agrif_Parent(rdt)
	738	WRITE(cl_check2,*) rdt
	739	WRITE(cl_check3,) rdtAgrif_Rhot()
	740	CALL ctl_stop( 'incompatible time step between grids', &
[5656]	741	& 'parent grid value : '//cl_check1 , &
	742	& 'child grid value : '//cl_check2 , &
[7646]	743	& 'value on child grid should be changed to &
[5656]	744	& :'//cl_check3 )
[13286]	745	ENDIF
[3680]	746
[13286]	747	! Check run length
	748	IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
[5656]	749	Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
[13286]	750	WRITE(cl_check1,) (Agrif_Parent(nit000)-1)Agrif_IRhot() + 1
	751	WRITE(cl_check2,) Agrif_Parent(nitend) Agrif_IRhot()
	752	CALL ctl_warn( 'incompatible run length between grids' , &
[5656]	753	& ' nit000 on fine grid will be change to : '//cl_check1, &
	754	& ' nitend on fine grid will be change to : '//cl_check2 )
[13286]	755	nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
	756	nitend = Agrif_Parent(nitend) *Agrif_IRhot()
	757	ENDIF
[3680]	758	ENDIF
[13286]	759	!
[12377]	760	END SUBROUTINE Agrif_InitValues_cont_top
[2715]	761
	762
[12377]	763	SUBROUTINE agrif_declare_var_top
[10068]	764	!!----------------------------------------------------------------------
	765	!! * ROUTINE agrif_declare_var_top *
[12377]	766	!!----------------------------------------------------------------------
	767	USE agrif_util
	768	USE agrif_oce
	769	USE dom_oce
	770	USE trc
[10068]	771	!!
[12377]	772	IMPLICIT NONE
	773	!
[14086]	774	INTEGER :: ind1, ind2, ind3, imaxrho
[10068]	775	!!----------------------------------------------------------------------
[13216]	776	!RB_CMEMS : declare here init for top
[12377]	777	! 1. Declaration of the type of variable which have to be interpolated
	778	!---------------------------------------------------------------------
[13286]	779	ind1 = nbghostcells
	780	ind2 = nn_hls + 2 + nbghostcells_x
	781	ind3 = nn_hls + 2 + nbghostcells_y_s
[14086]	782	imaxrho = MAX(Agrif_irhox(), Agrif_irhoy())
	783
[13286]	784	CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_id)
	785	CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_sponge_id)
[2715]	786
[12377]	787	! 2. Type of interpolation
	788	!-------------------------
	789	CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
	790	CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
[3680]	791
[12377]	792	! 3. Location of interpolation
	793	!-----------------------------
	794	CALL Agrif_Set_bc(trn_id,(/0,ind1-1/))
[14086]	795	CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*imaxrho-1,0/))
[3680]	796
[12377]	797	! 4. Update type
	798	!---------------
[9031]	799	# if defined UPD_HIGH
[12377]	800	CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting)
[9031]	801	#else
[12377]	802	CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
[9031]	803	#endif
[5656]	804	!
[12377]	805	END SUBROUTINE agrif_declare_var_top
[2715]	806	# endif
[13286]	807
[636]	808
[12377]	809	SUBROUTINE Agrif_detect( kg, ksizex )
[10068]	810	!!----------------------------------------------------------------------
	811	!! * ROUTINE Agrif_detect *
	812	!!----------------------------------------------------------------------
[12377]	813	INTEGER, DIMENSION(2) :: ksizex
	814	INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg
[10068]	815	!!----------------------------------------------------------------------
[12377]	816	!
	817	RETURN
	818	!
	819	END SUBROUTINE Agrif_detect
[390]	820
[13286]	821
[12377]	822	SUBROUTINE agrif_nemo_init
[10068]	823	!!----------------------------------------------------------------------
	824	!! * ROUTINE agrif_init *
	825	!!----------------------------------------------------------------------
[13286]	826	USE agrif_oce
	827	USE agrif_ice
	828	USE dom_oce
	829	USE in_out_manager
	830	USE lib_mpp
	831	!
[12377]	832	IMPLICIT NONE
	833	!
	834	INTEGER :: ios ! Local integer output status for namelist read
[13216]	835	NAMELIST/namagrif/ ln_agrif_2way, ln_init_chfrpar, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, &
[14086]	836	& ln_spc_dyn, ln_vert_remap, ln_chk_bathy
[10068]	837	!!--------------------------------------------------------------------------------------
[12377]	838	!
	839	READ ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
[11536]	840	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist' )
[12377]	841	READ ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
[11536]	842	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist' )
[12377]	843	IF(lwm) WRITE ( numond, namagrif )
	844	!
	845	IF(lwp) THEN ! control print
	846	WRITE(numout,*)
	847	WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
	848	WRITE(numout,*) '~~~~~~~~~~~~~~~'
	849	WRITE(numout,*) ' Namelist namagrif : set AGRIF parameters'
	850	WRITE(numout,*) ' Two way nesting activated ln_agrif_2way = ', ln_agrif_2way
[13216]	851	WRITE(numout,*) ' child initial state from parent ln_init_chfrpar = ', ln_init_chfrpar
	852	WRITE(numout,*) ' ad. sponge coeft for tracers rn_sponge_tra = ', rn_sponge_tra
	853	WRITE(numout,*) ' ad. sponge coeft for dynamics rn_sponge_tra = ', rn_sponge_dyn
	854	WRITE(numout,*) ' ad. time relaxation for tracers rn_trelax_tra = ', rn_trelax_tra
	855	WRITE(numout,*) ' ad. time relaxation for dynamics rn_trelax_dyn = ', rn_trelax_dyn
[12377]	856	WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn
[14086]	857	WRITE(numout,*) ' vertical remapping ln_vert_remap = ', ln_vert_remap
[12377]	858	WRITE(numout,*) ' check bathymetry ln_chk_bathy = ', ln_chk_bathy
	859	ENDIF
[13216]	860
[14086]	861	! JC => side effects of lines below to be checked:
[13216]	862	lk_west = .NOT. ( Agrif_Ix() == 1 )
[14086]	863	lk_east = .NOT. ( Agrif_Ix() + nbcellsx/AGRIF_Irhox() == Agrif_Parent(Ni0glo) -1 )
[13216]	864	lk_south = .NOT. ( Agrif_Iy() == 1 )
[14086]	865	lk_north = .NOT. ( Agrif_Iy() + nbcellsy/AGRIF_Irhoy() == Agrif_Parent(Nj0glo) -1 )
[12377]	866	!
[13216]	867	! Set the number of ghost cells according to periodicity
[13286]	868	nbghostcells_x = nbghostcells
[13216]	869	nbghostcells_y_s = nbghostcells
	870	nbghostcells_y_n = nbghostcells
[12377]	871	!
[13286]	872	IF( jperio == 1 ) nbghostcells_x = 0
	873	IF( .NOT. lk_south ) nbghostcells_y_s = 0
[14086]	874	IF( .NOT. lk_north ) nbghostcells_y_n = 0
	875	!
[13216]	876	! Some checks
[13286]	877	IF( jpiglo /= nbcellsx + 2 + 2*nn_hls + nbghostcells_x + nbghostcells_x ) CALL ctl_stop( 'STOP', &
	878	& 'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2 + 2nn_hls + 2nbghostcells_x' )
	879	IF( jpjglo /= nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n ) CALL ctl_stop( 'STOP', &
	880	& 'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n' )
[13216]	881	IF( ln_use_jattr ) CALL ctl_stop( 'STOP', 'agrif_nemo_init:Agrif children requires ln_use_jattr = .false. ' )
[12377]	882	!
[14086]	883	!
[12377]	884	END SUBROUTINE agrif_nemo_init
[3680]	885
[13286]	886
[1605]	887	# if defined key_mpp_mpi
[12377]	888	SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
[10068]	889	!!----------------------------------------------------------------------
	890	!! * ROUTINE Agrif_InvLoc *
	891	!!----------------------------------------------------------------------
[12377]	892	USE dom_oce
	893	!!
	894	IMPLICIT NONE
	895	!
	896	INTEGER :: indglob, indloc, nprocloc, i
[10068]	897	!!----------------------------------------------------------------------
[12377]	898	!
	899	SELECT CASE( i )
[13286]	900	CASE(1) ; indglob = mig(indloc)
	901	CASE(2) ; indglob = mjg(indloc)
	902	CASE DEFAULT ; indglob = indloc
[12377]	903	END SELECT
	904	!
	905	END SUBROUTINE Agrif_InvLoc
[390]	906
[13286]	907
[12377]	908	SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
[10068]	909	!!----------------------------------------------------------------------
	910	!! * ROUTINE Agrif_get_proc_info *
	911	!!----------------------------------------------------------------------
[12377]	912	USE par_oce
	913	!!
	914	IMPLICIT NONE
	915	!
	916	INTEGER, INTENT(out) :: imin, imax
	917	INTEGER, INTENT(out) :: jmin, jmax
[10068]	918	!!----------------------------------------------------------------------
[12377]	919	!
[13286]	920	imin = mig( 1 )
	921	jmin = mjg( 1 )
	922	imax = mig(jpi)
	923	jmax = mjg(jpj)
[12377]	924	!
	925	END SUBROUTINE Agrif_get_proc_info
[5656]	926
[13286]	927
[12377]	928	SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
[10068]	929	!!----------------------------------------------------------------------
	930	!! * ROUTINE Agrif_estimate_parallel_cost *
	931	!!----------------------------------------------------------------------
[12377]	932	USE par_oce
	933	!!
	934	IMPLICIT NONE
	935	!
	936	INTEGER, INTENT(in) :: imin, imax
	937	INTEGER, INTENT(in) :: jmin, jmax
	938	INTEGER, INTENT(in) :: nbprocs
	939	REAL(wp), INTENT(out) :: grid_cost
[10068]	940	!!----------------------------------------------------------------------
[12377]	941	!
	942	grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
	943	!
	944	END SUBROUTINE Agrif_estimate_parallel_cost
[5656]	945
[1605]	946	# endif
	947
[13216]	948	SUBROUTINE nemo_mapping(ndim,ptx,pty,bounds,bounds_chunks,correction_required,nb_chunks)
	949	!!----------------------------------------------------------------------
	950	!! * ROUTINE Nemo_mapping *
	951	!!----------------------------------------------------------------------
	952	USE dom_oce
	953	!!
	954	IMPLICIT NONE
	955	!
	956	INTEGER :: ndim
	957	INTEGER :: ptx, pty
	958	INTEGER, DIMENSION(ndim,2,2) :: bounds
	959	INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: bounds_chunks
	960	LOGICAL, DIMENSION(:), ALLOCATABLE :: correction_required
	961	INTEGER :: nb_chunks
	962	!
	963	INTEGER :: i
	964
	965	IF (agrif_debug_interp) THEN
	966	DO i=1,ndim
	967	WRITE(,) 'direction = ',i,bounds(i,1,2),bounds(i,2,2)
	968	ENDDO
	969	ENDIF
	970
	971	IF( bounds(2,2,2) > jpjglo) THEN
	972	IF( bounds(2,1,2) <=jpjglo) THEN
	973	nb_chunks = 2
	974	ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
	975	ALLOCATE(correction_required(nb_chunks))
	976	DO i = 1,nb_chunks
	977	bounds_chunks(i,:,:,:) = bounds
	978	END DO
	979
	980	! FIRST CHUNCK (for j<=jpjglo)
	981
	982	! Original indices
	983	bounds_chunks(1,1,1,1) = bounds(1,1,2)
	984	bounds_chunks(1,1,2,1) = bounds(1,2,2)
	985	bounds_chunks(1,2,1,1) = bounds(2,1,2)
	986	bounds_chunks(1,2,2,1) = jpjglo
	987
	988	bounds_chunks(1,1,1,2) = bounds(1,1,2)
	989	bounds_chunks(1,1,2,2) = bounds(1,2,2)
	990	bounds_chunks(1,2,1,2) = bounds(2,1,2)
	991	bounds_chunks(1,2,2,2) = jpjglo
	992
	993	! Correction required or not
	994	correction_required(1)=.FALSE.
	995
	996	! SECOND CHUNCK (for j>jpjglo)
	997
	998	! Original indices
	999	bounds_chunks(2,1,1,1) = bounds(1,1,2)
	1000	bounds_chunks(2,1,2,1) = bounds(1,2,2)
	1001	bounds_chunks(2,2,1,1) = jpjglo-2
	1002	bounds_chunks(2,2,2,1) = bounds(2,2,2)
	1003
	1004	! Where to find them
	1005	! We use the relation TAB(ji,jj)=TAB(jpiglo-ji+2,jpjglo-2-(jj-jpjglo))
	1006
	1007	IF( ptx == 2) THEN ! T, V points
	1008	bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+2
	1009	bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+2
	1010	ELSE ! U, F points
	1011	bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+1
	1012	bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+1
	1013	ENDIF
	1014
	1015	IF( pty == 2) THEN ! T, U points
	1016	bounds_chunks(2,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo)
	1017	bounds_chunks(2,2,2,2) = jpjglo-2-(jpjglo-2 -jpjglo)
	1018	ELSE ! V, F points
	1019	bounds_chunks(2,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo)
	1020	bounds_chunks(2,2,2,2) = jpjglo-3-(jpjglo-2 -jpjglo)
	1021	ENDIF
	1022	! Correction required or not
	1023	correction_required(2)=.TRUE.
	1024
	1025	ELSE
	1026	nb_chunks = 1
	1027	ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
	1028	ALLOCATE(correction_required(nb_chunks))
	1029	DO i=1,nb_chunks
	1030	bounds_chunks(i,:,:,:) = bounds
	1031	END DO
	1032
	1033	bounds_chunks(1,1,1,1) = bounds(1,1,2)
	1034	bounds_chunks(1,1,2,1) = bounds(1,2,2)
	1035	bounds_chunks(1,2,1,1) = bounds(2,1,2)
	1036	bounds_chunks(1,2,2,1) = bounds(2,2,2)
	1037
	1038	bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2
	1039	bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2
	1040
	1041	bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2)-jpjglo)
	1042	bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2)-jpjglo)
	1043
	1044	IF( ptx == 2) THEN ! T, V points
	1045	bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2
	1046	bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2
	1047	ELSE ! U, F points
	1048	bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+1
	1049	bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+1
	1050	ENDIF
	1051
	1052	IF (pty == 2) THEN ! T, U points
	1053	bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo)
	1054	bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2) -jpjglo)
	1055	ELSE ! V, F points
	1056	bounds_chunks(1,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo)
	1057	bounds_chunks(1,2,2,2) = jpjglo-3-(bounds(2,1,2) -jpjglo)
	1058	ENDIF
	1059
	1060	correction_required(1)=.TRUE.
	1061	ENDIF
	1062
	1063	ELSE IF (bounds(1,1,2) < 1) THEN
	1064	IF (bounds(1,2,2) > 0) THEN
	1065	nb_chunks = 2
	1066	ALLOCATE(correction_required(nb_chunks))
	1067	correction_required=.FALSE.
	1068	ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
	1069	DO i=1,nb_chunks
	1070	bounds_chunks(i,:,:,:) = bounds
	1071	END DO
	1072
	1073	bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2
	1074	bounds_chunks(1,1,2,2) = 1+jpiglo-2
	1075
	1076	bounds_chunks(1,1,1,1) = bounds(1,1,2)
	1077	bounds_chunks(1,1,2,1) = 1
	1078
	1079	bounds_chunks(2,1,1,2) = 2
	1080	bounds_chunks(2,1,2,2) = bounds(1,2,2)
	1081
	1082	bounds_chunks(2,1,1,1) = 2
	1083	bounds_chunks(2,1,2,1) = bounds(1,2,2)
	1084
	1085	ELSE
	1086	nb_chunks = 1
	1087	ALLOCATE(correction_required(nb_chunks))
	1088	correction_required=.FALSE.
	1089	ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
	1090	DO i=1,nb_chunks
	1091	bounds_chunks(i,:,:,:) = bounds
	1092	END DO
	1093	bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2
	1094	bounds_chunks(1,1,2,2) = bounds(1,2,2)+jpiglo-2
	1095
	1096	bounds_chunks(1,1,1,1) = bounds(1,1,2)
	1097	bounds_chunks(1,1,2,1) = bounds(1,2,2)
	1098	ENDIF
	1099	ELSE
	1100	nb_chunks=1
	1101	ALLOCATE(correction_required(nb_chunks))
	1102	correction_required=.FALSE.
	1103	ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
	1104	DO i=1,nb_chunks
	1105	bounds_chunks(i,:,:,:) = bounds
	1106	END DO
	1107	bounds_chunks(1,1,1,2) = bounds(1,1,2)
	1108	bounds_chunks(1,1,2,2) = bounds(1,2,2)
	1109	bounds_chunks(1,2,1,2) = bounds(2,1,2)
	1110	bounds_chunks(1,2,2,2) = bounds(2,2,2)
	1111
	1112	bounds_chunks(1,1,1,1) = bounds(1,1,2)
	1113	bounds_chunks(1,1,2,1) = bounds(1,2,2)
	1114	bounds_chunks(1,2,1,1) = bounds(2,1,2)
	1115	bounds_chunks(1,2,2,1) = bounds(2,2,2)
	1116	ENDIF
	1117
	1118	END SUBROUTINE nemo_mapping
	1119
	1120	FUNCTION agrif_external_switch_index(ptx,pty,i1,isens)
	1121
[13286]	1122	USE dom_oce
	1123	!
	1124	IMPLICIT NONE
[13216]	1125
[13286]	1126	INTEGER :: ptx, pty, i1, isens
	1127	INTEGER :: agrif_external_switch_index
	1128	!!----------------------------------------------------------------------
[13216]	1129
[13286]	1130	IF( isens == 1 ) THEN
	1131	IF( ptx == 2 ) THEN ! T, V points
	1132	agrif_external_switch_index = jpiglo-i1+2
	1133	ELSE ! U, F points
	1134	agrif_external_switch_index = jpiglo-i1+1
	1135	ENDIF
	1136	ELSE IF( isens ==2 ) THEN
	1137	IF ( pty == 2 ) THEN ! T, U points
	1138	agrif_external_switch_index = jpjglo-2-(i1 -jpjglo)
	1139	ELSE ! V, F points
	1140	agrif_external_switch_index = jpjglo-3-(i1 -jpjglo)
	1141	ENDIF
[13216]	1142	ENDIF
	1143
	1144	END FUNCTION agrif_external_switch_index
	1145
	1146	SUBROUTINE Correct_field(tab2d,i1,i2,j1,j2)
	1147	!!----------------------------------------------------------------------
	1148	!! * ROUTINE Correct_field *
	1149	!!----------------------------------------------------------------------
[13286]	1150	USE dom_oce
	1151	USE agrif_oce
	1152	!
	1153	IMPLICIT NONE
	1154	!
	1155	INTEGER :: i1,i2,j1,j2
	1156	REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2d
	1157	!
	1158	INTEGER :: i,j
	1159	REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2dtemp
	1160	!!----------------------------------------------------------------------
[13216]	1161
[13286]	1162	tab2dtemp = tab2d
[13216]	1163
[13286]	1164	IF( .NOT. use_sign_north ) THEN
	1165	DO j=j1,j2
	1166	DO i=i1,i2
	1167	tab2d(i,j)=tab2dtemp(i2-(i-i1),j2-(j-j1))
	1168	END DO
[13216]	1169	END DO
[13286]	1170	ELSE
	1171	DO j=j1,j2
	1172	DO i=i1,i2
	1173	tab2d(i,j)=sign_north * tab2dtemp(i2-(i-i1),j2-(j-j1))
	1174	END DO
[13216]	1175	END DO
[13286]	1176	ENDIF
[13216]	1177
	1178	END SUBROUTINE Correct_field
	1179
[390]	1180	#else
[12377]	1181	SUBROUTINE Subcalledbyagrif
[10068]	1182	!!----------------------------------------------------------------------
	1183	!! * ROUTINE Subcalledbyagrif *
	1184	!!----------------------------------------------------------------------
[12377]	1185	WRITE(,) 'Impossible to be here'
	1186	END SUBROUTINE Subcalledbyagrif
[390]	1187	#endif

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

Download in other formats: