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_oce_interp.F90 in NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/NST – NEMO

Context Navigation

source: NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/NST/agrif_oce_interp.F90 @ 14675

Last change on this file since 14675 was 14641, checked in by jchanut, 3 years ago
1) Revise boundary checking with AGRIF (unify vertical remaping case or not) 2) Disable parent volume check without vertical remaping until we sort out what to do in the damned overlapping zone. At this stage DOMAINcfg produces meshes in agreement with what NEMO expects, except for cyclic East-West child grids for which a mismatch persists at boundaries. Child grids over North Pole Fold or East-West boundaries are however correct, #2638
Property svn:keywords set to `Id`
File size: 73.9 KB

Rev	Line
[9570]	1	MODULE agrif_oce_interp
[1605]	2	!!======================================================================
[9570]	3	!! * MODULE agrif_oce_interp *
[14227]	4	!! AGRIF: interpolation package for the ocean dynamics (OCE)
[1605]	5	!!======================================================================
[9019]	6	!! History : 2.0 ! 2002-06 (L. Debreu) Original cade
[1605]	7	!! 3.2 ! 2009-04 (R. Benshila)
[5656]	8	!! 3.6 ! 2014-09 (R. Benshila)
[1605]	9	!!----------------------------------------------------------------------
[7646]	10	#if defined key_agrif
[1605]	11	!!----------------------------------------------------------------------
	12	!! 'key_agrif' AGRIF zoom
	13	!!----------------------------------------------------------------------
	14	!! Agrif_tra :
	15	!! Agrif_dyn :
[9019]	16	!! Agrif_ssh :
	17	!! Agrif_dyn_ts :
	18	!! Agrif_dta_ts :
	19	!! Agrif_ssh_ts :
	20	!! Agrif_avm :
[1605]	21	!! interpu :
	22	!! interpv :
	23	!!----------------------------------------------------------------------
[636]	24	USE par_oce
	25	USE oce
	26	USE dom_oce
[6140]	27	USE zdf_oce
[782]	28	USE agrif_oce
[1605]	29	USE phycst
[14053]	30	!!! USE dynspg_ts, ONLY: un_adv, vn_adv
[6140]	31	!
[1605]	32	USE in_out_manager
[9570]	33	USE agrif_oce_sponge
[2715]	34	USE lib_mpp
[12377]	35	USE vremap
[13216]	36	USE lbclnk
[5656]	37
[636]	38	IMPLICIT NONE
	39	PRIVATE
[4292]	40
[12377]	41	PUBLIC Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_dyn_ts_flux, Agrif_ssh_ts, Agrif_dta_ts
[9057]	42	PUBLIC Agrif_tra, Agrif_avm
[9019]	43	PUBLIC interpun , interpvn
[9057]	44	PUBLIC interptsn, interpsshn, interpavm
[9019]	45	PUBLIC interpunb, interpvnb , interpub2b, interpvb2b
[14641]	46	PUBLIC interpglamt, interpgphit
[14086]	47	PUBLIC interpht0, interpmbkt, interpe3t0_vremap
	48	PUBLIC agrif_istate_oce, agrif_istate_ssh ! called by icestate.F90 and domvvl.F90
	49	PUBLIC agrif_check_bat
[13216]	50
[6140]	51	INTEGER :: bdy_tinterp = 0
	52
[14053]	53	!! * Substitutions
	54	# include "domzgr_substitute.h90"
[9598]	55	!! NEMO/NST 4.0 , NEMO Consortium (2018)
[1156]	56	!! $Id$
[10068]	57	!! Software governed by the CeCILL license (see ./LICENSE)
[1156]	58	!!----------------------------------------------------------------------
[5656]	59	CONTAINS
	60
[14086]	61	SUBROUTINE Agrif_istate_oce( Kbb, Kmm, Kaa )
	62	!!----------------------------------------------------------------------
	63	!! * ROUTINE agrif_istate_oce *
	64	!!
	65	!! set initial t, s, u, v, ssh from parent
	66	!!----------------------------------------------------------------------
	67	!
	68	IMPLICIT NONE
	69	!
	70	INTEGER, INTENT(in) :: Kbb, Kmm, Kaa
	71	INTEGER :: jn
	72	!!----------------------------------------------------------------------
	73	IF(lwp) WRITE(numout,*) ' '
	74	IF(lwp) WRITE(numout,*) 'Agrif_istate_oce : interp child initial state from parent'
	75	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~'
	76	IF(lwp) WRITE(numout,*) ' '
	77
	78	IF ( .NOT.Agrif_Parent(l_1st_euler) ) &
	79	& CALL ctl_stop('AGRIF hot start requires to force Euler first step on parent')
	80
	81	l_ini_child = .TRUE.
	82	Agrif_SpecialValue = 0.0_wp
	83	Agrif_UseSpecialValue = .TRUE.
	84
[14170]	85	ts(:,:,:,:,Kbb) = 0.0_wp
	86	uu(:,:,:,Kbb) = 0.0_wp
	87	vv(:,:,:,Kbb) = 0.0_wp
[14086]	88
	89	Krhs_a = Kbb ; Kmm_a = Kbb
	90
	91	CALL Agrif_Init_Variable(tsini_id, procname=interptsn)
	92
	93	Agrif_UseSpecialValue = ln_spc_dyn
	94	use_sign_north = .TRUE.
	95	sign_north = -1._wp
	96	CALL Agrif_Init_Variable(uini_id , procname=interpun )
	97	CALL Agrif_Init_Variable(vini_id , procname=interpvn )
	98	use_sign_north = .FALSE.
	99
	100	Agrif_UseSpecialValue = .FALSE.
	101	l_ini_child = .FALSE.
	102
	103	Krhs_a = Kaa ; Kmm_a = Kmm
	104
	105	DO jn = 1, jpts
	106	ts(:,:,:,jn,Kbb) = ts(:,:,:,jn,Kbb) * tmask(:,:,:)
	107	END DO
	108	uu(:,:,:,Kbb) = uu(:,:,:,Kbb) * umask(:,:,:)
	109	vv(:,:,:,Kbb) = vv(:,:,:,Kbb) * vmask(:,:,:)
	110
[14433]	111	CALL lbc_lnk( 'agrif_istate_oce', uu(:,:,: ,Kbb), 'U', -1.0_wp , vv(:,:,:,Kbb), 'V', -1.0_wp )
[14086]	112	CALL lbc_lnk( 'agrif_istate_oce', ts(:,:,:,:,Kbb), 'T', 1.0_wp )
	113
	114	END SUBROUTINE Agrif_istate_oce
	115
	116
[14170]	117	SUBROUTINE Agrif_istate_ssh( Kbb, Kmm, Kaa )
[14086]	118	!!----------------------------------------------------------------------
	119	!! * ROUTINE agrif_istate_ssh *
	120	!!
	121	!! set initial ssh from parent
	122	!!----------------------------------------------------------------------
	123	!
	124	IMPLICIT NONE
	125	!
[14170]	126	INTEGER, INTENT(in) :: Kbb, Kmm, Kaa
[14086]	127	!!----------------------------------------------------------------------
	128	IF(lwp) WRITE(numout,*) ' '
	129	IF(lwp) WRITE(numout,*) 'Agrif_istate_ssh : interp child ssh from parent'
	130	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~'
	131	IF(lwp) WRITE(numout,*) ' '
	132
	133	IF ( .NOT.Agrif_Parent(l_1st_euler) ) &
	134	& CALL ctl_stop('AGRIF hot start requires to force Euler first step on parent')
	135
[14170]	136	Krhs_a = Kbb ; Kmm_a = Kbb
	137	!
[14086]	138	Agrif_SpecialValue = 0._wp
	139	Agrif_UseSpecialValue = .TRUE.
	140	l_ini_child = .TRUE.
	141	!
[14170]	142	ssh(:,:,Kbb) = 0._wp
[14086]	143	CALL Agrif_Init_Variable(sshini_id, procname=interpsshn)
	144	!
	145	Agrif_UseSpecialValue = .FALSE.
	146	l_ini_child = .FALSE.
[14170]	147	!
	148	Krhs_a = Kaa ; Kmm_a = Kmm
	149	!
	150	CALL lbc_lnk( 'Agrif_istate_ssh', ssh(:,:,Kbb), 'T', 1._wp )
	151	!
	152	ssh(:,:,Kmm) = ssh(:,:,Kbb)
	153	ssh(:,:,Kaa) = 0._wp
[14086]	154
	155	END SUBROUTINE Agrif_istate_ssh
	156
	157
[782]	158	SUBROUTINE Agrif_tra
[1605]	159	!!----------------------------------------------------------------------
[5656]	160	!! * ROUTINE Agrif_tra *
[1605]	161	!!----------------------------------------------------------------------
[636]	162	!
[1605]	163	IF( Agrif_Root() ) RETURN
[6140]	164	!
	165	Agrif_SpecialValue = 0._wp
[636]	166	Agrif_UseSpecialValue = .TRUE.
[14086]	167	l_vremap = ln_vert_remap
[6140]	168	!
[14086]	169	CALL Agrif_Bc_variable( ts_interp_id, procname=interptsn )
[6140]	170	!
[636]	171	Agrif_UseSpecialValue = .FALSE.
[14086]	172	l_vremap = .FALSE.
[1605]	173	!
[636]	174	END SUBROUTINE Agrif_tra
	175
[1605]	176
[636]	177	SUBROUTINE Agrif_dyn( kt )
[1605]	178	!!----------------------------------------------------------------------
	179	!! * ROUTINE Agrif_DYN *
	180	!!----------------------------------------------------------------------
	181	INTEGER, INTENT(in) :: kt
[6140]	182	!
	183	INTEGER :: ji, jj, jk ! dummy loop indices
[9057]	184	INTEGER :: ibdy1, jbdy1, ibdy2, jbdy2
[9019]	185	REAL(wp), DIMENSION(jpi,jpj) :: zub, zvb
[1605]	186	!!----------------------------------------------------------------------
[6140]	187	!
[1605]	188	IF( Agrif_Root() ) RETURN
[6140]	189	!
[13286]	190	Agrif_SpecialValue = 0.0_wp
[5656]	191	Agrif_UseSpecialValue = ln_spc_dyn
[14086]	192	l_vremap = ln_vert_remap
[6140]	193	!
[13216]	194	use_sign_north = .TRUE.
[13286]	195	sign_north = -1.0_wp
[6140]	196	CALL Agrif_Bc_variable( un_interp_id, procname=interpun )
	197	CALL Agrif_Bc_variable( vn_interp_id, procname=interpvn )
[14086]	198
	199	IF( .NOT.ln_dynspg_ts ) THEN ! Get transports
[14170]	200	ubdy(:,:) = 0._wp ; vbdy(:,:) = 0._wp
	201	utint_stage(:,:) = 0 ; vtint_stage(:,:) = 0
[14086]	202	CALL Agrif_Bc_variable( unb_interp_id, procname=interpunb )
	203	CALL Agrif_Bc_variable( vnb_interp_id, procname=interpvnb )
	204	ENDIF
	205
[13216]	206	use_sign_north = .FALSE.
[6140]	207	!
[5656]	208	Agrif_UseSpecialValue = .FALSE.
[14086]	209	l_vremap = .FALSE.
[6140]	210	!
[14086]	211	! Ensure below that vertically integrated transports match
	212	! either transports out of time splitting procedure (ln_dynspg_ts=.TRUE.)
	213	! or parent grid transports (ln_dynspg_ts=.FALSE.)
	214	!
[12377]	215	! --- West --- !
[13216]	216	IF( lk_west ) THEN
[13286]	217	ibdy1 = nn_hls + 2 ! halo + land + 1
[14086]	218	ibdy2 = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells
[13216]	219	!
	220	IF( .NOT.ln_dynspg_ts ) THEN ! Store transport
	221	DO ji = mi0(ibdy1), mi1(ibdy2)
[6140]	222	DO jj = 1, jpj
[14086]	223	uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a)
	224	vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a)
[5930]	225	END DO
[636]	226	END DO
[13216]	227	ENDIF
	228	!
[12377]	229	DO ji = mi0(ibdy1), mi1(ibdy2)
[14086]	230	zub(ji,:) = 0._wp
[9019]	231	DO jk = 1, jpkm1
	232	DO jj = 1, jpj
[13286]	233	zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
[9019]	234	END DO
[636]	235	END DO
[13216]	236	DO jj=1,jpj
	237	zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a)
[13286]	238	END DO
[6140]	239	DO jk = 1, jpkm1
	240	DO jj = 1, jpj
[13286]	241	uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk)
[5930]	242	END DO
	243	END DO
[12377]	244	END DO
[13286]	245	!
[14086]	246	DO ji = mi0(ibdy1), mi1(ibdy2)
	247	zvb(ji,:) = 0._wp
	248	DO jk = 1, jpkm1
	249	DO jj = 1, jpj
	250	zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
[13216]	251	END DO
[14086]	252	END DO
	253	DO jj = 1, jpj
	254	zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a)
	255	END DO
	256	DO jk = 1, jpkm1
[13216]	257	DO jj = 1, jpj
[14086]	258	vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) )*vmask(ji,jj,jk)
[13216]	259	END DO
	260	END DO
[14086]	261	END DO
[13286]	262	!
[636]	263	ENDIF
[390]	264
[9019]	265	! --- East --- !
[13216]	266	IF( lk_east) THEN
[14086]	267	ibdy1 = jpiglo - ( nn_hls + nbghostcells + 1) - nn_shift_bar*Agrif_Rhox()
	268	ibdy2 = jpiglo - ( nn_hls + 2 )
[13216]	269	!
[14086]	270	IF( .NOT.ln_dynspg_ts ) THEN
[13216]	271	DO ji = mi0(ibdy1), mi1(ibdy2)
[9057]	272	DO jj = 1, jpj
[14086]	273	uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a)
[5930]	274	END DO
[636]	275	END DO
[13216]	276	ENDIF
	277	!
[12377]	278	DO ji = mi0(ibdy1), mi1(ibdy2)
[14086]	279	zub(ji,:) = 0._wp
[6140]	280	DO jk = 1, jpkm1
	281	DO jj = 1, jpj
[13286]	282	zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
[5930]	283	END DO
	284	END DO
[13216]	285	DO jj=1,jpj
	286	zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a)
[4486]	287	END DO
[6140]	288	DO jk = 1, jpkm1
	289	DO jj = 1, jpj
[13286]	290	uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk)
[5930]	291	END DO
	292	END DO
[12377]	293	END DO
[13286]	294	!
[14086]	295	ibdy1 = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()
[14170]	296	ibdy2 = jpiglo - ( nn_hls + 1 )
	297	!
[14086]	298	IF( .NOT.ln_dynspg_ts ) THEN
[13216]	299	DO ji = mi0(ibdy1), mi1(ibdy2)
	300	DO jj = 1, jpj
[14086]	301	vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a)
[13216]	302	END DO
[14086]	303	END DO
	304	ENDIF
[14170]	305	!
[14086]	306	DO ji = mi0(ibdy1), mi1(ibdy2)
	307	zvb(ji,:) = 0._wp
	308	DO jk = 1, jpkm1
	309	DO jj = 1, jpj
	310	zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
	311	END DO
	312	END DO
	313	DO jj = 1, jpj
	314	zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a)
	315	END DO
	316	DO jk = 1, jpkm1
	317	DO jj = 1, jpj
[13286]	318	vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk)
[13216]	319	END DO
	320	END DO
[14086]	321	END DO
[13286]	322	!
[636]	323	ENDIF
[390]	324
[9019]	325	! --- South --- !
[13216]	326	IF( lk_south ) THEN
[14086]	327	jbdy1 = nn_hls + 2
	328	jbdy2 = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhoy()
[13216]	329	!
[14086]	330	IF( .NOT.ln_dynspg_ts ) THEN
[13216]	331	DO jj = mj0(jbdy1), mj1(jbdy2)
[14170]	332	DO ji = 1, jpi
	333	uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a)
	334	vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a)
[13216]	335	END DO
	336	END DO
	337	ENDIF
	338	!
[12377]	339	DO jj = mj0(jbdy1), mj1(jbdy2)
[14086]	340	zvb(:,jj) = 0._wp
[13216]	341	DO jk=1,jpkm1
	342	DO ji=1,jpi
[13286]	343	zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
[5930]	344	END DO
[636]	345	END DO
[13216]	346	DO ji = 1, jpi
	347	zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a)
[636]	348	END DO
[6140]	349	DO jk = 1, jpkm1
	350	DO ji = 1, jpi
[13286]	351	vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk)
[5930]	352	END DO
	353	END DO
[13216]	354	END DO
[13286]	355	!
[14086]	356	DO jj = mj0(jbdy1), mj1(jbdy2)
	357	zub(:,jj) = 0._wp
	358	DO jk = 1, jpkm1
	359	DO ji = 1, jpi
	360	zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
[13216]	361	END DO
[14086]	362	END DO
	363	DO ji = 1, jpi
	364	zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a)
	365	END DO
	366	DO jk = 1, jpkm1
[6140]	367	DO ji = 1, jpi
[14086]	368	uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk)
[5930]	369	END DO
[9057]	370	END DO
[14086]	371	END DO
[13286]	372	!
[636]	373	ENDIF
[390]	374
[9019]	375	! --- North --- !
[13216]	376	IF( lk_north ) THEN
[14086]	377	jbdy1 = jpjglo - ( nn_hls + nbghostcells + 1) - nn_shift_bar*Agrif_Rhoy()
	378	jbdy2 = jpjglo - ( nn_hls + 2 )
[13216]	379	!
[14086]	380	IF( .NOT.ln_dynspg_ts ) THEN
[13216]	381	DO jj = mj0(jbdy1), mj1(jbdy2)
[14170]	382	DO ji = 1, jpi
[14086]	383	vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a)
[13216]	384	END DO
	385	END DO
	386	ENDIF
	387	!
[12377]	388	DO jj = mj0(jbdy1), mj1(jbdy2)
[14086]	389	zvb(:,jj) = 0._wp
[13216]	390	DO jk=1,jpkm1
	391	DO ji=1,jpi
[13286]	392	zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk)
[5930]	393	END DO
[636]	394	END DO
[13216]	395	DO ji = 1, jpi
	396	zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a)
[636]	397	END DO
[9057]	398	DO jk = 1, jpkm1
	399	DO ji = 1, jpi
[13286]	400	vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk)
[9057]	401	END DO
	402	END DO
[13216]	403	END DO
[13286]	404	!
[14086]	405	jbdy1 = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()
	406	jbdy2 = jpjglo - ( nn_hls + 1 )
[14170]	407	!
[14086]	408	IF( .NOT.ln_dynspg_ts ) THEN
[13216]	409	DO jj = mj0(jbdy1), mj1(jbdy2)
[14170]	410	DO ji = 1, jpi
[14086]	411	uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a)
	412	END DO
	413	END DO
	414	ENDIF
[14170]	415	!
[14086]	416	DO jj = mj0(jbdy1), mj1(jbdy2)
	417	zub(:,jj) = 0._wp
	418	DO jk = 1, jpkm1
[6140]	419	DO ji = 1, jpi
[14086]	420	zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk)
[5930]	421	END DO
[14086]	422	END DO
	423	DO ji = 1, jpi
	424	zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a)
	425	END DO
	426	DO jk = 1, jpkm1
	427	DO ji = 1, jpi
[13286]	428	uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk)
[13216]	429	END DO
[5930]	430	END DO
[14086]	431	END DO
[13286]	432	!
[636]	433	ENDIF
[2715]	434	!
[636]	435	END SUBROUTINE Agrif_dyn
[390]	436
[6140]	437
[4486]	438	SUBROUTINE Agrif_dyn_ts( jn )
[4292]	439	!!----------------------------------------------------------------------
	440	!! * ROUTINE Agrif_dyn_ts *
	441	!!----------------------------------------------------------------------
[4486]	442	INTEGER, INTENT(in) :: jn
[4292]	443	!!
	444	INTEGER :: ji, jj
[12377]	445	INTEGER :: istart, iend, jstart, jend
[4486]	446	!!----------------------------------------------------------------------
[6140]	447	!
[4486]	448	IF( Agrif_Root() ) RETURN
[9057]	449	!
[12377]	450	!--- West ---!
[13216]	451	IF( lk_west ) THEN
[13286]	452	istart = nn_hls + 2 ! halo + land + 1
[14086]	453	iend = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells
[13216]	454	DO ji = mi0(istart), mi1(iend)
	455	DO jj=1,jpj
	456	va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
	457	ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
	458	END DO
[4486]	459	END DO
[13216]	460	ENDIF
[6140]	461	!
[12377]	462	!--- East ---!
[13216]	463	IF( lk_east ) THEN
[14086]	464	istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()
	465	iend = jpiglo - ( nn_hls + 1 )
[13216]	466	DO ji = mi0(istart), mi1(iend)
	467
	468	DO jj=1,jpj
	469	va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
	470	END DO
[4486]	471	END DO
[14086]	472	istart = jpiglo - ( nn_hls + nbghostcells + 1) - nn_shift_bar*Agrif_Rhox()
	473	iend = jpiglo - ( nn_hls + 2 )
[13216]	474	DO ji = mi0(istart), mi1(iend)
	475	DO jj=1,jpj
	476	ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
	477	END DO
[12377]	478	END DO
[13216]	479	ENDIF
[6140]	480	!
[12377]	481	!--- South ---!
[13216]	482	IF( lk_south ) THEN
[14086]	483	jstart = nn_hls + 2
	484	jend = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhoy()
[13216]	485	DO jj = mj0(jstart), mj1(jend)
	486
	487	DO ji=1,jpi
	488	ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
	489	va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
	490	END DO
[4486]	491	END DO
[13216]	492	ENDIF
[6140]	493	!
[12377]	494	!--- North ---!
[13216]	495	IF( lk_north ) THEN
[14086]	496	jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()
	497	jend = jpjglo - ( nn_hls + 1 )
[13216]	498	DO jj = mj0(jstart), mj1(jend)
	499	DO ji=1,jpi
	500	ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
	501	END DO
[4486]	502	END DO
[14086]	503	jstart = jpjglo - ( nn_hls + nbghostcells + 1) - nn_shift_bar*Agrif_Rhoy()
	504	jend = jpjglo - ( nn_hls + 2 )
[13216]	505	DO jj = mj0(jstart), mj1(jend)
	506	DO ji=1,jpi
	507	va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
	508	END DO
[12377]	509	END DO
[13216]	510	ENDIF
[4486]	511	!
	512	END SUBROUTINE Agrif_dyn_ts
	513
[13286]	514
[12377]	515	SUBROUTINE Agrif_dyn_ts_flux( jn, zu, zv )
	516	!!----------------------------------------------------------------------
	517	!! * ROUTINE Agrif_dyn_ts_flux *
	518	!!----------------------------------------------------------------------
	519	INTEGER, INTENT(in) :: jn
	520	REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: zu, zv
	521	!!
	522	INTEGER :: ji, jj
	523	INTEGER :: istart, iend, jstart, jend
	524	!!----------------------------------------------------------------------
	525	!
	526	IF( Agrif_Root() ) RETURN
	527	!
	528	!--- West ---!
[13216]	529	IF( lk_west ) THEN
[14086]	530	istart = nn_hls + 2
	531	iend = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhox()
[13216]	532	DO ji = mi0(istart), mi1(iend)
	533	DO jj=1,jpj
	534	zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
	535	zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
	536	END DO
[12377]	537	END DO
[13216]	538	ENDIF
[12377]	539	!
	540	!--- East ---!
[13216]	541	IF( lk_east ) THEN
[14086]	542	istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()
	543	iend = jpiglo - ( nn_hls + 1 )
[13216]	544	DO ji = mi0(istart), mi1(iend)
	545	DO jj=1,jpj
	546	zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
	547	END DO
[12377]	548	END DO
[14086]	549	istart = jpiglo - ( nn_hls + nbghostcells + 1) - nn_shift_bar*Agrif_Rhox()
	550	iend = jpiglo - ( nn_hls + 2 )
[13216]	551	DO ji = mi0(istart), mi1(iend)
	552	DO jj=1,jpj
	553	zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
	554	END DO
[12377]	555	END DO
[13216]	556	ENDIF
[12377]	557	!
	558	!--- South ---!
[13216]	559	IF( lk_south ) THEN
[14086]	560	jstart = nn_hls + 2
	561	jend = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhoy()
[13216]	562	DO jj = mj0(jstart), mj1(jend)
	563	DO ji=1,jpi
	564	zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
	565	zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
	566	END DO
[12377]	567	END DO
[13216]	568	ENDIF
[12377]	569	!
	570	!--- North ---!
[13216]	571	IF( lk_north ) THEN
[14086]	572	jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()
	573	jend = jpjglo - ( nn_hls + 1 )
[13216]	574	DO jj = mj0(jstart), mj1(jend)
	575	DO ji=1,jpi
	576	zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
	577	END DO
[12377]	578	END DO
[14086]	579	jstart = jpjglo - ( nn_hls + nbghostcells + 1) - nn_shift_bar*Agrif_Rhoy()
	580	jend = jpjglo - ( nn_hls + 2 )
[13216]	581	DO jj = mj0(jstart), mj1(jend)
	582	DO ji=1,jpi
	583	zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
	584	END DO
[12377]	585	END DO
[13216]	586	ENDIF
[12377]	587	!
	588	END SUBROUTINE Agrif_dyn_ts_flux
[6140]	589
[13286]	590
[4486]	591	SUBROUTINE Agrif_dta_ts( kt )
	592	!!----------------------------------------------------------------------
	593	!! * ROUTINE Agrif_dta_ts *
	594	!!----------------------------------------------------------------------
	595	INTEGER, INTENT(in) :: kt
	596	!!
	597	LOGICAL :: ll_int_cons
[4292]	598	!!----------------------------------------------------------------------
[6140]	599	!
[4292]	600	IF( Agrif_Root() ) RETURN
[6140]	601	!
	602	ll_int_cons = ln_bt_fw ! Assume conservative temporal integration in the forward case only
	603	!
[9031]	604	! Enforce volume conservation if no time refinement:
	605	IF ( Agrif_rhot()==1 ) ll_int_cons=.TRUE.
[6140]	606	!
[4486]	607	! Interpolate barotropic fluxes
[12377]	608	Agrif_SpecialValue = 0._wp
[4486]	609	Agrif_UseSpecialValue = ln_spc_dyn
[13216]	610
	611	use_sign_north = .TRUE.
	612	sign_north = -1.
	613
[6140]	614	!
[12377]	615	! Set bdy time interpolation stage to 0 (latter incremented locally do deal with corners)
	616	utint_stage(:,:) = 0
	617	vtint_stage(:,:) = 0
	618	!
[6140]	619	IF( ll_int_cons ) THEN ! Conservative interpolation
[14086]	620	IF ( lk_tint2d_notinterp ) THEN
[14122]	621	Agrif_UseSpecialValue = .FALSE.
[14086]	622	CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b_const )
	623	CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b_const )
	624	! Divergence conserving correction terms:
[14122]	625	IF ( Agrif_Rhox()>1 ) CALL Agrif_Bc_variable( ub2b_cor_id, calledweight=1._wp, procname=ub2b_cor )
	626	IF ( Agrif_Rhoy()>1 ) CALL Agrif_Bc_variable( vb2b_cor_id, calledweight=1._wp, procname=vb2b_cor )
[14086]	627	ELSE
	628	! order matters here !!!!!!
	629	CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated
	630	CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b )
	631	!
	632	bdy_tinterp = 1
	633	CALL Agrif_Bc_variable( unb_interp_id , calledweight=1._wp, procname=interpunb ) ! After
	634	CALL Agrif_Bc_variable( vnb_interp_id , calledweight=1._wp, procname=interpvnb )
	635	!
	636	bdy_tinterp = 2
	637	CALL Agrif_Bc_variable( unb_interp_id , calledweight=0._wp, procname=interpunb ) ! Before
	638	CALL Agrif_Bc_variable( vnb_interp_id , calledweight=0._wp, procname=interpvnb )
	639	ENDIF
[4486]	640	ELSE ! Linear interpolation
[12377]	641	!
	642	ubdy(:,:) = 0._wp ; vbdy(:,:) = 0._wp
[14086]	643	CALL Agrif_Bc_variable( unb_interp_id, procname=interpunb )
	644	CALL Agrif_Bc_variable( vnb_interp_id, procname=interpvnb )
[4486]	645	ENDIF
	646	Agrif_UseSpecialValue = .FALSE.
[13216]	647	use_sign_north = .FALSE.
[5656]	648	!
[4486]	649	END SUBROUTINE Agrif_dta_ts
	650
[6140]	651
[2486]	652	SUBROUTINE Agrif_ssh( kt )
	653	!!----------------------------------------------------------------------
[9031]	654	!! * ROUTINE Agrif_ssh *
[2486]	655	!!----------------------------------------------------------------------
	656	INTEGER, INTENT(in) :: kt
[9019]	657	!
[12377]	658	INTEGER :: ji, jj
	659	INTEGER :: istart, iend, jstart, jend
[2486]	660	!!----------------------------------------------------------------------
[6140]	661	!
[2486]	662	IF( Agrif_Root() ) RETURN
[9031]	663	!
[9116]	664	! Linear time interpolation of sea level
[9031]	665	!
	666	Agrif_SpecialValue = 0._wp
	667	Agrif_UseSpecialValue = .TRUE.
	668	CALL Agrif_Bc_variable(sshn_id, procname=interpsshn )
	669	Agrif_UseSpecialValue = .FALSE.
	670	!
[9116]	671	! --- West --- !
[13216]	672	IF(lk_west) THEN
[14086]	673	istart = nn_hls + 2 ! halo + land + 1
	674	iend = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells
[13216]	675	DO ji = mi0(istart), mi1(iend)
	676	DO jj = 1, jpj
	677	ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
[13286]	678	END DO
	679	END DO
[13216]	680	ENDIF
[6140]	681	!
[9019]	682	! --- East --- !
[13216]	683	IF(lk_east) THEN
[14086]	684	istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells - 1
	685	iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1
[13216]	686	DO ji = mi0(istart), mi1(iend)
	687	DO jj = 1, jpj
	688	ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
[13286]	689	END DO
	690	END DO
[13216]	691	ENDIF
[6140]	692	!
[9019]	693	! --- South --- !
[13216]	694	IF(lk_south) THEN
[14086]	695	jstart = nn_hls + 2 ! halo + land + 1
	696	jend = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells
[13216]	697	DO jj = mj0(jstart), mj1(jend)
	698	DO ji = 1, jpi
	699	ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
[13286]	700	END DO
	701	END DO
[13216]	702	ENDIF
[6140]	703	!
[9019]	704	! --- North --- !
[13216]	705	IF(lk_north) THEN
[14086]	706	jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells - 1
	707	jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1
[13216]	708	DO jj = mj0(jstart), mj1(jend)
	709	DO ji = 1, jpi
	710	ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
[13286]	711	END DO
	712	END DO
[13216]	713	ENDIF
[6140]	714	!
[2486]	715	END SUBROUTINE Agrif_ssh
	716
[6140]	717
[4486]	718	SUBROUTINE Agrif_ssh_ts( jn )
[4292]	719	!!----------------------------------------------------------------------
	720	!! * ROUTINE Agrif_ssh_ts *
	721	!!----------------------------------------------------------------------
[4486]	722	INTEGER, INTENT(in) :: jn
[4292]	723	!!
[12377]	724	INTEGER :: ji, jj
	725	INTEGER :: istart, iend, jstart, jend
[4292]	726	!!----------------------------------------------------------------------
[9031]	727	!
	728	IF( Agrif_Root() ) RETURN
	729	!
[9116]	730	! --- West --- !
[13216]	731	IF(lk_west) THEN
[14086]	732	istart = nn_hls + 2 ! halo + land + 1
	733	iend = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells
[13216]	734	DO ji = mi0(istart), mi1(iend)
	735	DO jj = 1, jpj
	736	ssha_e(ji,jj) = hbdy(ji,jj)
[13286]	737	END DO
	738	END DO
[13216]	739	ENDIF
[6140]	740	!
[9116]	741	! --- East --- !
[13216]	742	IF(lk_east) THEN
[14086]	743	istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells - 1
	744	iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1
[13216]	745	DO ji = mi0(istart), mi1(iend)
	746	DO jj = 1, jpj
	747	ssha_e(ji,jj) = hbdy(ji,jj)
[13286]	748	END DO
	749	END DO
[13216]	750	ENDIF
[6140]	751	!
[9116]	752	! --- South --- !
[13216]	753	IF(lk_south) THEN
[14086]	754	jstart = nn_hls + 2 ! halo + land + 1
	755	jend = nn_hls + 1 + nbghostcells + nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells
[13216]	756	DO jj = mj0(jstart), mj1(jend)
	757	DO ji = 1, jpi
	758	ssha_e(ji,jj) = hbdy(ji,jj)
[13286]	759	END DO
	760	END DO
[13216]	761	ENDIF
[6140]	762	!
[9116]	763	! --- North --- !
[13216]	764	IF(lk_north) THEN
[14086]	765	jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells - 1
	766	jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1
[13216]	767	DO jj = mj0(jstart), mj1(jend)
	768	DO ji = 1, jpi
	769	ssha_e(ji,jj) = hbdy(ji,jj)
[13286]	770	END DO
	771	END DO
[13216]	772	ENDIF
[6140]	773	!
[4292]	774	END SUBROUTINE Agrif_ssh_ts
	775
[13286]	776
[9019]	777	SUBROUTINE Agrif_avm
[4292]	778	!!----------------------------------------------------------------------
[9019]	779	!! * ROUTINE Agrif_avm *
[5656]	780	!!----------------------------------------------------------------------
	781	REAL(wp) :: zalpha
[6140]	782	!!----------------------------------------------------------------------
[5656]	783	!
[9031]	784	IF( Agrif_Root() ) RETURN
[6140]	785	!
[9031]	786	zalpha = 1._wp ! JC: proper time interpolation impossible
	787	! => use last available value from parent
	788	!
	789	Agrif_SpecialValue = 0.e0
[5656]	790	Agrif_UseSpecialValue = .TRUE.
[14086]	791	l_vremap = ln_vert_remap
[6140]	792	!
[9019]	793	CALL Agrif_Bc_variable( avm_id, calledweight=zalpha, procname=interpavm )
[6140]	794	!
[5656]	795	Agrif_UseSpecialValue = .FALSE.
[14086]	796	l_vremap = .FALSE.
[5656]	797	!
[9019]	798	END SUBROUTINE Agrif_avm
[5656]	799
[13286]	800
[12377]	801	SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before )
[6140]	802	!!----------------------------------------------------------------------
	803	REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab
	804	INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, n1, n2
	805	LOGICAL , INTENT(in ) :: before
[5656]	806	!
[12377]	807	INTEGER :: ji, jj, jk, jn ! dummy loop indices
	808	INTEGER :: N_in, N_out
[13216]	809	INTEGER :: item
[9031]	810	! vertical interpolation:
[14086]	811	REAL(wp) :: zhtot, zwgt
	812	REAL(wp), DIMENSION(k1:k2,1:jpts) :: tabin, tabin_i
	813	REAL(wp), DIMENSION(k1:k2) :: z_in, h_in_i, z_in_i
[13216]	814	REAL(wp), DIMENSION(1:jpk) :: h_out, z_out
[12377]	815	!!----------------------------------------------------------------------
[9031]	816
[13216]	817	IF( before ) THEN
	818
	819	item = Kmm_a
	820	IF( l_ini_child ) Kmm_a = Kbb_a
	821
[9031]	822	DO jn = 1,jpts
	823	DO jk=k1,k2
	824	DO jj=j1,j2
	825	DO ji=i1,i2
[12377]	826	ptab(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a)
[9031]	827	END DO
	828	END DO
	829	END DO
[13216]	830	END DO
[9031]	831
[14086]	832	IF( l_vremap .OR. l_ini_child .OR. ln_zps ) THEN
	833
	834	! Fill cell depths (i.e. gdept) to be interpolated
[13216]	835	! Warning: these are masked, hence extrapolated prior interpolation.
[14086]	836	DO jj=j1,j2
	837	DO ji=i1,i2
	838	ptab(ji,jj,k1,jpts+1) = 0.5_wp * tmask(ji,jj,k1) * e3t(ji,jj,k1,Kmm_a)
	839	DO jk=k1+1,k2
	840	ptab(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * &
	841	& ( ptab(ji,jj,jk-1,jpts+1) + 0.5_wp * (e3t(ji,jj,jk-1,Kmm_a)+e3t(ji,jj,jk,Kmm_a)) )
[13216]	842	END DO
	843	END DO
	844	END DO
[14086]	845
[13216]	846	! Save ssh at last level:
	847	IF (.NOT.ln_linssh) THEN
	848	ptab(i1:i2,j1:j2,k2,jpts+1) = ssh(i1:i2,j1:j2,Kmm_a)*tmask(i1:i2,j1:j2,1)
	849	END IF
	850	ENDIF
	851	Kmm_a = item
	852
[9031]	853	ELSE
[13216]	854	item = Krhs_a
	855	IF( l_ini_child ) Krhs_a = Kbb_a
[9031]	856
[13216]	857	IF( l_vremap .OR. l_ini_child ) THEN
	858	IF (ln_linssh) ptab(i1:i2,j1:j2,k2,n2) = 0._wp
	859	DO jj=j1,j2
	860	DO ji=i1,i2
[14086]	861	ts(ji,jj,:,:,Krhs_a) = 0.
	862	!
	863	! Build vertical grids:
[13216]	864	N_in = mbkt_parent(ji,jj)
[14218]	865	N_out = mbkt(ji,jj)
	866	IF (N_in*N_out > 0) THEN
	867	! Input grid (account for partial cells if any):
	868	DO jk=1,N_in
	869	z_in(jk) = ptab(ji,jj,jk,n2) - ptab(ji,jj,k2,n2)
	870	tabin(jk,1:jpts) = ptab(ji,jj,jk,1:jpts)
	871	END DO
[14086]	872
[14218]	873	! Intermediate grid:
	874	IF ( l_vremap ) THEN
	875	DO jk = 1, N_in
	876	h_in_i(jk) = e3t0_parent(ji,jj,jk) * &
	877	& (1._wp + ptab(ji,jj,k2,n2)/(ht0_parent(ji,jj)*ssmask(ji,jj) + 1._wp - ssmask(ji,jj)))
	878	END DO
	879	z_in_i(1) = 0.5_wp * h_in_i(1)
	880	DO jk=2,N_in
	881	z_in_i(jk) = z_in_i(jk-1) + 0.5_wp * ( h_in_i(jk) + h_in_i(jk-1) )
	882	END DO
	883	z_in_i(1:N_in) = z_in_i(1:N_in) - ptab(ji,jj,k2,n2)
	884	ENDIF
	885
	886	! Output (Child) grid:
	887	DO jk=1,N_out
	888	h_out(jk) = e3t(ji,jj,jk,Krhs_a)
[14086]	889	END DO
[14218]	890	z_out(1) = 0.5_wp * h_out(1)
	891	DO jk=2,N_out
	892	z_out(jk) = z_out(jk-1) + 0.5_wp * ( h_out(jk)+h_out(jk-1) )
[14086]	893	END DO
[14218]	894	IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out) - ssh(ji,jj,Krhs_a)
[13216]	895
	896	IF( l_ini_child ) THEN
[14086]	897	CALL remap_linear(tabin(1:N_in,1:jpts),z_in(1:N_in),ts(ji,jj,1:N_out,1:jpts,Krhs_a), &
[13216]	898	& z_out(1:N_out),N_in,N_out,jpts)
	899	ELSE
[14086]	900	CALL remap_linear(tabin(1:N_in,1:jpts),z_in(1:N_in),tabin_i(1:N_in,1:jpts), &
	901	& z_in_i(1:N_in),N_in,N_in,jpts)
	902	CALL reconstructandremap(tabin_i(1:N_in,1:jpts),h_in_i(1:N_in),ts(ji,jj,1:N_out,1:jpts,Krhs_a), &
[13216]	903	& h_out(1:N_out),N_in,N_out,jpts)
	904	ENDIF
[12377]	905	ENDIF
[13286]	906	END DO
	907	END DO
[13216]	908	Krhs_a = item
	909
	910	ELSE
	911
[14086]	912	IF ( Agrif_Parent(ln_zps) ) THEN ! Account for partial cells
	913	! linear vertical interpolation
	914	DO jj=j1,j2
	915	DO ji=i1,i2
	916	!
	917	N_in = mbkt(ji,jj)
	918	N_out = mbkt(ji,jj)
	919	z_in(1) = ptab(ji,jj,1,n2)
	920	tabin(1,1:jpts) = ptab(ji,jj,1,1:jpts)
	921	DO jk=2, N_in
	922	z_in(jk) = ptab(ji,jj,jk,n2)
	923	tabin(jk,1:jpts) = ptab(ji,jj,jk,1:jpts)
	924	END DO
	925	IF (.NOT.ln_linssh) z_in(1:N_in) = z_in(1:N_in) - ptab(ji,jj,k2,n2)
	926	z_out(1) = 0.5_wp * e3t(ji,jj,1,Krhs_a)
	927	DO jk=2, N_out
	928	z_out(jk) = z_out(jk-1) + 0.5_wp * (e3t(ji,jj,jk-1,Krhs_a) + e3t(ji,jj,jk,Krhs_a))
	929	END DO
	930	IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out) - ssh(ji,jj,Krhs_a)
	931	CALL remap_linear(tabin(1:N_in,1:jpts),z_in(1:N_in),ptab(ji,jj,1:N_out,1:jpts), &
	932	& z_out(1:N_out),N_in,N_out,jpts)
	933	END DO
	934	END DO
	935	ENDIF
	936
	937	DO jn =1, jpts
	938	ts(i1:i2,j1:j2,1:jpk,jn,Krhs_a) = ptab(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk)
[13216]	939	END DO
	940	ENDIF
[9116]	941
[5656]	942	ENDIF
	943	!
	944	END SUBROUTINE interptsn
	945
[13286]	946
[12377]	947	SUBROUTINE interpsshn( ptab, i1, i2, j1, j2, before )
[5656]	948	!!----------------------------------------------------------------------
[4292]	949	!! * ROUTINE interpsshn *
	950	!!----------------------------------------------------------------------
[6140]	951	INTEGER , INTENT(in ) :: i1, i2, j1, j2
	952	REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
	953	LOGICAL , INTENT(in ) :: before
	954	!
[5656]	955	!!----------------------------------------------------------------------
	956	!
	957	IF( before) THEN
[12377]	958	ptab(i1:i2,j1:j2) = ssh(i1:i2,j1:j2,Kmm_a)
[5656]	959	ELSE
[14086]	960	IF( l_ini_child ) THEN
[14170]	961	ssh(i1:i2,j1:j2,Krhs_a) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1)
[14086]	962	ELSE
	963	hbdy(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1)
	964	ENDIF
[5656]	965	ENDIF
	966	!
	967	END SUBROUTINE interpsshn
	968
[13286]	969
[12377]	970	SUBROUTINE interpun( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before )
[6140]	971	!!----------------------------------------------------------------------
[9019]	972	!! * ROUTINE interpun *
[9031]	973	!!---------------------------------------------
	974	!!
	975	INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,m1,m2
	976	REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,m1:m2), INTENT(inout) :: ptab
	977	LOGICAL, INTENT(in) :: before
	978	!!
	979	INTEGER :: ji,jj,jk
[12377]	980	REAL(wp) :: zrhoy, zhtot
[9031]	981	! vertical interpolation:
[13216]	982	REAL(wp), DIMENSION(k1:k2) :: tabin, h_in, z_in
	983	REAL(wp), DIMENSION(1:jpk) :: h_out, z_out
	984	INTEGER :: N_in, N_out,item
[9031]	985	REAL(wp) :: h_diff
	986	!!---------------------------------------------
[5656]	987	!
[9031]	988	IF (before) THEN
[13216]	989
	990	item = Kmm_a
	991	IF( l_ini_child ) Kmm_a = Kbb_a
	992
[9031]	993	DO jk=1,jpk
	994	DO jj=j1,j2
	995	DO ji=i1,i2
[12377]	996	ptab(ji,jj,jk,1) = (e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) * uu(ji,jj,jk,Kmm_a)*umask(ji,jj,jk))
[13216]	997	IF( l_vremap .OR. l_ini_child) THEN
	998	! Interpolate thicknesses (masked for subsequent extrapolation)
	999	ptab(ji,jj,jk,2) = umask(ji,jj,jk) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a)
	1000	ENDIF
[9031]	1001	END DO
	1002	END DO
[5656]	1003	END DO
[13216]	1004
[14086]	1005	IF( l_vremap .OR. l_ini_child ) THEN
[12377]	1006	! Extrapolate thicknesses in partial bottom cells:
	1007	! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on
[13216]	1008	IF (ln_zps) THEN
	1009	DO jj=j1,j2
	1010	DO ji=i1,i2
	1011	jk = mbku(ji,jj)
	1012	ptab(ji,jj,jk,2) = 0._wp
	1013	END DO
	1014	END DO
	1015	END IF
	1016
	1017	! Save ssh at last level:
	1018	ptab(i1:i2,j1:j2,k2,2) = 0._wp
	1019	IF (.NOT.ln_linssh) THEN
	1020	! This vertical sum below should be replaced by the sea-level at U-points (optimization):
	1021	DO jk=1,jpk
	1022	ptab(i1:i2,j1:j2,k2,2) = ptab(i1:i2,j1:j2,k2,2) + e3u(i1:i2,j1:j2,jk,Kmm_a) * umask(i1:i2,j1:j2,jk)
	1023	END DO
	1024	ptab(i1:i2,j1:j2,k2,2) = ptab(i1:i2,j1:j2,k2,2) - hu_0(i1:i2,j1:j2)
	1025	END IF
	1026	ENDIF
	1027
	1028	Kmm_a = item
[12377]	1029	!
[5656]	1030	ELSE
[9031]	1031	zrhoy = Agrif_rhoy()
[13216]	1032
	1033	IF( l_vremap .OR. l_ini_child) THEN
[9031]	1034	! VERTICAL REFINEMENT BEGIN
	1035
[13216]	1036	IF (ln_linssh) ptab(i1:i2,j1:j2,k2,2) = 0._wp
[12377]	1037
[13216]	1038	DO ji=i1,i2
	1039	DO jj=j1,j2
	1040	uu(ji,jj,:,Krhs_a) = 0._wp
	1041	N_in = mbku_parent(ji,jj)
[14218]	1042	N_out = mbku(ji,jj)
	1043	IF (N_in*N_out > 0) THEN
	1044	zhtot = 0._wp
	1045	DO jk=1,N_in
	1046	!IF (jk==N_in) THEN
	1047	! h_in(jk) = hu0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot
	1048	!ELSE
	1049	! h_in(jk) = ptab(ji,jj,jk,2)/(e2u(ji,jj)*zrhoy)
	1050	!ENDIF
	1051	IF ( l_vremap ) THEN
	1052	h_in(jk) = e3u0_parent(ji,jj,jk)
[14086]	1053	ELSE
[14218]	1054	IF (jk==N_in) THEN
	1055	h_in(jk) = hu0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot
	1056	ELSE
	1057	h_in(jk) = ptab(ji,jj,jk,2)/(e2u(ji,jj)*zrhoy)
	1058	ENDIF
[14086]	1059	ENDIF
[14218]	1060	zhtot = zhtot + h_in(jk)
	1061	IF( h_in(jk) .GT. 0. ) THEN
	1062	tabin(jk) = ptab(ji,jj,jk,1)/(e2u(ji,jj)zrhoyh_in(jk))
	1063	ELSE
	1064	tabin(jk) = 0.
	1065	ENDIF
	1066	END DO
	1067	z_in(1) = 0.5_wp * h_in(1) - zhtot + hu0_parent(ji,jj)
	1068	DO jk=2,N_in
	1069	z_in(jk) = z_in(jk-1) + 0.5_wp * (h_in(jk)+h_in(jk-1))
	1070	END DO
[13216]	1071
[14218]	1072	DO jk=1, N_out
	1073	h_out(jk) = e3u(ji,jj,jk,Krhs_a)
	1074	END DO
[13216]	1075
[14218]	1076	z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + hu_0(ji,jj)
	1077	DO jk=2,N_out
	1078	z_out(jk) = z_out(jk-1) + 0.5_wp * (h_out(jk-1) + h_out(jk))
	1079	END DO
[13216]	1080
[14218]	1081	IF( l_ini_child ) THEN
	1082	CALL remap_linear (tabin(1:N_in),z_in(1:N_in),uu(ji,jj,1:N_out,Krhs_a),z_out(1:N_out),N_in,N_out,1)
	1083	ELSE
	1084	CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),uu(ji,jj,1:N_out,Krhs_a),h_out(1:N_out),N_in,N_out,1)
	1085	ENDIF
[13216]	1086	ENDIF
[13286]	1087	END DO
	1088	END DO
[13216]	1089	ELSE
	1090	DO jk = 1, jpkm1
	1091	DO jj=j1,j2
	1092	uu(i1:i2,jj,jk,Krhs_a) = ptab(i1:i2,jj,jk,1) / ( zrhoy * e2u(i1:i2,jj) * e3u(i1:i2,jj,jk,Krhs_a) )
	1093	END DO
[5656]	1094	END DO
[13216]	1095	ENDIF
[9031]	1096
[5656]	1097	ENDIF
	1098	!
	1099	END SUBROUTINE interpun
	1100
[13286]	1101
[12377]	1102	SUBROUTINE interpvn( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before )
[6140]	1103	!!----------------------------------------------------------------------
[9019]	1104	!! * ROUTINE interpvn *
[6140]	1105	!!----------------------------------------------------------------------
[5656]	1106	!
[9031]	1107	INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,m1,m2
	1108	REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,m1:m2), INTENT(inout) :: ptab
	1109	LOGICAL, INTENT(in) :: before
	1110	!
	1111	INTEGER :: ji,jj,jk
	1112	REAL(wp) :: zrhox
	1113	! vertical interpolation:
[13216]	1114	REAL(wp), DIMENSION(k1:k2) :: tabin, h_in, z_in
	1115	REAL(wp), DIMENSION(1:jpk) :: h_out, z_out
	1116	INTEGER :: N_in, N_out, item
[12377]	1117	REAL(wp) :: h_diff, zhtot
[9031]	1118	!!---------------------------------------------
[5656]	1119	!
[13216]	1120	IF (before) THEN
	1121
	1122	item = Kmm_a
	1123	IF( l_ini_child ) Kmm_a = Kbb_a
	1124
[9031]	1125	DO jk=k1,k2
	1126	DO jj=j1,j2
	1127	DO ji=i1,i2
[12377]	1128	ptab(ji,jj,jk,1) = (e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vv(ji,jj,jk,Kmm_a)*vmask(ji,jj,jk))
[13216]	1129	IF( l_vremap .OR. l_ini_child) THEN
	1130	! Interpolate thicknesses (masked for subsequent extrapolation)
	1131	ptab(ji,jj,jk,2) = vmask(ji,jj,jk) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a)
	1132	ENDIF
[9031]	1133	END DO
	1134	END DO
[5656]	1135	END DO
[13216]	1136
	1137	IF( l_vremap .OR. l_ini_child) THEN
[12377]	1138	! Extrapolate thicknesses in partial bottom cells:
	1139	! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on
[13216]	1140	IF (ln_zps) THEN
	1141	DO jj=j1,j2
	1142	DO ji=i1,i2
	1143	jk = mbkv(ji,jj)
	1144	ptab(ji,jj,jk,2) = 0._wp
	1145	END DO
	1146	END DO
	1147	END IF
	1148	! Save ssh at last level:
	1149	ptab(i1:i2,j1:j2,k2,2) = 0._wp
	1150	IF (.NOT.ln_linssh) THEN
	1151	! This vertical sum below should be replaced by the sea-level at V-points (optimization):
	1152	DO jk=1,jpk
	1153	ptab(i1:i2,j1:j2,k2,2) = ptab(i1:i2,j1:j2,k2,2) + e3v(i1:i2,j1:j2,jk,Kmm_a) * vmask(i1:i2,j1:j2,jk)
[12377]	1154	END DO
[13216]	1155	ptab(i1:i2,j1:j2,k2,2) = ptab(i1:i2,j1:j2,k2,2) - hv_0(i1:i2,j1:j2)
	1156	END IF
	1157	ENDIF
	1158	item = Kmm_a
	1159
[9031]	1160	ELSE
	1161	zrhox = Agrif_rhox()
	1162
[13216]	1163	IF( l_vremap .OR. l_ini_child ) THEN
[9031]	1164
[13216]	1165	IF (ln_linssh) ptab(i1:i2,j1:j2,k2,2) = 0._wp
	1166
	1167	DO jj=j1,j2
	1168	DO ji=i1,i2
	1169	vv(ji,jj,:,Krhs_a) = 0._wp
	1170	N_in = mbkv_parent(ji,jj)
[14218]	1171	N_out = mbkv(ji,jj)
	1172
	1173	IF (N_in*N_out > 0) THEN
	1174	zhtot = 0._wp
	1175	DO jk=1,N_in
	1176	!IF (jk==N_in) THEN
	1177	! h_in(jk) = hv0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot
	1178	!ELSE
	1179	! h_in(jk) = ptab(ji,jj,jk,2)/(e1v(ji,jj)*zrhox)
	1180	!ENDIF
	1181	IF (l_vremap) THEN
	1182	h_in(jk) = e3v0_parent(ji,jj,jk)
[14086]	1183	ELSE
[14218]	1184	IF (jk==N_in) THEN
	1185	h_in(jk) = hv0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot
	1186	ELSE
	1187	h_in(jk) = ptab(ji,jj,jk,2)/(e1v(ji,jj)*zrhox)
	1188	ENDIF
[14086]	1189	ENDIF
[14218]	1190	zhtot = zhtot + h_in(jk)
	1191	IF( h_in(jk) .GT. 0. ) THEN
	1192	tabin(jk) = ptab(ji,jj,jk,1)/(e1v(ji,jj)zrhoxh_in(jk))
	1193	ELSE
	1194	tabin(jk) = 0.
	1195	ENDIF
	1196	END DO
[13216]	1197
[14218]	1198	z_in(1) = 0.5_wp * h_in(1) - zhtot + hv0_parent(ji,jj)
	1199	DO jk=2,N_in
	1200	z_in(jk) = z_in(jk-1) + 0.5_wp * (h_in(jk-1)+h_in(jk))
	1201	END DO
[13216]	1202
[14218]	1203	DO jk=1,N_out
	1204	h_out(jk) = e3v(ji,jj,jk,Krhs_a)
	1205	END DO
[13216]	1206
[14218]	1207	z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + hv_0(ji,jj)
	1208	DO jk=2,N_out
	1209	z_out(jk) = z_out(jk-1) + 0.5_wp * (h_out(jk-1)+h_out(jk))
	1210	END DO
[13216]	1211
	1212	IF( l_ini_child ) THEN
	1213	CALL remap_linear (tabin(1:N_in),z_in(1:N_in),vv(ji,jj,1:N_out,Krhs_a),z_out(1:N_out),N_in,N_out,1)
	1214	ELSE
	1215	CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),vv(ji,jj,1:N_out,Krhs_a),h_out(1:N_out),N_in,N_out,1)
	1216	ENDIF
[12377]	1217	ENDIF
[9031]	1218	END DO
	1219	END DO
[13216]	1220	ELSE
	1221	DO jk = 1, jpkm1
	1222	vv(i1:i2,j1:j2,jk,Krhs_a) = ptab(i1:i2,j1:j2,jk,1) / ( zrhox * e1v(i1:i2,j1:j2) * e3v(i1:i2,j1:j2,jk,Krhs_a) )
	1223	END DO
	1224	ENDIF
[5656]	1225	ENDIF
	1226	!
	1227	END SUBROUTINE interpvn
[636]	1228
[12377]	1229	SUBROUTINE interpunb( ptab, i1, i2, j1, j2, before)
[1605]	1230	!!----------------------------------------------------------------------
[5656]	1231	!! * ROUTINE interpunb *
[1605]	1232	!!----------------------------------------------------------------------
[6140]	1233	INTEGER , INTENT(in ) :: i1, i2, j1, j2
	1234	REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
	1235	LOGICAL , INTENT(in ) :: before
	1236	!
	1237	INTEGER :: ji, jj
	1238	REAL(wp) :: zrhoy, zrhot, zt0, zt1, ztcoeff
[1605]	1239	!!----------------------------------------------------------------------
[5656]	1240	!
[6140]	1241	IF( before ) THEN
[12377]	1242	ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * hu(i1:i2,j1:j2,Kmm_a) * uu_b(i1:i2,j1:j2,Kmm_a)
[5656]	1243	ELSE
	1244	zrhoy = Agrif_Rhoy()
	1245	zrhot = Agrif_rhot()
	1246	! Time indexes bounds for integration
	1247	zt0 = REAL(Agrif_NbStepint() , wp) / zrhot
	1248	zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot
[12377]	1249	!
	1250	DO ji = i1, i2
	1251	DO jj = j1, j2
	1252	IF ( utint_stage(ji,jj) < (bdy_tinterp + 1) ) THEN
	1253	IF ( utint_stage(ji,jj) == 1 ) THEN
	1254	ztcoeff = zrhot * ( zt1*2._wp ( zt1 - 1._wp) &
	1255	& - zt0*2._wp ( zt0 - 1._wp) )
	1256	ELSEIF( utint_stage(ji,jj) == 2 ) THEN
	1257	ztcoeff = zrhot * ( zt1 * ( zt1 - 1._wp)**2._wp &
	1258	& - zt0 * ( zt0 - 1._wp)**2._wp )
	1259	ELSEIF( utint_stage(ji,jj) == 0 ) THEN
	1260	ztcoeff = 1._wp
	1261	ELSE
	1262	ztcoeff = 0._wp
	1263	ENDIF
	1264	!
	1265	ubdy(ji,jj) = ubdy(ji,jj) + ztcoeff * ptab(ji,jj)
	1266	!
	1267	IF (( utint_stage(ji,jj) == 2 ).OR.( utint_stage(ji,jj) == 0 )) THEN
	1268	ubdy(ji,jj) = ubdy(ji,jj) / (zrhoye2u(ji,jj)) umask(ji,jj,1)
	1269	ENDIF
	1270	!
	1271	utint_stage(ji,jj) = utint_stage(ji,jj) + 1
	1272	ENDIF
	1273	END DO
	1274	END DO
	1275	END IF
[5656]	1276	!
	1277	END SUBROUTINE interpunb
[636]	1278
[6140]	1279
[12377]	1280	SUBROUTINE interpvnb( ptab, i1, i2, j1, j2, before )
[1605]	1281	!!----------------------------------------------------------------------
[5656]	1282	!! * ROUTINE interpvnb *
[1605]	1283	!!----------------------------------------------------------------------
[6140]	1284	INTEGER , INTENT(in ) :: i1, i2, j1, j2
	1285	REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
	1286	LOGICAL , INTENT(in ) :: before
	1287	!
[12377]	1288	INTEGER :: ji, jj
[6140]	1289	REAL(wp) :: zrhox, zrhot, zt0, zt1, ztcoeff
[1605]	1290	!!----------------------------------------------------------------------
[5656]	1291	!
[6140]	1292	IF( before ) THEN
[12377]	1293	ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * hv(i1:i2,j1:j2,Kmm_a) * vv_b(i1:i2,j1:j2,Kmm_a)
[5656]	1294	ELSE
	1295	zrhox = Agrif_Rhox()
	1296	zrhot = Agrif_rhot()
	1297	! Time indexes bounds for integration
	1298	zt0 = REAL(Agrif_NbStepint() , wp) / zrhot
[12377]	1299	zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot
	1300	!
	1301	DO ji = i1, i2
	1302	DO jj = j1, j2
	1303	IF ( vtint_stage(ji,jj) < (bdy_tinterp + 1) ) THEN
	1304	IF ( vtint_stage(ji,jj) == 1 ) THEN
	1305	ztcoeff = zrhot * ( zt1*2._wp ( zt1 - 1._wp) &
	1306	& - zt0*2._wp ( zt0 - 1._wp) )
	1307	ELSEIF( vtint_stage(ji,jj) == 2 ) THEN
	1308	ztcoeff = zrhot * ( zt1 * ( zt1 - 1._wp)**2._wp &
	1309	& - zt0 * ( zt0 - 1._wp)**2._wp )
	1310	ELSEIF( vtint_stage(ji,jj) == 0 ) THEN
	1311	ztcoeff = 1._wp
	1312	ELSE
	1313	ztcoeff = 0._wp
	1314	ENDIF
	1315	!
	1316	vbdy(ji,jj) = vbdy(ji,jj) + ztcoeff * ptab(ji,jj)
	1317	!
	1318	IF (( vtint_stage(ji,jj) == 2 ).OR.( vtint_stage(ji,jj) == 0 )) THEN
	1319	vbdy(ji,jj) = vbdy(ji,jj) / (zrhoxe1v(ji,jj)) vmask(ji,jj,1)
	1320	ENDIF
	1321	!
	1322	vtint_stage(ji,jj) = vtint_stage(ji,jj) + 1
	1323	ENDIF
	1324	END DO
	1325	END DO
[5656]	1326	ENDIF
	1327	!
	1328	END SUBROUTINE interpvnb
[390]	1329
[6140]	1330
[12377]	1331	SUBROUTINE interpub2b( ptab, i1, i2, j1, j2, before )
[1605]	1332	!!----------------------------------------------------------------------
[5656]	1333	!! * ROUTINE interpub2b *
[1605]	1334	!!----------------------------------------------------------------------
[6140]	1335	INTEGER , INTENT(in ) :: i1, i2, j1, j2
	1336	REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
	1337	LOGICAL , INTENT(in ) :: before
	1338	!
	1339	INTEGER :: ji,jj
[12377]	1340	REAL(wp) :: zrhot, zt0, zt1, zat
[1605]	1341	!!----------------------------------------------------------------------
[5656]	1342	IF( before ) THEN
[14053]	1343	! IF ( ln_bt_fw ) THEN
[9031]	1344	ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * ub2_b(i1:i2,j1:j2)
[14053]	1345	! ELSE
	1346	! ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * un_adv(i1:i2,j1:j2)
	1347	! ENDIF
[5656]	1348	ELSE
	1349	zrhot = Agrif_rhot()
	1350	! Time indexes bounds for integration
	1351	zt0 = REAL(Agrif_NbStepint() , wp) / zrhot
	1352	zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot
	1353	! Polynomial interpolation coefficients:
[6140]	1354	zat = zrhot * ( zt1*2._wp (-2._wp*zt1 + 3._wp) &
	1355	& - zt0*2._wp (-2._wp*zt0 + 3._wp) )
[12377]	1356	!
	1357	ubdy(i1:i2,j1:j2) = zat * ptab(i1:i2,j1:j2)
	1358	!
	1359	! Update interpolation stage:
	1360	utint_stage(i1:i2,j1:j2) = 1
[5656]	1361	ENDIF
	1362	!
	1363	END SUBROUTINE interpub2b
[6140]	1364
[14086]	1365	SUBROUTINE interpub2b_const( ptab, i1, i2, j1, j2, before )
	1366	!!----------------------------------------------------------------------
	1367	!! * ROUTINE interpub2b_const *
	1368	!!----------------------------------------------------------------------
	1369	INTEGER , INTENT(in ) :: i1, i2, j1, j2
	1370	REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
	1371	LOGICAL , INTENT(in ) :: before
	1372	!
	1373	REAL(wp) :: zrhoy
	1374	!!----------------------------------------------------------------------
	1375	IF( before ) THEN
	1376	! IF ( ln_bt_fw ) THEN
	1377	ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * ub2_b(i1:i2,j1:j2)
	1378	! ELSE
	1379	! ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * un_adv(i1:i2,j1:j2)
	1380	! ENDIF
	1381	ELSE
	1382	zrhoy = Agrif_Rhoy()
	1383	!
	1384	ubdy(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) &
	1385	& / (zrhoye2u(i1:i2,j1:j2)) umask(i1:i2,j1:j2,1)
	1386	!
	1387	ENDIF
	1388	!
	1389	END SUBROUTINE interpub2b_const
[636]	1390
[14086]	1391
	1392	SUBROUTINE ub2b_cor( ptab, i1, i2, j1, j2, before )
	1393	!!----------------------------------------------------------------------
	1394	!! * ROUTINE ub2b_cor *
	1395	!!----------------------------------------------------------------------
	1396	INTEGER , INTENT(in ) :: i1, i2, j1, j2
	1397	REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
	1398	LOGICAL , INTENT(in ) :: before
	1399	!
	1400	INTEGER :: ji, jj
	1401	REAL(wp) :: zrhox, zrhoy, zx
	1402	!!----------------------------------------------------------------------
	1403	IF( before ) THEN
	1404	ptab(:,:) = 0._wp
	1405	DO ji=i1+1,i2-1
[14122]	1406	DO jj=j1+1,j2-1
[14086]	1407	ptab(ji,jj) = 0.25_wp( ( vb2_b(ji+1,jj )e1v(ji+1,jj ) &
	1408	& -vb2_b(ji-1,jj )*e1v(ji-1,jj ) ) &
	1409	& -( vb2_b(ji+1,jj-1)*e1v(ji+1,jj-1) &
	1410	& -vb2_b(ji-1,jj-1)*e1v(ji-1,jj-1) ) )
	1411	END DO
	1412	END DO
	1413	ELSE
	1414	!
	1415	zrhox = Agrif_Rhox()
	1416	zrhoy = Agrif_Rhoy()
	1417	DO ji=i1,i2
	1418	DO jj=j1,j2
	1419	IF (utint_stage(ji,jj)==0) THEN
	1420	zx = 2._wp*MOD(ABS(mig0(ji)-nbghostcells-1), INT(Agrif_Rhox()))/zrhox - 1._wp
	1421	ubdy(ji,jj) = ubdy(ji,jj) + 0.25_wp(1._wp-zxzx) * ptab(ji,jj) &
	1422	& / zrhoy r1_e2u(ji,jj) umask(ji,jj,1)
	1423	utint_stage(ji,jj) = 1
	1424	ENDIF
	1425	END DO
	1426	END DO
	1427	!
	1428	ENDIF
	1429	!
	1430	END SUBROUTINE ub2b_cor
	1431
	1432
[12377]	1433	SUBROUTINE interpvb2b( ptab, i1, i2, j1, j2, before )
[4292]	1434	!!----------------------------------------------------------------------
[5656]	1435	!! * ROUTINE interpvb2b *
[4292]	1436	!!----------------------------------------------------------------------
[6140]	1437	INTEGER , INTENT(in ) :: i1, i2, j1, j2
	1438	REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
	1439	LOGICAL , INTENT(in ) :: before
	1440	!
	1441	INTEGER :: ji,jj
[12377]	1442	REAL(wp) :: zrhot, zt0, zt1, zat
[4292]	1443	!!----------------------------------------------------------------------
[5656]	1444	!
	1445	IF( before ) THEN
[14053]	1446	! IF ( ln_bt_fw ) THEN
[9031]	1447	ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2)
[14053]	1448	! ELSE
	1449	! ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vn_adv(i1:i2,j1:j2)
	1450	! ENDIF
[5656]	1451	ELSE
	1452	zrhot = Agrif_rhot()
	1453	! Time indexes bounds for integration
	1454	zt0 = REAL(Agrif_NbStepint() , wp) / zrhot
	1455	zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot
	1456	! Polynomial interpolation coefficients:
[6140]	1457	zat = zrhot * ( zt1*2._wp (-2._wp*zt1 + 3._wp) &
	1458	& - zt0*2._wp (-2._wp*zt0 + 3._wp) )
[5656]	1459	!
[12377]	1460	vbdy(i1:i2,j1:j2) = zat * ptab(i1:i2,j1:j2)
	1461	!
	1462	! update interpolation stage:
	1463	vtint_stage(i1:i2,j1:j2) = 1
[5656]	1464	ENDIF
	1465	!
	1466	END SUBROUTINE interpvb2b
[4292]	1467
[6140]	1468
[14086]	1469	SUBROUTINE interpvb2b_const( ptab, i1, i2, j1, j2, before )
	1470	!!----------------------------------------------------------------------
	1471	!! * ROUTINE interpub2b_const *
	1472	!!----------------------------------------------------------------------
	1473	INTEGER , INTENT(in ) :: i1, i2, j1, j2
	1474	REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
	1475	LOGICAL , INTENT(in ) :: before
	1476	!
	1477	REAL(wp) :: zrhox
	1478	!!----------------------------------------------------------------------
	1479	IF( before ) THEN
	1480	! IF ( ln_bt_fw ) THEN
	1481	ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2)
	1482	! ELSE
	1483	! ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vn_adv(i1:i2,j1:j2)
	1484	! ENDIF
	1485	ELSE
	1486	zrhox = Agrif_Rhox()
	1487	!
	1488	vbdy(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) &
	1489	& / (zrhoxe1v(i1:i2,j1:j2)) vmask(i1:i2,j1:j2,1)
	1490	!
	1491	ENDIF
	1492	!
	1493	END SUBROUTINE interpvb2b_const
	1494
	1495
	1496	SUBROUTINE vb2b_cor( ptab, i1, i2, j1, j2, before )
	1497	!!----------------------------------------------------------------------
	1498	!! * ROUTINE vb2b_cor *
	1499	!!----------------------------------------------------------------------
	1500	INTEGER , INTENT(in ) :: i1, i2, j1, j2
	1501	REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
	1502	LOGICAL , INTENT(in ) :: before
	1503	!
	1504	INTEGER :: ji, jj
	1505	REAL(wp) :: zrhox, zrhoy, zy
	1506	!!----------------------------------------------------------------------
	1507	IF( before ) THEN
	1508	ptab(:,:) = 0._wp
	1509	DO ji=i1+1,i2-1
[14122]	1510	DO jj=j1+1,j2-1
[14086]	1511	ptab(ji,jj) = 0.25_wp( ( ub2_b(ji ,jj+1)e2u(ji ,jj+1) &
	1512	& -ub2_b(ji ,jj-1)*e2u(ji ,jj-1) ) &
	1513	& -( ub2_b(ji-1,jj+1)*e2u(ji-1,jj+1) &
	1514	& -ub2_b(ji-1,jj-1)*e2u(ji-1,jj-1) ) )
	1515	END DO
	1516	END DO
	1517	ELSE
	1518	!
	1519	zrhox = Agrif_Rhox()
	1520	zrhoy = Agrif_Rhoy()
	1521	DO ji=i1,i2
	1522	DO jj=j1,j2
	1523	IF (vtint_stage(ji,jj)==0) THEN
	1524	zy = 2._wp*MOD(ABS(mjg0(jj)-nbghostcells-1), INT(Agrif_Rhoy()))/zrhoy - 1._wp
	1525	vbdy(ji,jj) = vbdy(ji,jj) + 0.25_wp(1._wp-zyzy) * ptab(ji,jj) &
	1526	& / zrhox * r1_e1v(ji,jj) * vmask(ji,jj,1)
	1527	vtint_stage(ji,jj) = 1
	1528	ENDIF
	1529	END DO
	1530	END DO
	1531	!
	1532	ENDIF
	1533	!
	1534	END SUBROUTINE vb2b_cor
	1535
	1536
	1537	SUBROUTINE interpe3t0_vremap( ptab, i1, i2, j1, j2, k1, k2, before )
	1538	!!----------------------------------------------------------------------
	1539	!! * ROUTINE interpe3t0_vremap *
	1540	!!----------------------------------------------------------------------
	1541	INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2
	1542	REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
	1543	LOGICAL , INTENT(in ) :: before
	1544	!
	1545	INTEGER :: ji, jj, jk
	1546	REAL(wp) :: zh
	1547	!!----------------------------------------------------------------------
	1548	!
	1549	IF( before ) THEN
	1550	IF ( ln_zps ) THEN
	1551	DO jk = k1, k2
	1552	DO jj = j1, j2
	1553	DO ji = i1, i2
	1554	ptab(ji, jj, jk) = e3t_1d(jk)
	1555	END DO
	1556	END DO
	1557	END DO
	1558	ELSE
	1559	ptab(i1:i2,j1:j2,k1:k2) = e3t_0(i1:i2,j1:j2,k1:k2)
	1560	ENDIF
	1561	ELSE
	1562	!
	1563	DO jk = k1, k2
	1564	DO jj = j1, j2
	1565	DO ji = i1, i2
	1566	e3t0_parent(ji,jj,jk) = ptab(ji,jj,jk)
	1567	END DO
	1568	END DO
	1569	END DO
	1570
	1571	! Retrieve correct scale factor at the bottom:
	1572	DO jj = j1, j2
	1573	DO ji = i1, i2
	1574	zh = 0._wp
	1575	DO jk = 1, mbkt_parent(ji, jj)-1
	1576	zh = zh + e3t0_parent(ji,jj,jk)
	1577	END DO
	1578	e3t0_parent(ji,jj,mbkt_parent(ji,jj)) = ht0_parent(ji, jj) - zh
	1579	END DO
	1580	END DO
	1581
	1582	ENDIF
	1583	!
	1584	END SUBROUTINE interpe3t0_vremap
	1585
	1586
[13286]	1587	SUBROUTINE interpglamt( ptab, i1, i2, j1, j2, before )
	1588	!!----------------------------------------------------------------------
	1589	!! * ROUTINE interpglamt *
	1590	!!----------------------------------------------------------------------
	1591	INTEGER , INTENT(in ) :: i1, i2, j1, j2
	1592	REAL(wp),DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
	1593	LOGICAL , INTENT(in ) :: before
	1594	!
	1595	INTEGER :: ji, jj, jk
	1596	REAL(wp):: ztst
	1597	!!----------------------------------------------------------------------
	1598	!
	1599	IF( before ) THEN
	1600	ptab(i1:i2,j1:j2) = glamt(i1:i2,j1:j2)
	1601	ELSE
	1602	ztst = MAXVAL(ABS(glamt(i1:i2,j1:j2)))*1.e-4
	1603	DO jj = j1, j2
	1604	DO ji = i1, i2
	1605	IF( ABS( ptab(ji,jj) - glamt(ji,jj) ) > ztst ) THEN
	1606	WRITE(numout,*) ' Agrif error for glamt: parent, child, i, j ', ptab(ji,jj), glamt(ji,jj), mig0(ji), mig0(jj)
	1607	! kindic_agr = kindic_agr + 1
	1608	ENDIF
	1609	END DO
	1610	END DO
	1611	ENDIF
	1612	!
	1613	END SUBROUTINE interpglamt
	1614
	1615
	1616	SUBROUTINE interpgphit( ptab, i1, i2, j1, j2, before )
	1617	!!----------------------------------------------------------------------
	1618	!! * ROUTINE interpgphit *
	1619	!!----------------------------------------------------------------------
	1620	INTEGER , INTENT(in ) :: i1, i2, j1, j2
	1621	REAL(wp),DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
	1622	LOGICAL , INTENT(in ) :: before
	1623	!
	1624	INTEGER :: ji, jj, jk
	1625	REAL(wp):: ztst
	1626	!!----------------------------------------------------------------------
	1627	!
	1628	IF( before ) THEN
	1629	ptab(i1:i2,j1:j2) = gphit(i1:i2,j1:j2)
	1630	ELSE
	1631	ztst = MAXVAL(ABS(gphit(i1:i2,j1:j2)))*1.e-4
	1632	DO jj = j1, j2
	1633	DO ji = i1, i2
	1634	IF( ABS( ptab(ji,jj) - gphit(ji,jj) ) > ztst ) THEN
	1635	WRITE(numout,*) ' Agrif error for gphit: parent, child, i, j ', ptab(ji,jj), gphit(ji,jj), mig0(ji), mig0(jj)
	1636	! kindic_agr = kindic_agr + 1
	1637	ENDIF
	1638	END DO
	1639	END DO
	1640	ENDIF
	1641	!
	1642	END SUBROUTINE interpgphit
	1643
	1644
[9031]	1645	SUBROUTINE interpavm( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before )
[4486]	1646	!!----------------------------------------------------------------------
[5656]	1647	!! * ROUTINE interavm *
[4486]	1648	!!----------------------------------------------------------------------
[9116]	1649	INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, m1, m2
[9031]	1650	REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,m1:m2), INTENT(inout) :: ptab
[9116]	1651	LOGICAL , INTENT(in ) :: before
[12377]	1652	!
	1653	INTEGER :: ji, jj, jk
	1654	INTEGER :: N_in, N_out
	1655	REAL(wp), DIMENSION(k1:k2) :: tabin, z_in
	1656	REAL(wp), DIMENSION(1:jpk) :: z_out
[4486]	1657	!!----------------------------------------------------------------------
[5656]	1658	!
[9031]	1659	IF (before) THEN
	1660	DO jk=k1,k2
	1661	DO jj=j1,j2
	1662	DO ji=i1,i2
	1663	ptab(ji,jj,jk,1) = avm_k(ji,jj,jk)
	1664	END DO
	1665	END DO
[13216]	1666	END DO
[12377]	1667
[13216]	1668	IF( l_vremap ) THEN
[14218]	1669	! Interpolate interfaces
[13216]	1670	! Warning: these are masked, hence extrapolated prior interpolation.
	1671	DO jk=k1,k2
	1672	DO jj=j1,j2
	1673	DO ji=i1,i2
[14218]	1674	ptab(ji,jj,jk,2) = tmask(ji,jj,jk) * gdepw(ji,jj,jk,Kmm_a)
[13216]	1675	END DO
	1676	END DO
	1677	END DO
	1678
	1679	! Save ssh at last level:
	1680	IF (.NOT.ln_linssh) THEN
	1681	ptab(i1:i2,j1:j2,k2,2) = ssh(i1:i2,j1:j2,Kmm_a)*tmask(i1:i2,j1:j2,1)
	1682	ELSE
	1683	ptab(i1:i2,j1:j2,k2,2) = 0._wp
	1684	END IF
	1685	ENDIF
	1686
[9031]	1687	ELSE
[13216]	1688
	1689	IF( l_vremap ) THEN
	1690	IF (ln_linssh) ptab(i1:i2,j1:j2,k2,2) = 0._wp
[14218]	1691	avm_k(i1:i2,j1:j2,1:jpkm1) = 0._wp
[13216]	1692
	1693	DO jj = j1, j2
	1694	DO ji =i1, i2
	1695	N_in = mbkt_parent(ji,jj)
[14218]	1696	N_out = mbkt(ji,jj)
[13216]	1697	IF (N_in*N_out > 0) THEN
[14218]	1698	DO jk = 1, N_in ! Parent vertical grid
	1699	z_in(jk) = ptab(ji,jj,jk,2) - ptab(ji,jj,k2,2)
	1700	tabin(jk) = ptab(ji,jj,jk,1)
	1701	END DO
	1702	DO jk = 1, N_out ! Child vertical grid
	1703	z_out(jk) = gdepw(ji,jj,jk,Kmm_a) - ssh(ji,jj,Kmm_a)
	1704	END DO
	1705	IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out) - ssh(ji,jj,Kmm_a)
	1706
[13216]	1707	CALL remap_linear(tabin(1:N_in),z_in(1:N_in),avm_k(ji,jj,1:N_out),z_out(1:N_out),N_in,N_out,1)
	1708	ENDIF
[13286]	1709	END DO
	1710	END DO
[13216]	1711	ELSE
[14218]	1712	avm_k(i1:i2,j1:j2,1:jpkm1) = ptab (i1:i2,j1:j2,1:jpkm1,1)
[13216]	1713	ENDIF
[5656]	1714	ENDIF
	1715	!
	1716	END SUBROUTINE interpavm
[4486]	1717
[13286]	1718
[12377]	1719	SUBROUTINE interpmbkt( ptab, i1, i2, j1, j2, before )
	1720	!!----------------------------------------------------------------------
[14086]	1721	!! * ROUTINE interpmbkt *
[12377]	1722	!!----------------------------------------------------------------------
	1723	INTEGER , INTENT(in ) :: i1, i2, j1, j2
	1724	REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
	1725	LOGICAL , INTENT(in ) :: before
	1726	!
	1727	!!----------------------------------------------------------------------
	1728	!
	1729	IF( before) THEN
	1730	ptab(i1:i2,j1:j2) = REAL(mbkt(i1:i2,j1:j2),wp)
	1731	ELSE
	1732	mbkt_parent(i1:i2,j1:j2) = NINT(ptab(i1:i2,j1:j2))
	1733	ENDIF
	1734	!
	1735	END SUBROUTINE interpmbkt
	1736
[13286]	1737
[12377]	1738	SUBROUTINE interpht0( ptab, i1, i2, j1, j2, before )
	1739	!!----------------------------------------------------------------------
[14086]	1740	!! * ROUTINE interpht0 *
[12377]	1741	!!----------------------------------------------------------------------
	1742	INTEGER , INTENT(in ) :: i1, i2, j1, j2
	1743	REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
	1744	LOGICAL , INTENT(in ) :: before
	1745	!
	1746	!!----------------------------------------------------------------------
	1747	!
	1748	IF( before) THEN
	1749	ptab(i1:i2,j1:j2) = ht_0(i1:i2,j1:j2)
	1750	ELSE
	1751	ht0_parent(i1:i2,j1:j2) = ptab(i1:i2,j1:j2)
	1752	ENDIF
	1753	!
	1754	END SUBROUTINE interpht0
	1755
[14086]	1756	SUBROUTINE Agrif_check_bat( iindic )
[13216]	1757	!!----------------------------------------------------------------------
[14086]	1758	!! * ROUTINE Agrif_check_bat *
[13216]	1759	!!----------------------------------------------------------------------
[14086]	1760	INTEGER, INTENT(inout) :: iindic
	1761	!!
[14641]	1762	INTEGER :: ji, jj, jk
[14086]	1763	INTEGER :: istart, iend, jstart, jend, ispon
[13216]	1764	!!----------------------------------------------------------------------
	1765	!
[14086]	1766	!
	1767	! --- West --- !
	1768	IF(lk_west) THEN
	1769	ispon = nn_sponge_len * Agrif_irhox()
[14641]	1770	istart = nn_hls + 1 ! halo + land + 1
[14086]	1771	iend = nn_hls + 1 + nbghostcells + ispon ! halo + land + nbghostcells + sponge
[14641]	1772	jstart = nn_hls + 1
	1773	jend = jpjglo - nn_hls
[14086]	1774	DO ji = mi0(istart), mi1(iend)
	1775	DO jj = mj0(jstart), mj1(jend)
	1776	IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
[14641]	1777	IF ( .NOT.ln_vert_remap) THEN
	1778	DO jk = 1, jpkm1
	1779	IF ( ABS(e3t0_parent(ji,jj,jk)-e3t_0(ji,jj,jk))*tmask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1
	1780	END DO
	1781	ENDIF
[14086]	1782	END DO
	1783	DO jj = mj0(jstart), mj1(jend-1)
	1784	IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
[14641]	1785	IF ( .NOT.ln_vert_remap) THEN
	1786	DO jk = 1, jpkm1
	1787	IF ( ABS(e3v0_parent(ji,jj,jk)-e3v_0(ji,jj,jk))*vmask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1
	1788	END DO
	1789	ENDIF
[14086]	1790	END DO
	1791	END DO
	1792	DO ji = mi0(istart), mi1(iend-1)
	1793	DO jj = mj0(jstart), mj1(jend)
	1794	IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
[14641]	1795	IF ( .NOT.ln_vert_remap) THEN
	1796	DO jk = 1, jpkm1
	1797	IF ( ABS(e3u0_parent(ji,jj,jk)-e3u_0(ji,jj,jk))*umask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1
	1798	END DO
	1799	ENDIF
[14086]	1800	END DO
	1801	END DO
[13216]	1802	ENDIF
	1803	!
[14086]	1804	! --- East --- !
	1805	IF(lk_east) THEN
	1806	ispon = nn_sponge_len * Agrif_irhox()
	1807	istart = jpiglo - ( nn_hls + nbghostcells + ispon ) ! halo + land + nbghostcells + sponge - 1
[14641]	1808	iend = jpiglo - nn_hls ! halo + land + 1 - 1
	1809	jstart = nn_hls + 1
	1810	jend = jpjglo - nn_hls
[14086]	1811	DO ji = mi0(istart), mi1(iend)
	1812	DO jj = mj0(jstart), mj1(jend)
	1813	IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
[14641]	1814	IF ( .NOT.ln_vert_remap) THEN
	1815	DO jk = 1, jpkm1
	1816	IF ( ABS(e3t0_parent(ji,jj,jk)-e3t_0(ji,jj,jk))*tmask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1
	1817	END DO
	1818	ENDIF
[14086]	1819	END DO
	1820	DO jj = mj0(jstart), mj1(jend-1)
	1821	IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
[14641]	1822	IF ( .NOT.ln_vert_remap) THEN
	1823	DO jk = 1, jpkm1
	1824	IF ( ABS(e3v0_parent(ji,jj,jk)-e3v_0(ji,jj,jk))*vmask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1
	1825	END DO
	1826	ENDIF
[14086]	1827	END DO
	1828	END DO
[14641]	1829	DO ji = mi0(istart), mi1(iend-1)
[14086]	1830	DO jj = mj0(jstart), mj1(jend)
	1831	IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
[14641]	1832	IF ( .NOT.ln_vert_remap) THEN
	1833	DO jk = 1, jpkm1
	1834	IF ( ABS(e3u0_parent(ji,jj,jk)-e3u_0(ji,jj,jk))*umask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1
	1835	END DO
	1836	ENDIF
[14086]	1837	END DO
	1838	END DO
	1839	ENDIF
	1840	!
	1841	! --- South --- !
	1842	IF(lk_south) THEN
[14641]	1843	ispon = nn_sponge_len * Agrif_irhoy()
	1844	jstart = nn_hls + 1 ! halo + land + 1
[14086]	1845	jend = nn_hls + 1 + nbghostcells + ispon ! halo + land + nbghostcells + sponge
[14641]	1846	istart = nn_hls + 1
	1847	iend = jpiglo - nn_hls
[14086]	1848	DO jj = mj0(jstart), mj1(jend)
	1849	DO ji = mi0(istart), mi1(iend)
	1850	IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
[14641]	1851	IF ( .NOT.ln_vert_remap) THEN
	1852	DO jk = 1, jpkm1
	1853	IF ( ABS(e3t0_parent(ji,jj,jk)-e3t_0(ji,jj,jk))*tmask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1
	1854	END DO
	1855	ENDIF
[14086]	1856	END DO
	1857	DO ji = mi0(istart), mi1(iend-1)
	1858	IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
[14641]	1859	IF ( .NOT.ln_vert_remap) THEN
	1860	DO jk = 1, jpkm1
	1861	IF ( ABS(e3u0_parent(ji,jj,jk)-e3u_0(ji,jj,jk))*umask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1
	1862	END DO
	1863	ENDIF
[14086]	1864	END DO
	1865	END DO
	1866	DO jj = mj0(jstart), mj1(jend-1)
	1867	DO ji = mi0(istart), mi1(iend)
	1868	IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
[14641]	1869	IF ( .NOT.ln_vert_remap) THEN
	1870	DO jk = 1, jpkm1
	1871	IF ( ABS(e3v0_parent(ji,jj,jk)-e3v_0(ji,jj,jk))*vmask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1
	1872	END DO
	1873	ENDIF
[14086]	1874	END DO
	1875	END DO
	1876	ENDIF
	1877	!
	1878	! --- North --- !
	1879	IF(lk_north) THEN
	1880	ispon = nn_sponge_len * Agrif_irhoy()
	1881	jstart = jpjglo - ( nn_hls + nbghostcells + ispon) ! halo + land + nbghostcells +sponge - 1
[14641]	1882	jend = jpjglo - nn_hls ! halo + land + 1 - 1
	1883	istart = nn_hls + 1
	1884	iend = jpiglo - nn_hls
[14086]	1885	DO jj = mj0(jstart), mj1(jend)
	1886	DO ji = mi0(istart), mi1(iend)
	1887	IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
[14641]	1888	IF ( .NOT.ln_vert_remap) THEN
	1889	DO jk = 1, jpkm1
	1890	IF ( ABS(e3t0_parent(ji,jj,jk)-e3t_0(ji,jj,jk))*tmask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1
	1891	END DO
	1892	ENDIF
[14086]	1893	END DO
	1894	DO ji = mi0(istart), mi1(iend-1)
	1895	IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
[14641]	1896	IF ( .NOT.ln_vert_remap) THEN
	1897	DO jk = 1, jpkm1
	1898	IF ( ABS(e3u0_parent(ji,jj,jk)-e3u_0(ji,jj,jk))*umask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1
	1899	END DO
	1900	ENDIF
[14086]	1901	END DO
	1902	END DO
[14641]	1903	DO jj = mj0(jstart), mj1(jend-1)
[14086]	1904	DO ji = mi0(istart), mi1(iend)
	1905	IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
[14641]	1906	IF ( .NOT.ln_vert_remap) THEN
	1907	DO jk = 1, jpkm1
	1908	IF ( ABS(e3v0_parent(ji,jj,jk)-e3v_0(ji,jj,jk))*vmask(ji,jj,jk) > 1.e-3 ) iindic = iindic + 1
	1909	END DO
	1910	ENDIF
[14086]	1911	END DO
	1912	END DO
	1913	ENDIF
	1914	!
	1915	END SUBROUTINE Agrif_check_bat
[13216]	1916
[390]	1917	#else
[1605]	1918	!!----------------------------------------------------------------------
	1919	!! Empty module no AGRIF zoom
	1920	!!----------------------------------------------------------------------
[636]	1921	CONTAINS
[9570]	1922	SUBROUTINE Agrif_OCE_Interp_empty
	1923	WRITE(,) 'agrif_oce_interp : You should not have seen this print! error?'
	1924	END SUBROUTINE Agrif_OCE_Interp_empty
[390]	1925	#endif
[1605]	1926
	1927	!!======================================================================
[9570]	1928	END MODULE agrif_oce_interp

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

Download in other formats: