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

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

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

Download in other formats: