New URL for NEMO forge! http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

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

Context Navigation

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

Last change on this file since 13226 was 13226, checked in by orioltp, 4 years ago
Merging dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation into the trunk
Property svn:keywords set to `Id`
File size: 50.5 KB

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

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

Download in other formats: