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/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST – NEMO

Context Navigation

source: NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_user.F90 @ 12048

Last change on this file since 12048 was 12048, checked in by jchanut, 4 years ago
#2222, add small tolerance for bathymetry matching test; correct U-V parent bathymetry on child grid in the special case of s coord into s coord
Property svn:keywords set to `Id`
File size: 38.1 KB

Rev	Line
[9096]	1	#undef UPD_HIGH /* MIX HIGH UPDATE */
[393]	2	#if defined key_agrif
[10068]	3	!!----------------------------------------------------------------------
	4	!! NEMO/NST 4.0 , NEMO Consortium (2018)
	5	!! $Id$
	6	!! Software governed by the CeCILL license (see ./LICENSE)
	7	!!----------------------------------------------------------------------
[11574]	8	SUBROUTINE agrif_user
	9	END SUBROUTINE agrif_user
[3680]	10
[11574]	11	SUBROUTINE agrif_before_regridding
	12	END SUBROUTINE agrif_before_regridding
[3680]	13
[11574]	14	SUBROUTINE Agrif_InitWorkspace
	15	END SUBROUTINE Agrif_InitWorkspace
[1156]	16
[11574]	17	SUBROUTINE Agrif_InitValues
[10068]	18	!!----------------------------------------------------------------------
	19	!! * ROUTINE Agrif_InitValues *
	20	!!----------------------------------------------------------------------
[11574]	21	USE nemogcm
[10068]	22	!!----------------------------------------------------------------------
[11574]	23	!
	24	CALL nemo_init !* Initializations of each fine grid
	25	!
	26	! !* Agrif initialization
	27	CALL agrif_nemo_init
	28	CALL Agrif_InitValues_cont_dom
	29	CALL Agrif_InitValues_cont
[2715]	30	# if defined key_top
[11574]	31	CALL Agrif_InitValues_cont_top
[7646]	32	# endif
[9570]	33	# if defined key_si3
[11574]	34	CALL Agrif_InitValues_cont_ice
[7761]	35	# endif
[11574]	36	!
	37	END SUBROUTINE Agrif_initvalues
[2031]	38
[11574]	39	SUBROUTINE Agrif_InitValues_cont_dom
[10068]	40	!!----------------------------------------------------------------------
[11574]	41	!! * ROUTINE Agrif_InitValues_cont_dom *
[10068]	42	!!----------------------------------------------------------------------
[11574]	43	!
	44	CALL agrif_declare_var_dom
	45	!
	46	END SUBROUTINE Agrif_InitValues_cont_dom
[3680]	47
[11574]	48	SUBROUTINE agrif_declare_var_dom
[10068]	49	!!----------------------------------------------------------------------
[11574]	50	!! * ROUTINE agrif_declare_var_dom *
[10068]	51	!!----------------------------------------------------------------------
[11574]	52	USE par_oce, ONLY: nbghostcells
	53	!
	54	IMPLICIT NONE
	55	!
	56	INTEGER :: ind1, ind2, ind3
[10068]	57	!!----------------------------------------------------------------------
[3680]	58
[10068]	59	! 1. Declaration of the type of variable which have to be interpolated
	60	!---------------------------------------------------------------------
[11574]	61	ind1 = nbghostcells
	62	ind2 = 1 + nbghostcells
	63	ind3 = 2 + nbghostcells
	64	CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id)
	65	CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id)
[3680]	66
[10068]	67	! 2. Type of interpolation
	68	!-------------------------
[11574]	69	CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm )
	70	CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm , interp2=Agrif_linear )
[3680]	71
[10068]	72	! 3. Location of interpolation
	73	!-----------------------------
[11574]	74	CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/))
	75	CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/))
[3680]	76
[10068]	77	! 4. Update type
	78	!---------------
[9031]	79	# if defined UPD_HIGH
[11574]	80	CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting)
	81	CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average)
[9031]	82	#else
[11574]	83	CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
	84	CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
[9031]	85	#endif
[3680]	86
[11574]	87	END SUBROUTINE agrif_declare_var_dom
[3680]	88
[11574]	89	SUBROUTINE Agrif_InitValues_cont
[10068]	90	!!----------------------------------------------------------------------
	91	!! * ROUTINE Agrif_InitValues_cont *
	92	!!----------------------------------------------------------------------
[11574]	93	USE agrif_oce
	94	USE agrif_oce_interp
	95	USE agrif_oce_sponge
	96	USE dom_oce
	97	USE oce
	98	USE lib_mpp
[11741]	99	USE lbclnk
[11574]	100	!
	101	IMPLICIT NONE
	102	!
[11741]	103	INTEGER :: ji, jj
[11574]	104	LOGICAL :: check_namelist
	105	CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4
[11741]	106	#if defined key_vertical
	107	REAL(wp), DIMENSION(jpi,jpj) :: zk ! workspace
	108	#endif
[10068]	109	!!----------------------------------------------------------------------
[390]	110
[11574]	111	! 1. Declaration of the type of variable which have to be interpolated
	112	!---------------------------------------------------------------------
	113	CALL agrif_declare_var
[636]	114
[11574]	115	! 2. First interpolations of potentially non zero fields
	116	!-------------------------------------------------------
[11741]	117
	118	#if defined key_vertical
	119	! Build consistent parent bathymetry and number of levels
	120	! on the child grid
	121	Agrif_UseSpecialValue = .FALSE.
	122	ht0_parent(:,:) = 0._wp
	123	mbkt_parent(:,:) = 0
	124	!
	125	CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 )
	126	CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt)
	127	!
[11868]	128	! Assume step wise change of bathymetry near interface
	129	! TODO: Switch to linear interpolation of bathymetry in the s-coordinate case
	130	! and no refinement
[11741]	131	DO jj = 1, jpjm1
	132	DO ji = 1, jpim1
	133	mbku_parent(ji,jj) = MIN( mbkt_parent(ji+1,jj ) , mbkt_parent(ji,jj) )
	134	mbkv_parent(ji,jj) = MIN( mbkt_parent(ji ,jj+1) , mbkt_parent(ji,jj) )
	135	END DO
	136	END DO
[12048]	137	IF ( ln_sco.AND.Agrif_Parent(ln_sco) ) THEN
	138	DO jj = 1, jpjm1
	139	DO ji = 1, jpim1
	140	hu0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji+1,jj) )
	141	hv0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji,jj+1) )
	142	END DO
	143	END DO
	144	ELSE
	145	DO jj = 1, jpjm1
	146	DO ji = 1, jpim1
	147	hu0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji+1,jj))
	148	hv0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji,jj+1))
	149	END DO
	150	END DO
	151
	152	ENDIF
[11741]	153	!
	154	CALL lbc_lnk( 'Agrif_InitValues_cont', hu0_parent, 'U', 1. )
	155	CALL lbc_lnk( 'Agrif_InitValues_cont', hv0_parent, 'V', 1. )
	156	zk(:,:) = REAL( mbku_parent(:,:), wp ) ; CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1. )
	157	mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )
	158	zk(:,:) = REAL( mbkv_parent(:,:), wp ) ; CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1. )
[11868]	159	mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )
[11741]	160	#endif
	161
[11574]	162	Agrif_SpecialValue = 0._wp
	163	Agrif_UseSpecialValue = .TRUE.
	164	CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn)
	165	CALL Agrif_Sponge
	166	tabspongedone_tsn = .FALSE.
	167	CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge)
	168	! reset tsa to zero
	169	tsa(:,:,:,:) = 0._wp
[390]	170
[11574]	171	Agrif_UseSpecialValue = ln_spc_dyn
	172	CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun)
	173	CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn)
	174	tabspongedone_u = .FALSE.
	175	tabspongedone_v = .FALSE.
	176	CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge)
	177	tabspongedone_u = .FALSE.
	178	tabspongedone_v = .FALSE.
	179	CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge)
	180	ua(:,:,:) = 0._wp
	181	va(:,:,:) = 0._wp
[4326]	182
[11574]	183	Agrif_UseSpecialValue = .TRUE.
	184	CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
	185	hbdy(:,:) = 0._wp
	186	ssha(:,:) = 0._wp
[628]	187
[11574]	188	IF ( ln_dynspg_ts ) THEN
	189	Agrif_UseSpecialValue = ln_spc_dyn
	190	CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb)
	191	CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb)
	192	CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b)
	193	CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b)
	194	ubdy(:,:) = 0._wp
	195	vbdy(:,:) = 0._wp
	196	ENDIF
[5656]	197
[11574]	198	Agrif_UseSpecialValue = .FALSE.
[5656]	199
[11574]	200	! 3. Some controls
	201	!-----------------
	202	check_namelist = .TRUE.
[3680]	203
[11574]	204	IF( check_namelist ) THEN
[3680]	205
[11574]	206	! Check time steps
	207	IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
	208	WRITE(cl_check1,*) NINT(Agrif_Parent(rdt))
	209	WRITE(cl_check2,*) NINT(rdt)
	210	WRITE(cl_check3,*) NINT(Agrif_Parent(rdt)/Agrif_Rhot())
	211	CALL ctl_stop( 'Incompatible time step between ocean grids', &
	212	& 'parent grid value : '//cl_check1 , &
	213	& 'child grid value : '//cl_check2 , &
	214	& 'value on child grid should be changed to : '//cl_check3 )
	215	ENDIF
[3680]	216
[11574]	217	! Check run length
	218	IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
	219	Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
	220	WRITE(cl_check1,) (Agrif_Parent(nit000)-1)Agrif_IRhot() + 1
	221	WRITE(cl_check2,) Agrif_Parent(nitend) Agrif_IRhot()
	222	CALL ctl_warn( 'Incompatible run length between grids' , &
	223	& 'nit000 on fine grid will be changed to : '//cl_check1, &
	224	& 'nitend on fine grid will be changed to : '//cl_check2 )
	225	nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
	226	nitend = Agrif_Parent(nitend) *Agrif_IRhot()
	227	ENDIF
[3680]	228
[11574]	229	! Check free surface scheme
	230	IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.&
	231	& ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN
	232	WRITE(cl_check1,*) Agrif_Parent( ln_dynspg_ts )
	233	WRITE(cl_check2,*) ln_dynspg_ts
	234	WRITE(cl_check3,*) Agrif_Parent( ln_dynspg_exp )
	235	WRITE(cl_check4,*) ln_dynspg_exp
	236	CALL ctl_stop( 'Incompatible free surface scheme between grids' , &
	237	& 'parent grid ln_dynspg_ts :'//cl_check1 , &
	238	& 'child grid ln_dynspg_ts :'//cl_check2 , &
	239	& 'parent grid ln_dynspg_exp :'//cl_check3 , &
	240	& 'child grid ln_dynspg_exp :'//cl_check4 , &
	241	& 'those logicals should be identical' )
	242	STOP
	243	ENDIF
[5930]	244
[11574]	245	! Check if identical linear free surface option
	246	IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.&
	247	& ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN
	248	WRITE(cl_check1,*) Agrif_Parent(ln_linssh )
	249	WRITE(cl_check2,*) ln_linssh
	250	CALL ctl_stop( 'Incompatible linearized fs option between grids', &
	251	& 'parent grid ln_linssh :'//cl_check1 , &
	252	& 'child grid ln_linssh :'//cl_check2 , &
	253	& 'those logicals should be identical' )
	254	STOP
	255	ENDIF
[9031]	256
[11868]	257	ENDIF
[11741]	258
[11868]	259	! check if masks and bathymetries match
	260	IF(ln_chk_bathy) THEN
[5656]	261	!
[11868]	262	IF(lwp) WRITE(numout,*) ' '
	263	IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level()
	264	!
	265	kindic_agr = 0
	266	# if ! defined key_vertical
	267	!
	268	! check if umask agree with parent along western and eastern boundaries:
	269	CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk)
	270	! check if vmask agree with parent along northern and southern boundaries:
	271	CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk)
	272	! check if tmask and vertical scale factors agree with parent over first two coarse grid points:
	273	CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t)
	274	!
	275	# else
	276	!
	277	! In case of vertical interpolation, check only that total depths agree between child and parent:
	278	DO ji = 1, jpi
	279	DO jj = 1, jpj
[12048]	280	IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
	281	IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
	282	IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
[11868]	283	END DO
	284	END DO
	285	# endif
	286	CALL mpp_sum( 'agrif_user', kindic_agr )
	287	IF( kindic_agr /= 0 ) THEN
	288	CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.')
	289	ELSE
	290	IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.'
	291	IF(lwp) WRITE(numout,*) ' '
	292	END IF
	293	!
[5656]	294	ENDIF
[11868]	295
	296	# if defined key_vertical
	297	! Additional constrain that should be removed someday:
	298	IF ( Agrif_Parent(jpk).GT.jpk ) THEN
	299	CALL ctl_stop( ' With key_vertical, child grids must have jpk greater or equal to the parent value' )
	300	ENDIF
	301	# endif
[11574]	302	!
	303	END SUBROUTINE Agrif_InitValues_cont
[9031]	304
[11574]	305	SUBROUTINE agrif_declare_var
[10068]	306	!!----------------------------------------------------------------------
[11574]	307	!! * ROUTINE agrif_declare_var *
[10068]	308	!!----------------------------------------------------------------------
[11574]	309	USE agrif_util
	310	USE agrif_oce
	311	USE par_oce
	312	USE zdf_oce
	313	USE oce
	314	!
	315	IMPLICIT NONE
	316	!
	317	INTEGER :: ind1, ind2, ind3
[10068]	318	!!----------------------------------------------------------------------
[2715]	319
[11574]	320	! 1. Declaration of the type of variable which have to be interpolated
	321	!---------------------------------------------------------------------
	322	ind1 = nbghostcells
	323	ind2 = 1 + nbghostcells
	324	ind3 = 2 + nbghostcells
[9031]	325	# if defined key_vertical
[11574]	326	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_id)
	327	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_sponge_id)
[9031]	328
[11574]	329	CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_interp_id)
	330	CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_interp_id)
	331	CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_update_id)
	332	CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_update_id)
	333	CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_sponge_id)
	334	CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_sponge_id)
[9031]	335	# else
[11574]	336	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id)
	337	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id)
[2715]	338
[11574]	339	CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_interp_id)
	340	CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_interp_id)
	341	CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_update_id)
	342	CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_update_id)
	343	CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_sponge_id)
	344	CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_sponge_id)
[9031]	345	# endif
[2715]	346
[11574]	347	CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
	348	CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
	349	CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
[11741]	350	# if defined key_vertical
	351	CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),mbkt_id)
	352	CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ht0_id)
	353	# endif
[2715]	354
[11574]	355	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id)
[5656]	356
[11574]	357	CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
	358	CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
	359	CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
	360	CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
	361	CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
	362	CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
[5656]	363
[11574]	364	CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
[5656]	365
[11574]	366	IF( ln_zdftke.OR.ln_zdfgls ) THEN
	367	! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id)
	368	! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id)
[9031]	369	# if defined key_vertical
[11574]	370	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),avm_id)
[9031]	371	# else
[11574]	372	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),avm_id)
[9031]	373	# endif
[11574]	374	ENDIF
[5656]	375
[11574]	376	! 2. Type of interpolation
	377	!-------------------------
	378	CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
[2715]	379
[11574]	380	CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
	381	CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
[2715]	382
[11574]	383	CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
[2715]	384
[11574]	385	CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
	386	CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
	387	CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
	388	CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
	389	CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
[11741]	390	!
	391	! > Divergence conserving alternative:
	392	! CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_constant)
	393	! CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_constant)
	394	! CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_constant,interp2=Agrif_linear)
	395	! CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_constant)
	396	! CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_constant,interp2=Agrif_linear)
	397	!<
[4326]	398
[11574]	399	CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
	400	CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
[5656]	401
[11574]	402	CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)
	403	CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant)
	404	CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)
[5656]	405
[11741]	406	# if defined key_vertical
	407	CALL Agrif_Set_bcinterp(mbkt_id,interp=AGRIF_constant)
	408	CALL Agrif_Set_bcinterp(ht0_id ,interp=AGRIF_constant)
	409	# endif
	410
[11574]	411	IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )
[5656]	412
[11574]	413	! 3. Location of interpolation
	414	!-----------------------------
[11868]	415	CALL Agrif_Set_bc( tsn_id, (/0,ind1-1/) ) ! if west, rhox=3 and nbghost=3: columns 2 to 4
	416	CALL Agrif_Set_bc( un_interp_id, (/0,ind1-1/) )
[11590]	417	CALL Agrif_Set_bc( vn_interp_id, (/0,ind1-1/) )
[2715]	418
[11868]	419	CALL Agrif_Set_bc( tsn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) ! if west, rhox=3, nn_sponge_len=2
	420	CALL Agrif_Set_bc( un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) ! and nbghost=3:
	421	CALL Agrif_Set_bc( vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) ! columns 4 to 11
[4326]	422
[11574]	423	CALL Agrif_Set_bc( sshn_id, (/0,ind1-1/) )
	424	CALL Agrif_Set_bc( unb_id, (/0,ind1-1/) )
	425	CALL Agrif_Set_bc( vnb_id, (/0,ind1-1/) )
	426	CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) )
	427	CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) )
[2715]	428
[11868]	429	CALL Agrif_Set_bc( e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) ) ! if west, rhox=3, nn_sponge_len=2
	430	CALL Agrif_Set_bc( umsk_id, (/0,0/) ) ! and nbghost=3:
	431	CALL Agrif_Set_bc( vmsk_id, (/0,0/) ) ! columns 2 to 10
	432	# if defined key_vertical
[11741]	433	! extend the interpolation zone by 1 more point than necessary:
[11827]	434	CALL Agrif_Set_bc( mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) )
	435	CALL Agrif_Set_bc( ht0_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) )
[11741]	436	# endif
[2715]	437
[11574]	438	IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) )
[5656]	439
[11574]	440	! 4. Update type
	441	!---------------
	442	CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
[2715]	443
[9031]	444	# if defined UPD_HIGH
[11574]	445	CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
	446	CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
	447	CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
[9031]	448
[11574]	449	CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
	450	CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
	451	CALL Agrif_Set_Updatetype(sshn_id,update = Agrif_Update_Full_Weighting)
	452	CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting)
[9031]	453
[11574]	454	IF( ln_zdftke.OR.ln_zdfgls ) THEN
	455	! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting)
	456	! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting)
	457	! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting)
	458	ENDIF
[9031]	459
	460	#else
[11574]	461	CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
	462	CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
	463	CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
[3680]	464
[11574]	465	CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
	466	CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
	467	CALL Agrif_Set_Updatetype(sshn_id,update = AGRIF_Update_Average)
	468	CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average)
[5656]	469
[11574]	470	IF( ln_zdftke.OR.ln_zdfgls ) THEN
	471	! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
	472	! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
	473	! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
	474	ENDIF
[5656]	475
[9031]	476	#endif
[11574]	477	!
	478	END SUBROUTINE agrif_declare_var
[3680]	479
[9570]	480	#if defined key_si3
[9610]	481	SUBROUTINE Agrif_InitValues_cont_ice
[10068]	482	!!----------------------------------------------------------------------
	483	!! * ROUTINE Agrif_InitValues_cont_ice *
	484	!!----------------------------------------------------------------------
[11574]	485	USE Agrif_Util
	486	USE sbc_oce, ONLY : nn_fsbc ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc
	487	USE ice
	488	USE agrif_ice
	489	USE in_out_manager
	490	USE agrif_ice_interp
	491	USE lib_mpp
	492	!
	493	IMPLICIT NONE
[10068]	494	!!----------------------------------------------------------------------
[11574]	495	!
	496	! Declaration of the type of variable which have to be interpolated (parent=>child)
	497	!----------------------------------------------------------------------------------
	498	CALL agrif_declare_var_ice
[3680]	499
[11574]	500	! Controls
[7761]	501
[11574]	502	! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom)
	503	! the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child)
	504	! therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable
	505	! If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account
	506	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]	507
[11574]	508	! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer
	509	IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 ) THEN
	510	CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')
	511	ENDIF
	512	! First Interpolations (using "after" ice subtime step => nbstep_ice=1)
	513	!----------------------------------------------------------------------
	514	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)
	515	CALL agrif_interp_ice('U') ! interpolation of ice velocities
	516	CALL agrif_interp_ice('V') ! interpolation of ice velocities
	517	CALL agrif_interp_ice('T') ! interpolation of ice tracers
	518	nbstep_ice = 0
	519	!
	520	END SUBROUTINE Agrif_InitValues_cont_ice
[7646]	521
[11574]	522	SUBROUTINE agrif_declare_var_ice
[10068]	523	!!----------------------------------------------------------------------
	524	!! * ROUTINE agrif_declare_var_ice *
	525	!!----------------------------------------------------------------------
[11574]	526	USE Agrif_Util
	527	USE ice
	528	USE par_oce, ONLY : nbghostcells
	529	!
	530	IMPLICIT NONE
	531	!
	532	INTEGER :: ind1, ind2, ind3
[10068]	533	!!----------------------------------------------------------------------
[11574]	534	!
	535	! 1. Declaration of the type of variable which have to be interpolated (parent=>child)
	536	! agrif_declare_variable(position,1st point index,--,--,dimensions,name)
	537	! ex.: position=> 1,1 = not-centered (in i and j)
	538	! 2,2 = centered ( - )
	539	! index => 1,1 = one ghost line
	540	! 2,2 = two ghost lines
	541	!-------------------------------------------------------------------------------------
	542	ind1 = nbghostcells
	543	ind2 = 1 + nbghostcells
	544	ind3 = 2 + nbghostcells
	545	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_ice_id)
	546	CALL agrif_declare_variable((/1,2/) ,(/ind2,ind3/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,u_ice_id )
	547	CALL agrif_declare_variable((/2,1/) ,(/ind3,ind2/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,v_ice_id )
[7646]	548
[11574]	549	! 2. Set interpolations (normal & tangent to the grid cell for velocities)
	550	!-----------------------------------
	551	CALL Agrif_Set_bcinterp(tra_ice_id, interp = AGRIF_linear)
	552	CALL Agrif_Set_bcinterp(u_ice_id , interp1 = Agrif_linear,interp2 = AGRIF_ppm )
	553	CALL Agrif_Set_bcinterp(v_ice_id , interp1 = AGRIF_ppm ,interp2 = Agrif_linear)
[7646]	554
[11574]	555	! 3. Set location of interpolations
	556	!----------------------------------
	557	CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/))
	558	CALL Agrif_Set_bc(u_ice_id ,(/0,ind1/))
	559	CALL Agrif_Set_bc(v_ice_id ,(/0,ind1/))
[7646]	560
[11574]	561	! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
	562	!--------------------------------------------------
[9134]	563	# if defined UPD_HIGH
[11574]	564	CALL Agrif_Set_Updatetype(tra_ice_id, update = Agrif_Update_Full_Weighting)
	565	CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)
	566	CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )
[9134]	567	#else
[11574]	568	CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average)
	569	CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)
	570	CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )
[9134]	571	#endif
[7646]	572
[11574]	573	END SUBROUTINE agrif_declare_var_ice
[7646]	574	#endif
	575
	576
[2715]	577	# if defined key_top
[11574]	578	SUBROUTINE Agrif_InitValues_cont_top
[10068]	579	!!----------------------------------------------------------------------
	580	!! * ROUTINE Agrif_InitValues_cont_top *
[11574]	581	!!----------------------------------------------------------------------
	582	USE Agrif_Util
	583	USE oce
	584	USE dom_oce
	585	USE nemogcm
	586	USE par_trc
	587	USE lib_mpp
	588	USE trc
	589	USE in_out_manager
	590	USE agrif_oce_sponge
	591	USE agrif_top_update
	592	USE agrif_top_interp
	593	USE agrif_top_sponge
[10068]	594	!!
[11574]	595	IMPLICIT NONE
	596	!
	597	CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
	598	LOGICAL :: check_namelist
[10068]	599	!!----------------------------------------------------------------------
[1300]	600
[11574]	601	! 1. Declaration of the type of variable which have to be interpolated
	602	!---------------------------------------------------------------------
	603	CALL agrif_declare_var_top
[1300]	604
[11574]	605	! 2. First interpolations of potentially non zero fields
	606	!-------------------------------------------------------
	607	Agrif_SpecialValue=0._wp
	608	Agrif_UseSpecialValue = .TRUE.
	609	CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
	610	Agrif_UseSpecialValue = .FALSE.
	611	CALL Agrif_Sponge
	612	tabspongedone_trn = .FALSE.
	613	CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
	614	! reset tsa to zero
	615	tra(:,:,:,:) = 0._wp
[3680]	616
[11574]	617	! 3. Some controls
	618	!-----------------
	619	check_namelist = .TRUE.
[3680]	620
[11574]	621	IF( check_namelist ) THEN
	622	! Check time steps
[5656]	623	IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
	624	WRITE(cl_check1,*) Agrif_Parent(rdt)
	625	WRITE(cl_check2,*) rdt
	626	WRITE(cl_check3,) rdtAgrif_Rhot()
[7646]	627	CALL ctl_stop( 'incompatible time step between grids', &
[5656]	628	& 'parent grid value : '//cl_check1 , &
	629	& 'child grid value : '//cl_check2 , &
[7646]	630	& 'value on child grid should be changed to &
[5656]	631	& :'//cl_check3 )
[3680]	632	ENDIF
	633
	634	! Check run length
	635	IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
[5656]	636	Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
	637	WRITE(cl_check1,) (Agrif_Parent(nit000)-1)Agrif_IRhot() + 1
	638	WRITE(cl_check2,) Agrif_Parent(nitend) Agrif_IRhot()
	639	CALL ctl_warn( 'incompatible run length between grids' , &
	640	& ' nit000 on fine grid will be change to : '//cl_check1, &
	641	& ' nitend on fine grid will be change to : '//cl_check2 )
	642	nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
	643	nitend = Agrif_Parent(nitend) *Agrif_IRhot()
[3680]	644	ENDIF
	645
	646	! Check passive tracer cell
[5656]	647	IF( nn_dttrc .NE. 1 ) THEN
[3680]	648	WRITE(,) 'nn_dttrc should be equal to 1'
[1300]	649	ENDIF
[3680]	650	ENDIF
[5656]	651	!
[11574]	652	END SUBROUTINE Agrif_InitValues_cont_top
[2715]	653
	654
[11574]	655	SUBROUTINE agrif_declare_var_top
[10068]	656	!!----------------------------------------------------------------------
	657	!! * ROUTINE agrif_declare_var_top *
[11574]	658	!!----------------------------------------------------------------------
	659	USE agrif_util
	660	USE agrif_oce
	661	USE dom_oce
	662	USE trc
[10068]	663	!!
[11574]	664	IMPLICIT NONE
	665	!
	666	INTEGER :: ind1, ind2, ind3
[10068]	667	!!----------------------------------------------------------------------
[2715]	668
[11574]	669	! 1. Declaration of the type of variable which have to be interpolated
	670	!---------------------------------------------------------------------
	671	ind1 = nbghostcells
	672	ind2 = 1 + nbghostcells
	673	ind3 = 2 + nbghostcells
[9031]	674	# if defined key_vertical
[11574]	675	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_id)
	676	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_sponge_id)
[9031]	677	# else
[11574]	678	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id)
	679	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id)
[9031]	680	# endif
[2715]	681
[11574]	682	! 2. Type of interpolation
	683	!-------------------------
	684	CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
	685	CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
[3680]	686
[11574]	687	! 3. Location of interpolation
	688	!-----------------------------
[11590]	689	CALL Agrif_Set_bc(trn_id,(/0,ind1-1/))
[11574]	690	CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
[3680]	691
[11574]	692	! 4. Update type
	693	!---------------
[9031]	694	# if defined UPD_HIGH
[11574]	695	CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting)
[9031]	696	#else
[11574]	697	CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
[9031]	698	#endif
[5656]	699	!
[11574]	700	END SUBROUTINE agrif_declare_var_top
[2715]	701	# endif
[636]	702
[11574]	703	SUBROUTINE Agrif_detect( kg, ksizex )
[10068]	704	!!----------------------------------------------------------------------
	705	!! * ROUTINE Agrif_detect *
	706	!!----------------------------------------------------------------------
[11574]	707	INTEGER, DIMENSION(2) :: ksizex
	708	INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg
[10068]	709	!!----------------------------------------------------------------------
[11574]	710	!
	711	RETURN
	712	!
	713	END SUBROUTINE Agrif_detect
[390]	714
[11574]	715	SUBROUTINE agrif_nemo_init
[10068]	716	!!----------------------------------------------------------------------
	717	!! * ROUTINE agrif_init *
	718	!!----------------------------------------------------------------------
[11574]	719	USE agrif_oce
	720	USE agrif_ice
	721	USE in_out_manager
	722	USE lib_mpp
	723	!!
	724	IMPLICIT NONE
	725	!
	726	INTEGER :: ios ! Local integer output status for namelist read
[11769]	727	NAMELIST/namagrif/ ln_agrif_2way, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, &
	728	& ln_spc_dyn, ln_chk_bathy
[10068]	729	!!--------------------------------------------------------------------------------------
[11574]	730	!
	731	REWIND( numnam_ref ) ! Namelist namagrif in reference namelist : AGRIF zoom
	732	READ ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
[11573]	733	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist' )
[11574]	734	REWIND( numnam_cfg ) ! Namelist namagrif in configuration namelist : AGRIF zoom
	735	READ ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
[11573]	736	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist' )
[11574]	737	IF(lwm) WRITE ( numond, namagrif )
	738	!
	739	IF(lwp) THEN ! control print
	740	WRITE(numout,*)
	741	WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
	742	WRITE(numout,*) '~~~~~~~~~~~~~~~'
	743	WRITE(numout,*) ' Namelist namagrif : set AGRIF parameters'
	744	WRITE(numout,*) ' Two way nesting activated ln_agrif_2way = ', ln_agrif_2way
	745	WRITE(numout,*) ' sponge coefficient for tracers rn_sponge_tra = ', rn_sponge_tra, ' m^2/s'
	746	WRITE(numout,*) ' sponge coefficient for dynamics rn_sponge_tra = ', rn_sponge_dyn, ' m^2/s'
[11769]	747	WRITE(numout,*) ' time relaxation for tracers rn_trelax_tra = ', rn_trelax_tra, ' ad.'
	748	WRITE(numout,*) ' time relaxation for dynamics rn_trelax_dyn = ', rn_trelax_dyn, ' ad.'
[11574]	749	WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn
	750	WRITE(numout,*) ' check bathymetry ln_chk_bathy = ', ln_chk_bathy
	751	ENDIF
	752	!
	753	!
	754	IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
	755	!
	756	END SUBROUTINE agrif_nemo_init
[3680]	757
[1605]	758	# if defined key_mpp_mpi
	759
[11574]	760	SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
[10068]	761	!!----------------------------------------------------------------------
	762	!! * ROUTINE Agrif_InvLoc *
	763	!!----------------------------------------------------------------------
[11574]	764	USE dom_oce
	765	!!
	766	IMPLICIT NONE
	767	!
	768	INTEGER :: indglob, indloc, nprocloc, i
[10068]	769	!!----------------------------------------------------------------------
[11574]	770	!
	771	SELECT CASE( i )
	772	CASE(1) ; indglob = indloc + nimppt(nprocloc+1) - 1
	773	CASE(2) ; indglob = indloc + njmppt(nprocloc+1) - 1
	774	CASE DEFAULT
	775	indglob = indloc
	776	END SELECT
	777	!
	778	END SUBROUTINE Agrif_InvLoc
[390]	779
[11574]	780	SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
[10068]	781	!!----------------------------------------------------------------------
	782	!! * ROUTINE Agrif_get_proc_info *
	783	!!----------------------------------------------------------------------
[11574]	784	USE par_oce
	785	!!
	786	IMPLICIT NONE
	787	!
	788	INTEGER, INTENT(out) :: imin, imax
	789	INTEGER, INTENT(out) :: jmin, jmax
[10068]	790	!!----------------------------------------------------------------------
[11574]	791	!
	792	imin = nimppt(Agrif_Procrank+1) ! ?????
	793	jmin = njmppt(Agrif_Procrank+1) ! ?????
	794	imax = imin + jpi - 1
	795	jmax = jmin + jpj - 1
	796	!
	797	END SUBROUTINE Agrif_get_proc_info
[5656]	798
[11574]	799	SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
[10068]	800	!!----------------------------------------------------------------------
	801	!! * ROUTINE Agrif_estimate_parallel_cost *
	802	!!----------------------------------------------------------------------
[11574]	803	USE par_oce
	804	!!
	805	IMPLICIT NONE
	806	!
	807	INTEGER, INTENT(in) :: imin, imax
	808	INTEGER, INTENT(in) :: jmin, jmax
	809	INTEGER, INTENT(in) :: nbprocs
	810	REAL(wp), INTENT(out) :: grid_cost
[10068]	811	!!----------------------------------------------------------------------
[11574]	812	!
	813	grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
	814	!
	815	END SUBROUTINE Agrif_estimate_parallel_cost
[5656]	816
[1605]	817	# endif
	818
[390]	819	#else
[11574]	820	SUBROUTINE Subcalledbyagrif
[10068]	821	!!----------------------------------------------------------------------
	822	!! * ROUTINE Subcalledbyagrif *
	823	!!----------------------------------------------------------------------
[11574]	824	WRITE(,) 'Impossible to be here'
	825	END SUBROUTINE Subcalledbyagrif
[390]	826	#endif

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

Download in other formats: