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

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

agrif_user.F90 in NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/NST – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/NST/agrif_user.F90 @ 13076

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

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

Download in other formats: