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 @ 11769

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

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

Download in other formats: