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/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/NST – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/NST/agrif_user.F90 @ 14644

Last change on this file since 14644 was 14644, checked in by sparonuz, 3 years ago
Merge trunk -r14642:HEAD
Property svn:keywords set to `Id`
File size: 52.2 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
[14644]	65	IF (l_Iperio) THEN
[13216]	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	!
[14644]	211	CALL lbc_lnk( '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
[14644]	253	CALL lbc_lnk( '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	ENDIF
[14644]	275	!
	276	CALL mpp_sum( 'agrif_InitValues_Domain', kindic_agr )
	277	IF( kindic_agr /= 0 ) THEN
	278	CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.')
	279	ELSE
	280	IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.'
	281	IF(lwp) WRITE(numout,*) ' '
	282	ENDIF
[13216]	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.
[14200]	367	CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) ! must be called before unb_id to define ubdy
	368	CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) ! must be called before vnb_id to define vbdy
[14086]	369	CALL Agrif_Bc_variable( unb_interp_id,calledweight=1.,procname=interpunb )
	370	CALL Agrif_Bc_variable( vnb_interp_id,calledweight=1.,procname=interpvnb )
[13216]	371	use_sign_north = .FALSE.
[12377]	372	ubdy(:,:) = 0._wp
	373	vbdy(:,:) = 0._wp
[14200]	374	ELSEIF ( ln_dynspg_EXP ) THEN
[14086]	375	Agrif_UseSpecialValue = ln_spc_dyn
	376	use_sign_north = .TRUE.
	377	sign_north = -1.
[14200]	378	ubdy(:,:) = 0._wp
	379	vbdy(:,:) = 0._wp
[14086]	380	CALL Agrif_Bc_variable( unb_interp_id,calledweight=1.,procname=interpunb )
	381	CALL Agrif_Bc_variable( vnb_interp_id,calledweight=1.,procname=interpvnb )
	382	use_sign_north = .FALSE.
	383	ubdy(:,:) = 0._wp
	384	vbdy(:,:) = 0._wp
[12377]	385	ENDIF
[13216]	386	Agrif_UseSpecialValue = .FALSE.
[14086]	387	l_vremap = .FALSE.
[3680]	388
[12377]	389	!-----------------
	390	check_namelist = .TRUE.
[3680]	391
[12377]	392	IF( check_namelist ) THEN
	393	! Check free surface scheme
	394	IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.&
	395	& ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN
	396	WRITE(cl_check1,*) Agrif_Parent( ln_dynspg_ts )
	397	WRITE(cl_check2,*) ln_dynspg_ts
	398	WRITE(cl_check3,*) Agrif_Parent( ln_dynspg_exp )
	399	WRITE(cl_check4,*) ln_dynspg_exp
	400	CALL ctl_stop( 'Incompatible free surface scheme between grids' , &
	401	& 'parent grid ln_dynspg_ts :'//cl_check1 , &
	402	& 'child grid ln_dynspg_ts :'//cl_check2 , &
	403	& 'parent grid ln_dynspg_exp :'//cl_check3 , &
	404	& 'child grid ln_dynspg_exp :'//cl_check4 , &
	405	& 'those logicals should be identical' )
	406	STOP
	407	ENDIF
	408
	409	! Check if identical linear free surface option
	410	IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.&
	411	& ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN
	412	WRITE(cl_check1,*) Agrif_Parent(ln_linssh )
	413	WRITE(cl_check2,*) ln_linssh
	414	CALL ctl_stop( 'Incompatible linearized fs option between grids', &
	415	& 'parent grid ln_linssh :'//cl_check1 , &
	416	& 'child grid ln_linssh :'//cl_check2 , &
	417	& 'those logicals should be identical' )
	418	STOP
	419	ENDIF
[9031]	420	ENDIF
	421
[12377]	422	END SUBROUTINE Agrif_InitValues_cont
	423
	424	SUBROUTINE agrif_declare_var
[10068]	425	!!----------------------------------------------------------------------
[12377]	426	!! * ROUTINE agrif_declare_var *
[10068]	427	!!----------------------------------------------------------------------
[12377]	428	USE agrif_util
	429	USE agrif_oce
	430	USE par_oce
	431	USE zdf_oce
	432	USE oce
	433	!
	434	IMPLICIT NONE
	435	!
[14086]	436	INTEGER :: ind1, ind2, ind3, imaxrho
[10068]	437	!!----------------------------------------------------------------------
[2715]	438
[12377]	439	! 1. Declaration of the type of variable which have to be interpolated
	440	!---------------------------------------------------------------------
[13286]	441	ind1 = nbghostcells
	442	ind2 = nn_hls + 2 + nbghostcells_x
	443	ind3 = nn_hls + 2 + nbghostcells_y_s
[14086]	444	imaxrho = MAX(Agrif_irhox(), Agrif_irhoy())
	445
	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_interp_id)
	447	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)
	448	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]	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_interp_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_interp_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_update_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_update_id)
	453	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)
	454	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]	455
	456	CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/) ,sshn_id)
	457	CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/), unb_interp_id)
	458	CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/), vnb_interp_id)
[13286]	459	CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_interp_id)
	460	CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_interp_id)
[14086]	461	CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/), unb_sponge_id)
	462	CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/), vnb_sponge_id)
[13286]	463	CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_update_id)
	464	CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_update_id)
[14086]	465	CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/), unb_update_id)
	466	CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/), vnb_update_id)
	467	CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/) ,ub2b_cor_id)
	468	CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/) ,vb2b_cor_id)
[13286]	469	! CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),glamt_id)
	470	! CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gphit_id)
[2715]	471
[5656]	472
[13216]	473	IF( ln_zdftke.OR.ln_zdfgls ) THEN ! logical not known at this point
[13286]	474	! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
	475	! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
	476	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]	477	ENDIF
[13216]	478
[12377]	479	! 2. Type of interpolation
	480	!-------------------------
[14086]	481	CALL Agrif_Set_bcinterp( ts_interp_id,interp =AGRIF_linear)
	482	CALL Agrif_Set_bcinterp( ts_sponge_id,interp =AGRIF_linear)
[2715]	483
[14086]	484	#if defined DIV_CONS
	485	lk_tint2d_notinterp = .TRUE.
	486	CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_constant)
	487	CALL Agrif_Set_bcinterp(ub2b_cor_id,interp=AGRIF_constant)
	488	CALL Agrif_Set_bcinterp(vb2b_cor_id,interp=AGRIF_constant)
	489	CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_linearconserv)
	490	CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_linearconserv,interp2=Agrif_linear)
	491	#else
	492	lk_tint2d_notinterp = .FALSE.
	493	CALL Agrif_Set_bcinterp(sshn_id,interp =AGRIF_linear)
	494	CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
	495	CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
	496	#endif
[2715]	497
[14086]	498	CALL Agrif_Set_bcinterp(unb_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm )
	499	CALL Agrif_Set_bcinterp(vnb_interp_id,interp1=AGRIF_ppm ,interp2=Agrif_linear)
	500	CALL Agrif_Set_bcinterp(unb_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm )
	501	CALL Agrif_Set_bcinterp(vnb_sponge_id,interp1=AGRIF_ppm ,interp2=Agrif_linear)
[4326]	502
[14086]	503	CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm )
	504	CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm ,interp2=Agrif_linear)
	505
	506	CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm )
	507	CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm ,interp2=Agrif_linear)
	508
[13216]	509	IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )
	510
[5656]	511
[13286]	512	! CALL Agrif_Set_bcinterp(gphit_id,interp=AGRIF_constant)
	513	! CALL Agrif_Set_bcinterp(glamt_id,interp=AGRIF_constant)
	514
	515	! 3. Location of interpolation
[12377]	516	!-----------------------------
[14086]	517	CALL Agrif_Set_bc( ts_interp_id, (/0,ind1-1/) ) ! if west, rhox=3 and nbghost=3: columns 2 to 4
	518	CALL Agrif_Set_bc( un_interp_id, (/0,ind1-1/) )
	519	CALL Agrif_Set_bc( vn_interp_id, (/0,ind1-1/) )
[2715]	520
[14086]	521	CALL Agrif_Set_bc( ts_sponge_id, (/-nn_sponge_len*imaxrho-1,0/) ) ! if west, rhox=3, nn_sponge_len=2
	522	CALL Agrif_Set_bc( un_sponge_id, (/-nn_sponge_len*imaxrho-1,0/) ) ! and nbghost=3:
	523	CALL Agrif_Set_bc( vn_sponge_id, (/-nn_sponge_len*imaxrho-1,0/) ) ! columns 4 to 11
[4326]	524
[14086]	525	CALL Agrif_Set_bc( sshn_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
	526	CALL Agrif_Set_bc( unb_interp_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
	527	CALL Agrif_Set_bc( vnb_interp_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
	528	CALL Agrif_Set_bc(ub2b_interp_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
	529	CALL Agrif_Set_bc(vb2b_interp_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
	530	CALL Agrif_Set_bc( unb_sponge_id, (/-(nn_sponge_len+nn_shift_bar)imaxrho,-imaxrhonn_shift_bar/) )
	531	CALL Agrif_Set_bc( vnb_sponge_id, (/-(nn_sponge_len+nn_shift_bar)imaxrho,-imaxrhonn_shift_bar/) )
	532	CALL Agrif_Set_bc( ub2b_cor_id, (/-imaxrho*nn_shift_bar,ind1/) )
	533	CALL Agrif_Set_bc( vb2b_cor_id, (/-imaxrho*nn_shift_bar,ind1/) )
[14644]	534	IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1-1/) )
[13286]	535	!!$ CALL Agrif_Set_bc(glamt_id, (/0,ind1-1/) )
	536	!!$ CALL Agrif_Set_bc(gphit_id, (/0,ind1-1/) )
[2715]	537
[12377]	538	! 4. Update type
	539	!---------------
[2715]	540
[9031]	541	# if defined UPD_HIGH
[14086]	542	CALL Agrif_Set_Updatetype( ts_interp_id,update = Agrif_Update_Full_Weighting)
	543	CALL Agrif_Set_Updatetype( un_update_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)
	544	CALL Agrif_Set_Updatetype( vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )
[9031]	545
[14086]	546	CALL Agrif_Set_Updatetype( unb_update_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)
	547	CALL Agrif_Set_Updatetype( vnb_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )
[13286]	548	CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)
	549	CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )
	550	CALL Agrif_Set_Updatetype( sshn_id,update = Agrif_Update_Full_Weighting)
	551	CALL Agrif_Set_Updatetype( e3t_id,update = Agrif_Update_Full_Weighting)
[9031]	552
[13216]	553	! IF( ln_zdftke.OR.ln_zdfgls ) THEN
[12377]	554	! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting)
	555	! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting)
	556	! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting)
[13216]	557	! ENDIF
[9031]	558
	559	#else
[14086]	560	CALL Agrif_Set_Updatetype( ts_update_id,update = AGRIF_Update_Average)
	561	CALL Agrif_Set_Updatetype( un_update_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)
	562	CALL Agrif_Set_Updatetype( vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )
[3680]	563
[14086]	564	CALL Agrif_Set_Updatetype( unb_update_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)
	565	CALL Agrif_Set_Updatetype( vnb_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )
[13286]	566	CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)
	567	CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )
	568	CALL Agrif_Set_Updatetype( sshn_id,update = AGRIF_Update_Average)
	569	CALL Agrif_Set_Updatetype( e3t_id,update = AGRIF_Update_Average)
[5656]	570
[13216]	571	! IF( ln_zdftke.OR.ln_zdfgls ) THEN
[12377]	572	! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
	573	! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
	574	! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
[13216]	575	! ENDIF
[5656]	576
[9031]	577	#endif
[12377]	578	!
	579	END SUBROUTINE agrif_declare_var
[3680]	580
[9570]	581	#if defined key_si3
[13286]	582	SUBROUTINE Agrif_InitValues_cont_ice
	583	!!----------------------------------------------------------------------
	584	!! * ROUTINE Agrif_InitValues_cont_ice *
	585	!!----------------------------------------------------------------------
[12377]	586	USE Agrif_Util
	587	USE sbc_oce, ONLY : nn_fsbc ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc
	588	USE ice
	589	USE agrif_ice
	590	USE in_out_manager
	591	USE agrif_ice_interp
	592	USE lib_mpp
[13286]	593	!
	594	IMPLICIT NONE
	595	!
[10068]	596	!!----------------------------------------------------------------------
[12377]	597	! Controls
[7761]	598
[12377]	599	! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom)
	600	! the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child)
	601	! therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable
[13216]	602	! If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account
[12377]	603	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]	604
[12377]	605	! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer
	606	IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 ) THEN
	607	CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')
	608	ENDIF
	609	! First Interpolations (using "after" ice subtime step => nbstep_ice=1)
	610	!----------------------------------------------------------------------
	611	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)
	612	CALL agrif_interp_ice('U') ! interpolation of ice velocities
	613	CALL agrif_interp_ice('V') ! interpolation of ice velocities
	614	CALL agrif_interp_ice('T') ! interpolation of ice tracers
	615	nbstep_ice = 0
	616	!
	617	END SUBROUTINE Agrif_InitValues_cont_ice
[7646]	618
[13286]	619
[12377]	620	SUBROUTINE agrif_declare_var_ice
[10068]	621	!!----------------------------------------------------------------------
	622	!! * ROUTINE agrif_declare_var_ice *
	623	!!----------------------------------------------------------------------
[12377]	624	USE Agrif_Util
	625	USE ice
[13216]	626	USE par_oce, ONLY : nbghostcells, nbghostcells_x, nbghostcells_y_s
[12377]	627	!
	628	IMPLICIT NONE
	629	!
	630	INTEGER :: ind1, ind2, ind3
[13286]	631	INTEGER :: ipl
	632	!!----------------------------------------------------------------------
[12377]	633	!
	634	! 1. Declaration of the type of variable which have to be interpolated (parent=>child)
	635	! agrif_declare_variable(position,1st point index,--,--,dimensions,name)
	636	! ex.: position=> 1,1 = not-centered (in i and j)
	637	! 2,2 = centered ( - )
	638	! index => 1,1 = one ghost line
	639	! 2,2 = two ghost lines
	640	!-------------------------------------------------------------------------------------
[13286]	641	ind1 = nbghostcells
	642	ind2 = nn_hls + 2 + nbghostcells_x
	643	ind3 = nn_hls + 2 + nbghostcells_y_s
[13472]	644	ipl = jpl*(9+nlay_s+nlay_i)
[13286]	645	CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_ice_id)
	646	CALL agrif_declare_variable((/1,2/) ,(/ind2-1,ind3/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), u_ice_id)
	647	CALL agrif_declare_variable((/2,1/) ,(/ind2,ind3-1/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), v_ice_id)
[13216]	648
[13286]	649	CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_iceini_id)
	650	CALL agrif_declare_variable((/1,2/) ,(/ind2-1,ind3/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), u_iceini_id)
	651	CALL agrif_declare_variable((/2,1/) ,(/ind2,ind3-1/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), v_iceini_id)
[7646]	652
[12377]	653	! 2. Set interpolations (normal & tangent to the grid cell for velocities)
	654	!-----------------------------------
	655	CALL Agrif_Set_bcinterp(tra_ice_id, interp = AGRIF_linear)
	656	CALL Agrif_Set_bcinterp(u_ice_id , interp1 = Agrif_linear,interp2 = AGRIF_ppm )
	657	CALL Agrif_Set_bcinterp(v_ice_id , interp1 = AGRIF_ppm ,interp2 = Agrif_linear)
[7646]	658
[13216]	659	CALL Agrif_Set_bcinterp(tra_iceini_id, interp = AGRIF_linear)
	660	CALL Agrif_Set_interp (tra_iceini_id, interp = AGRIF_linear)
[14086]	661	CALL Agrif_Set_bcinterp(u_iceini_id , interp = AGRIF_linear)
	662	CALL Agrif_Set_interp (u_iceini_id , interp = AGRIF_linear)
[13216]	663	CALL Agrif_Set_bcinterp(v_iceini_id , interp = AGRIF_linear)
	664	CALL Agrif_Set_interp (v_iceini_id , interp = AGRIF_linear)
	665
[12377]	666	! 3. Set location of interpolations
	667	!----------------------------------
	668	CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/))
	669	CALL Agrif_Set_bc(u_ice_id ,(/0,ind1/))
	670	CALL Agrif_Set_bc(v_ice_id ,(/0,ind1/))
[7646]	671
[13216]	672	CALL Agrif_Set_bc(tra_iceini_id,(/0,ind1/))
	673	CALL Agrif_Set_bc(u_iceini_id ,(/0,ind1/))
	674	CALL Agrif_Set_bc(v_iceini_id ,(/0,ind1/))
	675
[12377]	676	! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
	677	!--------------------------------------------------
[9134]	678	# if defined UPD_HIGH
[12377]	679	CALL Agrif_Set_Updatetype(tra_ice_id, update = Agrif_Update_Full_Weighting)
	680	CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)
	681	CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )
[13216]	682	# else
[12377]	683	CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average)
	684	CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)
	685	CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )
[13216]	686	# endif
[7646]	687
[12377]	688	END SUBROUTINE agrif_declare_var_ice
[7646]	689	#endif
	690
	691
[2715]	692	# if defined key_top
[12377]	693	SUBROUTINE Agrif_InitValues_cont_top
[10068]	694	!!----------------------------------------------------------------------
	695	!! * ROUTINE Agrif_InitValues_cont_top *
[12377]	696	!!----------------------------------------------------------------------
	697	USE Agrif_Util
	698	USE oce
	699	USE dom_oce
	700	USE nemogcm
	701	USE par_trc
	702	USE lib_mpp
	703	USE trc
	704	USE in_out_manager
	705	USE agrif_oce_sponge
	706	USE agrif_top_update
	707	USE agrif_top_interp
	708	USE agrif_top_sponge
[13286]	709	!
	710	IMPLICIT NONE
	711	!
	712	CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
	713	LOGICAL :: check_namelist
[10068]	714	!!----------------------------------------------------------------------
[1300]	715
[13286]	716	! 1. Declaration of the type of variable which have to be interpolated
	717	!---------------------------------------------------------------------
	718	CALL agrif_declare_var_top
[1300]	719
[13286]	720	! 2. First interpolations of potentially non zero fields
	721	!-------------------------------------------------------
	722	Agrif_SpecialValue=0._wp
	723	Agrif_UseSpecialValue = .TRUE.
	724	CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
	725	Agrif_UseSpecialValue = .FALSE.
	726	CALL Agrif_Sponge
	727	tabspongedone_trn = .FALSE.
	728	CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
	729	! reset tsa to zero
[14086]	730	tr(:,:,:,:,Krhs_a) = 0._wp
[3680]	731
[13286]	732	! 3. Some controls
	733	!-----------------
	734	check_namelist = .TRUE.
[3680]	735
[13286]	736	IF( check_namelist ) THEN
	737	! Check time steps
	738	IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
	739	WRITE(cl_check1,*) Agrif_Parent(rdt)
	740	WRITE(cl_check2,*) rdt
	741	WRITE(cl_check3,) rdtAgrif_Rhot()
	742	CALL ctl_stop( 'incompatible time step between grids', &
[5656]	743	& 'parent grid value : '//cl_check1 , &
	744	& 'child grid value : '//cl_check2 , &
[7646]	745	& 'value on child grid should be changed to &
[5656]	746	& :'//cl_check3 )
[13286]	747	ENDIF
[3680]	748
[13286]	749	! Check run length
	750	IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
[5656]	751	Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
[13286]	752	WRITE(cl_check1,) (Agrif_Parent(nit000)-1)Agrif_IRhot() + 1
	753	WRITE(cl_check2,) Agrif_Parent(nitend) Agrif_IRhot()
	754	CALL ctl_warn( 'incompatible run length between grids' , &
[5656]	755	& ' nit000 on fine grid will be change to : '//cl_check1, &
	756	& ' nitend on fine grid will be change to : '//cl_check2 )
[13286]	757	nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
	758	nitend = Agrif_Parent(nitend) *Agrif_IRhot()
	759	ENDIF
[3680]	760	ENDIF
[13286]	761	!
[12377]	762	END SUBROUTINE Agrif_InitValues_cont_top
[2715]	763
	764
[12377]	765	SUBROUTINE agrif_declare_var_top
[10068]	766	!!----------------------------------------------------------------------
	767	!! * ROUTINE agrif_declare_var_top *
[12377]	768	!!----------------------------------------------------------------------
	769	USE agrif_util
	770	USE agrif_oce
	771	USE dom_oce
	772	USE trc
[10068]	773	!!
[12377]	774	IMPLICIT NONE
	775	!
[14086]	776	INTEGER :: ind1, ind2, ind3, imaxrho
[10068]	777	!!----------------------------------------------------------------------
[13216]	778	!RB_CMEMS : declare here init for top
[12377]	779	! 1. Declaration of the type of variable which have to be interpolated
	780	!---------------------------------------------------------------------
[13286]	781	ind1 = nbghostcells
	782	ind2 = nn_hls + 2 + nbghostcells_x
	783	ind3 = nn_hls + 2 + nbghostcells_y_s
[14086]	784	imaxrho = MAX(Agrif_irhox(), Agrif_irhoy())
	785
[13286]	786	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)
	787	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]	788
[12377]	789	! 2. Type of interpolation
	790	!-------------------------
	791	CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
	792	CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
[3680]	793
[12377]	794	! 3. Location of interpolation
	795	!-----------------------------
	796	CALL Agrif_Set_bc(trn_id,(/0,ind1-1/))
[14086]	797	CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*imaxrho-1,0/))
[3680]	798
[12377]	799	! 4. Update type
	800	!---------------
[9031]	801	# if defined UPD_HIGH
[12377]	802	CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting)
[9031]	803	#else
[12377]	804	CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
[9031]	805	#endif
[5656]	806	!
[12377]	807	END SUBROUTINE agrif_declare_var_top
[2715]	808	# endif
[13286]	809
[636]	810
[12377]	811	SUBROUTINE Agrif_detect( kg, ksizex )
[10068]	812	!!----------------------------------------------------------------------
	813	!! * ROUTINE Agrif_detect *
	814	!!----------------------------------------------------------------------
[12377]	815	INTEGER, DIMENSION(2) :: ksizex
	816	INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg
[10068]	817	!!----------------------------------------------------------------------
[12377]	818	!
	819	RETURN
	820	!
	821	END SUBROUTINE Agrif_detect
[390]	822
[13286]	823
[12377]	824	SUBROUTINE agrif_nemo_init
[10068]	825	!!----------------------------------------------------------------------
	826	!! * ROUTINE agrif_init *
	827	!!----------------------------------------------------------------------
[13286]	828	USE agrif_oce
	829	USE agrif_ice
	830	USE dom_oce
	831	USE in_out_manager
	832	USE lib_mpp
	833	!
[12377]	834	IMPLICIT NONE
	835	!
	836	INTEGER :: ios ! Local integer output status for namelist read
[13216]	837	NAMELIST/namagrif/ ln_agrif_2way, ln_init_chfrpar, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, &
[14086]	838	& ln_spc_dyn, ln_vert_remap, ln_chk_bathy
[10068]	839	!!--------------------------------------------------------------------------------------
[12377]	840	!
	841	READ ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
[11536]	842	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist' )
[12377]	843	READ ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
[11536]	844	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist' )
[12377]	845	IF(lwm) WRITE ( numond, namagrif )
	846	!
	847	IF(lwp) THEN ! control print
	848	WRITE(numout,*)
	849	WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
	850	WRITE(numout,*) '~~~~~~~~~~~~~~~'
	851	WRITE(numout,*) ' Namelist namagrif : set AGRIF parameters'
	852	WRITE(numout,*) ' Two way nesting activated ln_agrif_2way = ', ln_agrif_2way
[13216]	853	WRITE(numout,*) ' child initial state from parent ln_init_chfrpar = ', ln_init_chfrpar
	854	WRITE(numout,*) ' ad. sponge coeft for tracers rn_sponge_tra = ', rn_sponge_tra
	855	WRITE(numout,*) ' ad. sponge coeft for dynamics rn_sponge_tra = ', rn_sponge_dyn
	856	WRITE(numout,*) ' ad. time relaxation for tracers rn_trelax_tra = ', rn_trelax_tra
	857	WRITE(numout,*) ' ad. time relaxation for dynamics rn_trelax_dyn = ', rn_trelax_dyn
[12377]	858	WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn
[14086]	859	WRITE(numout,*) ' vertical remapping ln_vert_remap = ', ln_vert_remap
[12377]	860	WRITE(numout,*) ' check bathymetry ln_chk_bathy = ', ln_chk_bathy
	861	ENDIF
[13216]	862
[14086]	863	! JC => side effects of lines below to be checked:
[13216]	864	lk_west = .NOT. ( Agrif_Ix() == 1 )
[14086]	865	lk_east = .NOT. ( Agrif_Ix() + nbcellsx/AGRIF_Irhox() == Agrif_Parent(Ni0glo) -1 )
[13216]	866	lk_south = .NOT. ( Agrif_Iy() == 1 )
[14086]	867	lk_north = .NOT. ( Agrif_Iy() + nbcellsy/AGRIF_Irhoy() == Agrif_Parent(Nj0glo) -1 )
[12377]	868	!
[13216]	869	! Set the number of ghost cells according to periodicity
[13286]	870	nbghostcells_x = nbghostcells
[13216]	871	nbghostcells_y_s = nbghostcells
	872	nbghostcells_y_n = nbghostcells
[12377]	873	!
[14644]	874	IF( l_Iperio ) nbghostcells_x = 0
[13286]	875	IF( .NOT. lk_south ) nbghostcells_y_s = 0
[14086]	876	IF( .NOT. lk_north ) nbghostcells_y_n = 0
	877	!
[13216]	878	! Some checks
[14200]	879	IF( (.NOT.ln_vert_remap).AND.(jpkglo>Agrif_Parent(jpkglo)) ) CALL ctl_stop( 'STOP', &
	880	& 'agrif_nemo_init: Agrif children must have less or equal number of vertical levels without ln_vert_remap defined' )
[13286]	881	IF( jpiglo /= nbcellsx + 2 + 2*nn_hls + nbghostcells_x + nbghostcells_x ) CALL ctl_stop( 'STOP', &
	882	& 'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2 + 2nn_hls + 2nbghostcells_x' )
	883	IF( jpjglo /= nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n ) CALL ctl_stop( 'STOP', &
	884	& 'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n' )
[13216]	885	IF( ln_use_jattr ) CALL ctl_stop( 'STOP', 'agrif_nemo_init:Agrif children requires ln_use_jattr = .false. ' )
[12377]	886	!
[14086]	887	!
[12377]	888	END SUBROUTINE agrif_nemo_init
[3680]	889
[13286]	890
[14644]	891	# if ! defined key_mpi_off
[12377]	892	SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
[10068]	893	!!----------------------------------------------------------------------
	894	!! * ROUTINE Agrif_InvLoc *
	895	!!----------------------------------------------------------------------
[12377]	896	USE dom_oce
	897	!!
	898	IMPLICIT NONE
	899	!
	900	INTEGER :: indglob, indloc, nprocloc, i
[10068]	901	!!----------------------------------------------------------------------
[12377]	902	!
	903	SELECT CASE( i )
[13286]	904	CASE(1) ; indglob = mig(indloc)
	905	CASE(2) ; indglob = mjg(indloc)
	906	CASE DEFAULT ; indglob = indloc
[12377]	907	END SELECT
	908	!
	909	END SUBROUTINE Agrif_InvLoc
[390]	910
[13286]	911
[12377]	912	SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
[10068]	913	!!----------------------------------------------------------------------
	914	!! * ROUTINE Agrif_get_proc_info *
	915	!!----------------------------------------------------------------------
[12377]	916	USE par_oce
	917	!!
	918	IMPLICIT NONE
	919	!
	920	INTEGER, INTENT(out) :: imin, imax
	921	INTEGER, INTENT(out) :: jmin, jmax
[10068]	922	!!----------------------------------------------------------------------
[12377]	923	!
[13286]	924	imin = mig( 1 )
	925	jmin = mjg( 1 )
	926	imax = mig(jpi)
	927	jmax = mjg(jpj)
[12377]	928	!
	929	END SUBROUTINE Agrif_get_proc_info
[5656]	930
[13286]	931
[12377]	932	SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
[10068]	933	!!----------------------------------------------------------------------
	934	!! * ROUTINE Agrif_estimate_parallel_cost *
	935	!!----------------------------------------------------------------------
[12377]	936	USE par_oce
	937	!!
	938	IMPLICIT NONE
	939	!
	940	INTEGER, INTENT(in) :: imin, imax
	941	INTEGER, INTENT(in) :: jmin, jmax
	942	INTEGER, INTENT(in) :: nbprocs
	943	REAL(wp), INTENT(out) :: grid_cost
[10068]	944	!!----------------------------------------------------------------------
[12377]	945	!
	946	grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
	947	!
	948	END SUBROUTINE Agrif_estimate_parallel_cost
[5656]	949
[1605]	950	# endif
	951
[13216]	952	SUBROUTINE nemo_mapping(ndim,ptx,pty,bounds,bounds_chunks,correction_required,nb_chunks)
	953	!!----------------------------------------------------------------------
	954	!! * ROUTINE Nemo_mapping *
	955	!!----------------------------------------------------------------------
	956	USE dom_oce
	957	!!
	958	IMPLICIT NONE
	959	!
	960	INTEGER :: ndim
	961	INTEGER :: ptx, pty
	962	INTEGER, DIMENSION(ndim,2,2) :: bounds
	963	INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: bounds_chunks
	964	LOGICAL, DIMENSION(:), ALLOCATABLE :: correction_required
	965	INTEGER :: nb_chunks
	966	!
	967	INTEGER :: i
	968
	969	IF (agrif_debug_interp) THEN
	970	DO i=1,ndim
	971	WRITE(,) 'direction = ',i,bounds(i,1,2),bounds(i,2,2)
	972	ENDDO
	973	ENDIF
	974
	975	IF( bounds(2,2,2) > jpjglo) THEN
	976	IF( bounds(2,1,2) <=jpjglo) THEN
	977	nb_chunks = 2
	978	ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
	979	ALLOCATE(correction_required(nb_chunks))
	980	DO i = 1,nb_chunks
	981	bounds_chunks(i,:,:,:) = bounds
	982	END DO
	983
	984	! FIRST CHUNCK (for j<=jpjglo)
	985
	986	! Original indices
	987	bounds_chunks(1,1,1,1) = bounds(1,1,2)
	988	bounds_chunks(1,1,2,1) = bounds(1,2,2)
	989	bounds_chunks(1,2,1,1) = bounds(2,1,2)
	990	bounds_chunks(1,2,2,1) = jpjglo
	991
	992	bounds_chunks(1,1,1,2) = bounds(1,1,2)
	993	bounds_chunks(1,1,2,2) = bounds(1,2,2)
	994	bounds_chunks(1,2,1,2) = bounds(2,1,2)
	995	bounds_chunks(1,2,2,2) = jpjglo
	996
	997	! Correction required or not
	998	correction_required(1)=.FALSE.
	999
	1000	! SECOND CHUNCK (for j>jpjglo)
	1001
	1002	! Original indices
	1003	bounds_chunks(2,1,1,1) = bounds(1,1,2)
	1004	bounds_chunks(2,1,2,1) = bounds(1,2,2)
	1005	bounds_chunks(2,2,1,1) = jpjglo-2
	1006	bounds_chunks(2,2,2,1) = bounds(2,2,2)
	1007
	1008	! Where to find them
	1009	! We use the relation TAB(ji,jj)=TAB(jpiglo-ji+2,jpjglo-2-(jj-jpjglo))
	1010
	1011	IF( ptx == 2) THEN ! T, V points
	1012	bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+2
	1013	bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+2
	1014	ELSE ! U, F points
	1015	bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+1
	1016	bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+1
	1017	ENDIF
	1018
	1019	IF( pty == 2) THEN ! T, U points
	1020	bounds_chunks(2,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo)
	1021	bounds_chunks(2,2,2,2) = jpjglo-2-(jpjglo-2 -jpjglo)
	1022	ELSE ! V, F points
	1023	bounds_chunks(2,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo)
	1024	bounds_chunks(2,2,2,2) = jpjglo-3-(jpjglo-2 -jpjglo)
	1025	ENDIF
	1026	! Correction required or not
	1027	correction_required(2)=.TRUE.
	1028
	1029	ELSE
	1030	nb_chunks = 1
	1031	ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
	1032	ALLOCATE(correction_required(nb_chunks))
	1033	DO i=1,nb_chunks
	1034	bounds_chunks(i,:,:,:) = bounds
	1035	END DO
	1036
	1037	bounds_chunks(1,1,1,1) = bounds(1,1,2)
	1038	bounds_chunks(1,1,2,1) = bounds(1,2,2)
	1039	bounds_chunks(1,2,1,1) = bounds(2,1,2)
	1040	bounds_chunks(1,2,2,1) = bounds(2,2,2)
	1041
	1042	bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2
	1043	bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2
	1044
	1045	bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2)-jpjglo)
	1046	bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2)-jpjglo)
	1047
	1048	IF( ptx == 2) THEN ! T, V points
	1049	bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2
	1050	bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2
	1051	ELSE ! U, F points
	1052	bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+1
	1053	bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+1
	1054	ENDIF
	1055
	1056	IF (pty == 2) THEN ! T, U points
	1057	bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo)
	1058	bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2) -jpjglo)
	1059	ELSE ! V, F points
	1060	bounds_chunks(1,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo)
	1061	bounds_chunks(1,2,2,2) = jpjglo-3-(bounds(2,1,2) -jpjglo)
	1062	ENDIF
	1063
	1064	correction_required(1)=.TRUE.
	1065	ENDIF
	1066
	1067	ELSE IF (bounds(1,1,2) < 1) THEN
	1068	IF (bounds(1,2,2) > 0) THEN
	1069	nb_chunks = 2
	1070	ALLOCATE(correction_required(nb_chunks))
	1071	correction_required=.FALSE.
	1072	ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
	1073	DO i=1,nb_chunks
	1074	bounds_chunks(i,:,:,:) = bounds
	1075	END DO
	1076
	1077	bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2
	1078	bounds_chunks(1,1,2,2) = 1+jpiglo-2
	1079
	1080	bounds_chunks(1,1,1,1) = bounds(1,1,2)
	1081	bounds_chunks(1,1,2,1) = 1
	1082
	1083	bounds_chunks(2,1,1,2) = 2
	1084	bounds_chunks(2,1,2,2) = bounds(1,2,2)
	1085
	1086	bounds_chunks(2,1,1,1) = 2
	1087	bounds_chunks(2,1,2,1) = bounds(1,2,2)
	1088
	1089	ELSE
	1090	nb_chunks = 1
	1091	ALLOCATE(correction_required(nb_chunks))
	1092	correction_required=.FALSE.
	1093	ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
	1094	DO i=1,nb_chunks
	1095	bounds_chunks(i,:,:,:) = bounds
	1096	END DO
	1097	bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2
	1098	bounds_chunks(1,1,2,2) = bounds(1,2,2)+jpiglo-2
	1099
	1100	bounds_chunks(1,1,1,1) = bounds(1,1,2)
	1101	bounds_chunks(1,1,2,1) = bounds(1,2,2)
	1102	ENDIF
	1103	ELSE
	1104	nb_chunks=1
	1105	ALLOCATE(correction_required(nb_chunks))
	1106	correction_required=.FALSE.
	1107	ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
	1108	DO i=1,nb_chunks
	1109	bounds_chunks(i,:,:,:) = bounds
	1110	END DO
	1111	bounds_chunks(1,1,1,2) = bounds(1,1,2)
	1112	bounds_chunks(1,1,2,2) = bounds(1,2,2)
	1113	bounds_chunks(1,2,1,2) = bounds(2,1,2)
	1114	bounds_chunks(1,2,2,2) = bounds(2,2,2)
	1115
	1116	bounds_chunks(1,1,1,1) = bounds(1,1,2)
	1117	bounds_chunks(1,1,2,1) = bounds(1,2,2)
	1118	bounds_chunks(1,2,1,1) = bounds(2,1,2)
	1119	bounds_chunks(1,2,2,1) = bounds(2,2,2)
	1120	ENDIF
	1121
	1122	END SUBROUTINE nemo_mapping
	1123
	1124	FUNCTION agrif_external_switch_index(ptx,pty,i1,isens)
	1125
[13286]	1126	USE dom_oce
	1127	!
	1128	IMPLICIT NONE
[13216]	1129
[13286]	1130	INTEGER :: ptx, pty, i1, isens
	1131	INTEGER :: agrif_external_switch_index
	1132	!!----------------------------------------------------------------------
[13216]	1133
[13286]	1134	IF( isens == 1 ) THEN
	1135	IF( ptx == 2 ) THEN ! T, V points
	1136	agrif_external_switch_index = jpiglo-i1+2
	1137	ELSE ! U, F points
	1138	agrif_external_switch_index = jpiglo-i1+1
	1139	ENDIF
	1140	ELSE IF( isens ==2 ) THEN
	1141	IF ( pty == 2 ) THEN ! T, U points
	1142	agrif_external_switch_index = jpjglo-2-(i1 -jpjglo)
	1143	ELSE ! V, F points
	1144	agrif_external_switch_index = jpjglo-3-(i1 -jpjglo)
	1145	ENDIF
[13216]	1146	ENDIF
	1147
	1148	END FUNCTION agrif_external_switch_index
	1149
	1150	SUBROUTINE Correct_field(tab2d,i1,i2,j1,j2)
	1151	!!----------------------------------------------------------------------
	1152	!! * ROUTINE Correct_field *
	1153	!!----------------------------------------------------------------------
[13286]	1154	USE dom_oce
	1155	USE agrif_oce
	1156	!
	1157	IMPLICIT NONE
	1158	!
	1159	INTEGER :: i1,i2,j1,j2
	1160	REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2d
	1161	!
	1162	INTEGER :: i,j
	1163	REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2dtemp
	1164	!!----------------------------------------------------------------------
[13216]	1165
[13286]	1166	tab2dtemp = tab2d
[13216]	1167
[13286]	1168	IF( .NOT. use_sign_north ) THEN
	1169	DO j=j1,j2
	1170	DO i=i1,i2
	1171	tab2d(i,j)=tab2dtemp(i2-(i-i1),j2-(j-j1))
	1172	END DO
[13216]	1173	END DO
[13286]	1174	ELSE
	1175	DO j=j1,j2
	1176	DO i=i1,i2
	1177	tab2d(i,j)=sign_north * tab2dtemp(i2-(i-i1),j2-(j-j1))
	1178	END DO
[13216]	1179	END DO
[13286]	1180	ENDIF
[13216]	1181
	1182	END SUBROUTINE Correct_field
	1183
[390]	1184	#else
[12377]	1185	SUBROUTINE Subcalledbyagrif
[10068]	1186	!!----------------------------------------------------------------------
	1187	!! * ROUTINE Subcalledbyagrif *
	1188	!!----------------------------------------------------------------------
[12377]	1189	WRITE(,) 'Impossible to be here'
	1190	END SUBROUTINE Subcalledbyagrif
[390]	1191	#endif

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

Download in other formats: