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.

modinterp.F in trunk/AGRIF/AGRIF_FILES – NEMO

Context Navigation

source: trunk/AGRIF/AGRIF_FILES/modinterp.F @ 1200

Last change on this file since 1200 was 1200, checked in by rblod, 16 years ago
Adapt Agrif to the new SBC and correct several bugs for agrif (restart writing and reading), see ticket #133 Note : this fix does not work yet on NEC computerq (sxf90/360)
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 80.6 KB

Rev	Line
[396]	1	!
	2	! $Id$
	3	!
	4	C AGRIF (Adaptive Grid Refinement In Fortran)
	5	C
	6	C Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
	7	C Christophe Vouland (Christophe.Vouland@imag.fr)
	8	C
	9	C This program is free software; you can redistribute it and/or modify
	10	C it under the terms of the GNU General Public License as published by
	11	C the Free Software Foundation; either version 2 of the License, or
	12	C (at your option) any later version.
	13	C
	14	C This program is distributed in the hope that it will be useful,
	15	C but WITHOUT ANY WARRANTY; without even the implied warranty of
	16	C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	17	C GNU General Public License for more details.
	18	C
	19	C You should have received a copy of the GNU General Public License
	20	C along with this program; if not, write to the Free Software
	21	C Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
	22	C
	23	C
	24	C
	25	CCC Module Agrif_Interpolation
	26	C
	27	Module Agrif_Interpolation
	28	C
	29	CCC Description:
	30	CCC Module to initialize a fine grid from its parent grid, by using a space
	31	CCC interpolation
	32	C
	33	C Modules used:
	34	C
	35	Use Agrif_Interpbasic
	36	Use Agrif_Arrays
	37	Use Agrif_Mask
	38	Use Agrif_CurgridFunctions
	39	#if defined AGRIF_MPI
	40	Use Agrif_mpp
	41	#endif
	42	C
	43	IMPLICIT NONE
[779]	44	logical, private:: precomputedone(7) = .FALSE.
[396]	45	C
	46	CONTAINS
	47	C Define procedures contained in this module
	48	C
	49	C
	50	C
	51	C **************************************************************************
	52	CCC Subroutine Agrif_Interp_1d
	53	C **************************************************************************
	54	C
	55	Subroutine Agrif_Interp_1d(TypeInterp,parent,child,tab,
[1200]	56	& torestore,nbdim,procname)
[396]	57	C
	58	CCC Description:
	59	CCC Subroutine to calculate the boundary conditions of a fine grid for a 1D
	60	C grid variable.
	61	C
	62	C Declarations:
	63	C
	64
	65	C
	66	C Arguments
	67	INTEGER :: nbdim
	68	INTEGER,DIMENSION(6) :: TypeInterp ! Kind of interpolation
	69	! (linear,lagrange,spline)
	70	TYPE(AGRIF_PVariable) :: parent ! Variable on the parent grid
	71	TYPE(AGRIF_PVariable) :: child ! Variable on the child grid
	72	TYPE(AGRIF_PVariable) :: childtemp ! Temporary variable on the child
	73	! grid
	74	LOGICAL :: torestore
	75	REAL, DIMENSION(
[1200]	76	& child%var%lb(1):child%var%ub(1)
[396]	77	& ), Target :: tab ! Result
[1200]	78	External :: procname
	79	Optional :: procname
[396]	80	C
	81	C
	82	allocate(childtemp % var)
	83	C
	84	C Pointer on the root variable
	85	childtemp % var % root_var => child % var %root_var
	86	C
	87	C Number of dimensions of the grid variable
	88	childtemp % var % nbdim = nbdim
	89	C
	90	C Tab is the result of the interpolation
	91	childtemp % var % array1 => tab
[1200]	92
	93	childtemp % var % lb = child % var % lb
	94	childtemp % var % ub = child % var % ub
	95
[396]	96	C
	97	if (torestore) then
	98	C
	99	childtemp % var % array1 = child % var % array1
	100	C
	101	childtemp % var % restore1D => child % var % restore1D
	102	C
	103	else
	104	C
	105	Nullify(childtemp % var % restore1D)
	106	C
	107	endif
	108	C
	109	C Index indicating (in the Agrif_Interp1D procedure) if a space
	110	C interpolation is necessary
	111	childtemp % var % interpIndex => child % var % interpIndex
	112	childtemp % var % Interpolationshouldbemade =
[662]	113	& child % var % Interpolationshouldbemade
	114	childtemp % var % list_interp => child % var% list_interp
[396]	115	C
[1200]	116	if (present(procname)) then
[396]	117	Call Agrif_InterpVariable
[1200]	118	& (TypeInterp,parent,childtemp,torestore,procname)
	119	else
	120	Call Agrif_InterpVariable
[396]	121	& (TypeInterp,parent,childtemp,torestore)
[1200]	122	endif
[662]	123	child % var % list_interp => childtemp % var %list_interp
[396]	124	C
	125	deallocate(childtemp % var)
	126	C
	127	C
	128	End Subroutine Agrif_Interp_1D
	129	C
	130	C
	131	C
	132	C **************************************************************************
	133	CCC Subroutine Agrif_Interp_2d
	134	C **************************************************************************
	135	C
	136	Subroutine Agrif_Interp_2d(TypeInterp,parent,child,tab,
[1200]	137	& torestore,nbdim,procname)
[396]	138	C
	139	CCC Description:
	140	CCC Subroutine to calculate the boundary conditions of a fine grid for a 2D
	141	C grid variable.
	142	C
	143	C Declarations:
	144	C
	145
	146	C
	147	C Arguments
	148	INTEGER :: nbdim
	149	INTEGER,DIMENSION(6) :: TypeInterp ! Kind of interpolation
	150	! (linear,lagrange,spline)
	151	TYPE(AGRIF_PVariable) :: parent ! Variable on the parent grid
	152	TYPE(AGRIF_PVariable) :: child ! Variable on the child grid
	153	TYPE(AGRIF_PVariable) :: childtemp ! Temporary variable on the child
	154	! grid
	155	LOGICAL :: torestore
	156	REAL, DIMENSION(
[1200]	157	& child%var%lb(1):child%var%ub(1),
	158	& child%var%lb(2):child%var%ub(2)
[396]	159	& ), Target :: tab ! Result
[1200]	160	External :: procname
	161	Optional :: procname
[396]	162	C
	163	C
	164	allocate(childtemp % var)
	165	C
	166	C Pointer on the root variable
	167	childtemp % var % root_var => child % var %root_var
	168	C
	169	C Number of dimensions of the grid variable
	170	childtemp % var % nbdim = nbdim
	171	C
	172	C Tab is the result of the interpolation
	173	childtemp % var % array2 => tab
[1200]	174
	175	childtemp % var % lb = child % var % lb
	176	childtemp % var % ub = child % var % ub
	177
	178	C
[396]	179	if (torestore) then
	180	C
[1200]	181	childtemp % var % array2 = child % var % array2
[396]	182	C
	183	childtemp % var % restore2D => child % var % restore2D
	184	C
	185	else
	186	C
	187	Nullify(childtemp % var % restore2D)
	188	C
	189	endif
	190	C
	191	C Index indicating (in the Agrif_Interp2D procedure) if a space
	192	C interpolation is necessary
	193	childtemp % var % interpIndex => child % var % interpIndex
	194	childtemp % var % Interpolationshouldbemade =
[662]	195	& child % var % Interpolationshouldbemade
	196	childtemp % var % list_interp => child % var% list_interp
[396]	197	C
[1200]	198	if (present(procname)) then
[396]	199	Call Agrif_InterpVariable
[1200]	200	& (TypeInterp,parent,childtemp,torestore,procname)
	201	else
	202	Call Agrif_InterpVariable
[396]	203	& (TypeInterp,parent,childtemp,torestore)
[1200]	204	endif
	205
[662]	206	child % var % list_interp => childtemp % var %list_interp
[396]	207	C
	208	deallocate(childtemp % var)
	209	C
	210	C
	211	End Subroutine Agrif_Interp_2D
	212	C
	213	C
	214	C
	215	C **************************************************************************
	216	CCC Subroutine Agrif_Interp_3d
	217	C **************************************************************************
	218	C
	219	Subroutine Agrif_Interp_3d(TypeInterp,parent,child,tab,
[1200]	220	& torestore,nbdim,procname)
[396]	221	C
	222	CCC Description:
	223	CCC Subroutine to calculate the boundary conditions of a fine grid for a 3D
	224	C grid variable.
	225	C
	226	C Declarations:
	227	C
	228
	229	C
	230	C Arguments
	231	INTEGER :: nbdim
	232	INTEGER,DIMENSION(6) :: TypeInterp ! Kind of interpolation
	233	! (linear,lagrange,spline)
	234	TYPE(AGRIF_PVariable) :: parent ! Variable on the parent grid
	235	TYPE(AGRIF_PVariable) :: child ! Variable on the child grid
	236	TYPE(AGRIF_PVariable) :: childtemp ! Temporary variable on the child
	237	! grid
	238	LOGICAL :: torestore
	239	REAL, DIMENSION(
[1200]	240	& child%var%lb(1):child%var%ub(1),
	241	& child%var%lb(2):child%var%ub(2),
	242	& child%var%lb(3):child%var%ub(3)
[396]	243	& ), Target :: tab ! Results
[1200]	244	External :: procname
	245	Optional :: procname
[396]	246	C
	247	C
	248	allocate(childtemp % var)
	249	C
	250	C Pointer on the root variable
	251	childtemp % var % root_var => child % var %root_var
	252	C
	253	C Number of dimensions of the grid variable
	254	childtemp % var % nbdim = nbdim
	255	C
	256	C Tab is the result of the interpolation
	257	childtemp % var % array3 => tab
[1200]	258
	259	childtemp % var % lb = child % var % lb
	260	childtemp % var % ub = child % var % ub
[396]	261	C
	262	if (torestore) then
	263	C
	264	childtemp % var % array3 = child % var % array3
	265	C
	266	childtemp % var % restore3D => child % var % restore3D
	267	C
	268	else
	269	C
	270	Nullify(childtemp % var % restore3D)
	271	C
	272	endif
	273	C
	274	C Index indicating (in the Agrif_Interp3D procedure) if a space
	275	C interpolation is necessary
	276	childtemp % var % interpIndex => child % var % interpIndex
	277	childtemp % var % Interpolationshouldbemade =
[662]	278	& child % var % Interpolationshouldbemade
	279	childtemp % var % list_interp => child % var% list_interp
[396]	280	C
[1200]	281
	282	if (present(procname)) then
[396]	283	Call Agrif_InterpVariable
[1200]	284	& (TypeInterp,parent,childtemp,torestore,procname)
	285	else
	286	Call Agrif_InterpVariable
[396]	287	& (TypeInterp,parent,childtemp,torestore)
[1200]	288	endif
	289
	290
[662]	291	child % var % list_interp => childtemp % var %list_interp
[396]	292	C
	293	deallocate(childtemp % var)
	294	C
	295	C
	296	End Subroutine Agrif_Interp_3D
	297	C
	298	C
	299	C
	300	C **************************************************************************
	301	CCC Subroutine Agrif_Interp_4d
	302	C **************************************************************************
	303	C
	304	Subroutine Agrif_Interp_4d(TypeInterp,parent,child,tab,
[1200]	305	& torestore,nbdim,procname)
[396]	306	C
	307	CCC Description:
	308	CCC Subroutine to calculate the boundary conditions of a fine grid for a 4D
	309	C grid variable.
	310	C
	311	C Declarations:
	312	C
	313
	314	C
	315	C Arguments
	316	INTEGER :: nbdim
	317	INTEGER,DIMENSION(6) :: TypeInterp ! Kind of interpolation
	318	! (linear,lagrange,spline)
	319	TYPE(AGRIF_PVariable) :: parent ! Variable on the parent grid
	320	TYPE(AGRIF_PVariable) :: child ! Variable on the child grid
	321	TYPE(AGRIF_PVariable) :: childtemp ! Temporary variable on the child
	322	! grid
	323	LOGICAL :: torestore
	324	REAL, DIMENSION(
[1200]	325	& child%var%lb(1):child%var%ub(1),
	326	& child%var%lb(2):child%var%ub(2),
	327	& child%var%lb(3):child%var%ub(3),
	328	& child%var%lb(4):child%var%ub(4)
[396]	329	& ), Target :: tab ! Results
[1200]	330	External :: procname
	331	Optional :: procname
[396]	332	C
	333	C
	334	allocate(childtemp % var)
	335	C
	336	C Pointer on the root variable
	337	childtemp % var % root_var => child % var %root_var
	338	C
	339	C Number of dimensions of the grid variable
	340	childtemp % var % nbdim = nbdim
	341	C
	342	C Tab is the result of the interpolation
	343	childtemp % var % array4 => tab
[1200]	344
	345	childtemp % var % lb = child % var % lb
	346	childtemp % var % ub = child % var % ub
	347
[396]	348	C
	349	if (torestore) then
	350	C
	351	childtemp % var % array4 = child % var % array4
	352	C
	353	childtemp % var % restore4D => child % var % restore4D
	354	C
	355	else
	356	C
	357	Nullify(childtemp % var % restore4D)
	358	C
	359	endif
	360	C
	361	C Index indicating (in the Agrif_Interp4D procedure) if a space
	362	C interpolation is necessary
	363	childtemp % var % interpIndex => child % var % interpIndex
	364	childtemp % var % Interpolationshouldbemade =
[662]	365	& child % var % Interpolationshouldbemade
	366	childtemp % var % list_interp => child % var% list_interp
[396]	367	C
[1200]	368	if (present(procname)) then
[396]	369	Call Agrif_InterpVariable
[1200]	370	& (TypeInterp,parent,childtemp,torestore,procname)
	371	else
	372	Call Agrif_InterpVariable
[396]	373	& (TypeInterp,parent,childtemp,torestore)
[1200]	374	endif
	375
	376
[662]	377	child % var % list_interp => childtemp % var %list_interp
[396]	378	C
	379	deallocate(childtemp % var)
	380	C
	381	C
	382	End Subroutine Agrif_Interp_4D
	383	C
	384	C
	385	C
	386	C **************************************************************************
	387	CCC Subroutine Agrif_Interp_5d
	388	C **************************************************************************
	389	C
	390	Subroutine Agrif_Interp_5d(TypeInterp,parent,child,tab,
[1200]	391	& torestore,nbdim,procname)
[396]	392	C
	393	CCC Description:
	394	CCC Subroutine to calculate the boundary conditions of a fine grid for a 5D
	395	C grid variable.
	396	C
	397	C Declarations:
	398	C
	399
	400	C
	401	C Arguments
	402	INTEGER :: nbdim
	403	INTEGER,DIMENSION(6) :: TypeInterp ! Kind of interpolation
	404	! (linear,lagrange,spline)
	405	TYPE(AGRIF_PVariable) :: parent ! Variable on the parent grid
	406	TYPE(AGRIF_PVariable) :: child ! Variable on the child grid
	407	TYPE(AGRIF_PVariable) :: childtemp ! Temporary variable on the child
	408	! grid
	409	LOGICAL :: torestore
	410	REAL, DIMENSION(
[1200]	411	& child%var%lb(1):child%var%ub(1),
	412	& child%var%lb(2):child%var%ub(2),
	413	& child%var%lb(3):child%var%ub(3),
	414	& child%var%lb(4):child%var%ub(4),
	415	& child%var%lb(5):child%var%ub(5)
[396]	416	& ), Target :: tab ! Results
[1200]	417	External :: procname
	418	Optional :: procname
[396]	419	C
	420	C
	421	allocate(childtemp % var)
	422	C
	423	C Pointer on the root variable
	424	childtemp % var % root_var => child % var %root_var
	425	C
	426	C Number of dimensions of the grid variable
	427	childtemp % var % nbdim = nbdim
	428	C
	429	C Tab is the result of the interpolation
	430	childtemp % var % array5 => tab
[1200]	431
	432	childtemp % var % lb = child % var % lb
	433	childtemp % var % ub = child % var % ub
	434
[396]	435	C
	436	if (torestore) then
	437	C
	438	childtemp % var % array5 = child % var % array5
	439	C
	440	childtemp % var % restore5D => child % var % restore5D
	441	C
	442	else
	443	C
	444	Nullify(childtemp % var % restore5D)
	445	C
	446	endif
	447	C
	448	C Index indicating (in the Agrif_Interp5D procedure) if a space
	449	C interpolation is necessary
	450	childtemp % var % interpIndex => child % var % interpIndex
	451	childtemp % var % Interpolationshouldbemade =
[662]	452	& child % var % Interpolationshouldbemade
	453	childtemp % var % list_interp => child % var% list_interp
[396]	454	C
[1200]	455	if (present(procname)) then
[396]	456	Call Agrif_InterpVariable
[1200]	457	& (TypeInterp,parent,childtemp,torestore,procname)
	458	else
	459	Call Agrif_InterpVariable
[396]	460	& (TypeInterp,parent,childtemp,torestore)
[1200]	461	endif
	462
[662]	463
	464	child % var % list_interp => childtemp % var %list_interp
[396]	465	C
	466	deallocate(childtemp % var)
	467	C
	468	C
	469	End Subroutine Agrif_Interp_5D
	470	C
	471	C
	472	C
	473	C **************************************************************************
	474	CCC Subroutine Agrif_Interp_6d
	475	C **************************************************************************
	476	C
	477	Subroutine Agrif_Interp_6d(TypeInterp,parent,child,tab,
[1200]	478	& torestore,nbdim,procname)
[396]	479	C
	480	CCC Description:
	481	CCC Subroutine to calculate the boundary conditions of a fine grid for a 6D
	482	C grid variable.
	483	C
	484	C Declarations:
	485	C
	486
	487	C
	488	C Arguments
	489	INTEGER :: nbdim
	490	INTEGER,DIMENSION(6) :: TypeInterp ! Kind of interpolation
	491	! (linear,lagrange,spline)
	492	TYPE(AGRIF_PVariable) :: parent ! Variable on the parent grid
	493	TYPE(AGRIF_PVariable) :: child ! Variable on the child grid
	494	TYPE(AGRIF_PVariable) :: childtemp ! Temporary variable on the child
	495	! grid
	496	LOGICAL :: torestore
	497	REAL, DIMENSION(
[1200]	498	& child%var%lb(1):child%var%ub(1),
	499	& child%var%lb(2):child%var%ub(2),
	500	& child%var%lb(3):child%var%ub(3),
	501	& child%var%lb(4):child%var%ub(4),
	502	& child%var%lb(5):child%var%ub(5),
	503	& child%var%lb(6):child%var%ub(6)
[396]	504	& ), Target :: tab ! Results
[1200]	505	External :: procname
	506	Optional :: procname
[396]	507	C
	508	C
	509	allocate(childtemp % var)
	510	C
	511	C Pointer on the root variable
	512	childtemp % var % root_var => child % var %root_var
	513	C
	514	C Number of dimensions of the grid variable
	515	childtemp % var % nbdim = nbdim
	516	C
	517	C Tab is the result of the interpolation
	518	childtemp % var % array6 => tab
[1200]	519
	520	childtemp % var % lb = child % var % lb
	521	childtemp % var % ub = child % var % ub
	522
[396]	523	C
	524	if (torestore) then
	525	C
	526	childtemp % var % array6 = child % var % array6
	527	C
	528	childtemp % var % restore6D => child % var % restore6D
	529	C
	530	else
	531	C
	532	Nullify(childtemp % var % restore6D)
	533	C
	534	endif
	535	C
	536	C Index indicating (in the Agrif_Interp6D procedure) if a space
	537	C interpolation is necessary
	538	childtemp % var % interpIndex => child % var % interpIndex
	539	childtemp % var % Interpolationshouldbemade =
[662]	540	& child % var % Interpolationshouldbemade
	541
	542	childtemp % var % list_interp => child % var% list_interp
[396]	543	C
[1200]	544
	545	if (present(procname)) then
[396]	546	Call Agrif_InterpVariable
[1200]	547	& (TypeInterp,parent,childtemp,torestore,procname)
	548	else
	549	Call Agrif_InterpVariable
[396]	550	& (TypeInterp,parent,childtemp,torestore)
[1200]	551	endif
	552
	553
[396]	554	C
[662]	555	child % var % list_interp => childtemp % var %list_interp
[396]	556	deallocate(childtemp % var)
	557	C
	558	C
	559	End Subroutine Agrif_Interp_6D
	560	C
	561	C
	562	C
	563	C **************************************************************************
	564	C Subroutine Agrif_InterpVariable
	565	C **************************************************************************
	566	C
[1200]	567	Subroutine Agrif_InterpVariable(TYPEinterp,parent,child,torestore,
	568	& procname)
[396]	569	C
	570	CCC Description:
	571	CCC Subroutine to set some arguments of subroutine Agrif_InterpnD, n being the
	572	CCC DIMENSION of the grid variable.
	573	C
	574	CC Declarations:
	575	C
	576	c
	577	C
	578	C
	579	C Scalar argument
	580	INTEGER,DIMENSION(6) :: TYPEinterp! TYPE of interpolation
	581	! (linear,spline,...)
	582	C Data TYPE arguments
	583	TYPE(AGRIF_PVariable) :: parent ! Variable on the parent grid
	584	TYPE(AGRIF_PVariable) :: child ! Variable on the child grid
	585	C
	586	C LOGICAL argument
	587	LOGICAL:: torestore ! Its value is .false., it indicates the
	588	! results of the interpolation are
	589	! applied on the whole current grid
	590	C
	591	C Local scalars
	592	INTEGER :: nbdim ! Number of dimensions of the
	593	! current grid
	594	INTEGER ,DIMENSION(6) :: pttab_child
	595	INTEGER ,DIMENSION(6) :: petab_child
	596	INTEGER ,DIMENSION(6) :: pttab_parent
	597	REAL ,DIMENSION(6) :: s_child,s_parent
	598	REAL ,DIMENSION(6) :: ds_child,ds_parent
[1200]	599	External :: procname
	600	Optional :: procname
	601
[396]	602	C
	603	Call PreProcessToInterpOrUpdate(parent,child,
	604	& petab_Child(1:nbdim),
	605	& pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
	606	& s_Child(1:nbdim),s_Parent(1:nbdim),
	607	& ds_Child(1:nbdim),ds_Parent(1:nbdim),
	608	& nbdim)
	609	C
	610	C
	611	C Call to a procedure of interpolation against the number of dimensions of
	612	C the grid variable
	613	C
[1200]	614
	615	if (present(procname)) then
[396]	616	call Agrif_InterpnD
	617	& (TYPEinterp,parent,child,
	618	& pttab_Child(1:nbdim),petab_Child(1:nbdim),
	619	& pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
	620	& s_Child(1:nbdim),s_Parent(1:nbdim),
	621	& ds_Child(1:nbdim),ds_Parent(1:nbdim),
[1200]	622	& child,torestore,nbdim,procname)
	623	else
	624	call Agrif_InterpnD
	625	& (TYPEinterp,parent,child,
	626	& pttab_Child(1:nbdim),petab_Child(1:nbdim),
	627	& pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
	628	& s_Child(1:nbdim),s_Parent(1:nbdim),
	629	& ds_Child(1:nbdim),ds_Parent(1:nbdim),
[396]	630	& child,torestore,nbdim)
[1200]	631
	632	endif
[396]	633	C
	634	Return
	635	C
	636	C
	637	End subroutine Agrif_InterpVariable
	638	C
	639	C
	640	C **************************************************************************
	641	C Subroutine Agrif_InterpnD
	642	C **************************************************************************
	643	C
	644	Subroutine Agrif_InterpnD(TYPEinterp,parent,child,
	645	& pttab,petab,
	646	& pttab_Child,pttab_Parent,
	647	& s_Child,s_Parent,ds_Child,ds_Parent,
	648	& restore,torestore,nbdim,procname)
	649	C
	650	C Description:
	651	C Subroutine to interpolate a nD grid variable from its parent grid,
	652	C by using a space interpolation.
	653	C
	654	C Declarations:
	655	C
	656
	657	C
	658	#ifdef AGRIF_MPI
	659	C
	660	#include "mpif.h"
	661	C
	662	#endif
	663	C
	664	C Arguments
	665	External :: procname
	666	Optional :: procname
	667	INTEGER :: nbdim
	668	INTEGER,DIMENSION(6) :: TYPEinterp ! TYPE of interpolation
	669	! (linear,...)
	670	TYPE(AGRIF_PVARIABLE) :: parent ! Variable of the parent
	671	! grid
	672	TYPE(AGRIF_PVARIABLE) :: child ! Variable of the child
	673	! grid
	674	INTEGER,DIMENSION(nbdim) :: pttab ! Index of the first
	675	! point inside the
	676	! domain
	677	INTEGER,DIMENSION(nbdim) :: petab ! Index of the first
	678	! point inside the
	679	! domain
	680	INTEGER,DIMENSION(nbdim) :: pttab_Child ! Index of the first
	681	! point inside the
	682	! domain for the child
	683	! grid variable
	684	INTEGER,DIMENSION(nbdim) :: pttab_Parent ! Index of the first
	685	! point inside the
	686	! domain for the
	687	! parent grid variable
	688	TYPE(AGRIF_PVARIABLE) :: restore ! Indicates points where
	689	! interpolation
	690	REAL,DIMENSION(nbdim) :: s_Child,s_Parent ! Positions of the parent
	691	! and child grids
	692	REAL,DIMENSION(nbdim) :: ds_Child,ds_Parent ! Space steps of the
	693	! parent and child
	694	! grids
	695	LOGICAL :: torestore ! Indicates if the array
	696	! restore is used
	697	C
	698	C Local pointers
[662]	699	TYPE(AGRIF_PVARIABLE),SAVE :: tempP,tempPextend ! Temporary parent grid variable
	700	TYPE(AGRIF_PVARIABLE),SAVE :: tempC ! Temporary child grid variable
[396]	701	C
	702	C Local scalars
	703	INTEGER :: i,j,k,l,m,n
	704	INTEGER,DIMENSION(nbdim) :: pttruetab,cetruetab
	705	INTEGER,DIMENSION(nbdim) :: indmin,indmax
	706	LOGICAL,DIMENSION(nbdim) :: noraftab
	707	REAL ,DIMENSION(nbdim) :: s_Child_temp,s_Parent_temp
	708	INTEGER,DIMENSION(nbdim) :: lowerbound,upperbound
	709	INTEGER,DIMENSION(nbdim) :: indminglob,indmaxglob
	710	INTEGER,DIMENSION(nbdim,2,2) :: childarray
	711	INTEGER,DIMENSION(nbdim,2,2) :: parentarray
	712	LOGICAL :: memberin,member
[662]	713	TYPE(AGRIF_PVARIABLE),SAVE :: parentvalues
	714	LOGICAL :: find_list_interp
	715	INTEGER,DIMENSION(nbdim) :: indminglob2,indmaxglob2
[396]	716	C
	717	#ifdef AGRIF_MPI
	718	C
	719	LOGICAL :: memberout
	720	INTEGER,PARAMETER :: etiquette = 100
	721	INTEGER :: code
	722	INTEGER,DIMENSION(nbdim,4) :: tab3
	723	INTEGER,DIMENSION(nbdim,4,0:Agrif_Nbprocs-1) :: tab4
[898]	724	INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
[662]	725	LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall
[1200]	726	LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1
[662]	727	LOGICAL, DIMENSION(1) :: memberin1
[396]	728	C
	729	#endif
	730	C
[1200]	731
[396]	732	C
	733	C Boundaries of the current grid where interpolation is done
[662]	734
	735	IF (Associated(child%var%list_interp)) THEN
	736	Call Agrif_Find_list_interp(child%var%list_interp,pttab,petab,
	737	& pttab_Child,pttab_Parent,nbdim,
	738	& indmin,indmax,indminglob,
	739	& indmaxglob,indminglob2,indmaxglob2,parentarray,
	740	& pttruetab,cetruetab,member,memberin,find_list_interp
	741	#if defined AGRIF_MPI
[898]	742	& ,tab4t,memberinall,sendtoproc1,recvfromproc1
[662]	743	#endif
	744	& )
	745	ELSE
	746	find_list_interp = .FALSE.
	747	ENDIF
	748
	749	IF (.not.find_list_interp) THEN
[1200]	750
[396]	751	Call Agrif_nbdim_Get_bound_dimension(child % var,
	752	& lowerbound,upperbound,nbdim)
[1200]	753
[396]	754	Call Agrif_Childbounds(nbdim,lowerbound,upperbound,
	755	& pttab,petab,
	756	& pttruetab,cetruetab,memberin)
[662]	757
[396]	758	C
	759	Call Agrif_Parentbounds(TYPEinterp,nbdim,indminglob,indmaxglob,
	760	& s_Parent_temp,s_Child_temp,
	761	& s_Child,ds_Child,
	762	& s_Parent,ds_Parent,
	763	& pttab,petab,
	764	& pttab_Child,pttab_Parent,
	765	& child%var%root_var%posvar,
	766	& child % var % root_var % interptab)
[1200]	767
[662]	768	#ifdef AGRIF_MPI
	769	IF (memberin) THEN
	770	Call Agrif_Parentbounds(TYPEinterp,nbdim,indmin,indmax,
[396]	771	& s_Parent_temp,s_Child_temp,
	772	& s_Child,ds_Child,
	773	& s_Parent,ds_Parent,
	774	& pttruetab,cetruetab,
	775	& pttab_Child,pttab_Parent,
	776	& child%var%root_var%posvar,
	777	& child % var % root_var % interptab)
[1200]	778	ENDIF
	779
[396]	780	Call Agrif_nbdim_Get_bound_dimension(parent%var,
	781	& lowerbound,upperbound,nbdim)
[1200]	782
[396]	783	Call Agrif_ChildGrid_to_ParentGrid()
	784	C
	785	Call Agrif_Childbounds(nbdim,
	786	& lowerbound,upperbound,
	787	& indminglob,indmaxglob,
	788	& indminglob2,indmaxglob2,member)
	789
	790	C
	791	IF (member) THEN
	792	Call Agrif_GlobtoLocInd2(parentarray,
	793	& lowerbound,upperbound,
	794	& indminglob2,indmaxglob2,
	795	& nbdim,Agrif_Procrank,
	796	& member)
[662]	797	endif
	798
[396]	799	Call Agrif_ParentGrid_to_ChildGrid()
	800	#else
	801	parentarray(:,1,1) = indminglob
	802	parentarray(:,2,1) = indmaxglob
	803	parentarray(:,1,2) = indminglob
	804	parentarray(:,2,2) = indmaxglob
	805	indmin = indminglob
	806	indmax = indmaxglob
	807	member = .TRUE.
	808	#endif
	809
[662]	810	ELSE
	811
	812	#if !defined AGRIF_MPI
	813	parentarray(:,1,1) = indminglob
	814	parentarray(:,2,1) = indmaxglob
	815	parentarray(:,1,2) = indminglob
	816	parentarray(:,2,2) = indmaxglob
	817	indmin = indminglob
	818	indmax = indmaxglob
	819	member = .TRUE.
	820	s_Parent_temp = s_Parent + (indminglob - pttab_Parent)*ds_Parent
	821	s_Child_temp = s_Child + (pttab - pttab_Child) * ds_Child
	822	#else
	823	s_Parent_temp = s_Parent + (indmin - pttab_Parent)*ds_Parent
	824	s_Child_temp = s_Child + (pttruetab - pttab_Child) * ds_Child
	825	#endif
	826
	827	ENDIF
[396]	828
	829	IF (member) THEN
[662]	830	IF (.not.associated(tempP%var)) allocate(tempP%var)
[396]	831
	832	C
	833	Call Agrif_nbdim_allocation(tempP%var,
	834	& parentarray(:,1,1),parentarray(:,2,1),nbdim)
	835
	836	Call Agrif_nbdim_Full_VarEQreal(tempP%var,0.,nbdim)
	837
	838
	839
	840	IF (present(procname)) THEN
	841	Call Agrif_ChildGrid_to_ParentGrid()
	842	SELECT CASE (nbdim)
	843	CASE(1)
	844	CALL procname(tempP%var%array1,
	845	& parentarray(1,1,2),parentarray(1,2,2))
	846	CASE(2)
	847	CALL procname(tempP%var%array2,
	848	& parentarray(1,1,2),parentarray(1,2,2),
	849	& parentarray(2,1,2),parentarray(2,2,2))
	850	CASE(3)
	851	CALL procname(tempP%var%array3,
	852	& parentarray(1,1,2),parentarray(1,2,2),
	853	& parentarray(2,1,2),parentarray(2,2,2),
	854	& parentarray(3,1,2),parentarray(3,2,2))
	855	CASE(4)
	856	CALL procname(tempP%var%array4,
	857	& parentarray(1,1,2),parentarray(1,2,2),
	858	& parentarray(2,1,2),parentarray(2,2,2),
	859	& parentarray(3,1,2),parentarray(3,2,2),
	860	& parentarray(4,1,2),parentarray(4,2,2))
	861	CASE(5)
	862	CALL procname(tempP%var%array5,
	863	& parentarray(1,1,2),parentarray(1,2,2),
	864	& parentarray(2,1,2),parentarray(2,2,2),
	865	& parentarray(3,1,2),parentarray(3,2,2),
	866	& parentarray(4,1,2),parentarray(4,2,2),
	867	& parentarray(5,1,2),parentarray(5,2,2))
	868	CASE(6)
	869	CALL procname(tempP%var%array6,
	870	& parentarray(1,1,2),parentarray(1,2,2),
	871	& parentarray(2,1,2),parentarray(2,2,2),
	872	& parentarray(3,1,2),parentarray(3,2,2),
	873	& parentarray(4,1,2),parentarray(4,2,2),
	874	& parentarray(5,1,2),parentarray(5,2,2),
	875	& parentarray(6,1,2),parentarray(6,2,2))
	876	END SELECT
	877	Call Agrif_ParentGrid_to_ChildGrid()
	878	ELSE
[662]	879
[396]	880	Call Agrif_nbdim_VarEQvar(tempP%var,
	881	& parentarray(:,1,1),parentarray(:,2,1),
	882	& parent%var,parentarray(:,1,2),parentarray(:,2,2),
	883	& nbdim)
	884	ENDIF
	885	endif
	886
	887	#ifdef AGRIF_MPI
[662]	888	if (.not.find_list_interp) then
[396]	889	tab3(:,1) = indminglob2(:)
	890	tab3(:,2) = indmaxglob2(:)
	891	tab3(:,3) = indmin(:)
	892	tab3(:,4) = indmax(:)
	893	C
	894	C
	895	Call MPI_ALLGATHER(tab3,4nbdim,MPI_INTEGER,tab4,4nbdim,
	896	& MPI_INTEGER,MPI_COMM_WORLD,code)
	897
[662]	898	IF (.not.associated(tempPextend%var)) Allocate(tempPextend%var)
	899
[396]	900	DO k=0,Agrif_Nbprocs-1
	901	do j=1,4
	902	do i=1,nbdim
	903	tab4t(i,k,j) = tab4(i,j,k)
	904	enddo
	905	enddo
	906	enddo
[662]	907
	908	memberin1(1) = memberin
	909	CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall,
	910	& 1,MPI_LOGICAL,MPI_COMM_WORLD,code)
[898]	911
	912	Call Get_External_Data_first(tab4t(:,:,1),
	913	& tab4t(:,:,2),
	914	& tab4t(:,:,3),tab4t(:,:,4),nbdim,member,memberin,
	915	& memberinall,sendtoproc1,recvfromproc1,tab4t(:,:,5),
	916	& tab4t(:,:,6),tab4t(:,:,7),tab4t(:,:,8))
	917
[662]	918	endif
	919
[898]	920	! Call Get_External_Data(tempP,tempPextend,tab4t(:,:,1),
	921	! & tab4t(:,:,2),
	922	! & tab4t(:,:,3),tab4t(:,:,4),nbdim,member,memberin,
	923	! & memberinall)
	924
	925	Call ExchangeSameLevel2(sendtoproc1,recvfromproc1,nbdim,
	926	& tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6),
	927	& tab4t(:,:,7),tab4t(:,:,8),memberin,tempP,
	928	& tempPextend)
[396]	929	#else
	930	tempPextend%var => tempP%var
	931	#endif
	932
[662]	933	if (.not.find_list_interp) then
	934	Call Agrif_Addto_list_interp(child%var%list_interp,pttab,petab,
	935	& pttab_Child,pttab_Parent,indmin,indmax,
	936	& indminglob,indmaxglob,indminglob2,indmaxglob2,parentarray,
	937	& pttruetab,cetruetab,member,memberin,nbdim
	938	#if defined AGRIF_MPI
[898]	939	& ,tab4t,memberinall,sendtoproc1,recvfromproc1
[662]	940	#endif
	941	& )
[1200]	942	endif
[396]	943	C
	944	C
	945	IF (memberin) THEN
[662]	946	IF (.not.associated(tempC%var)) allocate(tempC%var)
[396]	947	C
	948
	949	Call Agrif_nbdim_allocation(tempC%var,pttruetab,cetruetab,nbdim)
	950
	951	C
	952	C
	953	C Special values on the parent grid
	954	if (Agrif_UseSpecialValue) then
	955	C
	956	noraftab(1:nbdim) =
	957	& child % var % root_var % interptab(1:nbdim) .EQ. 'N'
	958	C
[662]	959	IF (.not.associated(parentvalues%var))
	960	& Allocate(parentvalues%var)
[396]	961	C
	962	Call Agrif_nbdim_allocation
	963	& (parentvalues%var,indmin,indmax,nbdim)
	964	Call Agrif_nbdim_Full_VarEQvar
	965	& (parentvalues%var,tempPextend%var,nbdim)
	966	C
	967	Call Agrif_CheckMasknD(tempPextend,
	968	& parentvalues,
	969	& indmin(1:nbdim),indmax(1:nbdim),
	970	& indmin(1:nbdim),indmax(1:nbdim),
	971	& noraftab(1:nbdim),nbdim)
	972	C
	973	Call Agrif_nbdim_deallocation(parentvalues%var,nbdim)
[662]	974	C Deallocate(parentvalues%var)
[396]	975	C
	976	C
	977	endif
	978
	979	C
	980	C
	981	C Interpolation of the current grid
	982
	983	IF (memberin) THEN
	984	if ( nbdim .EQ. 1 ) then
	985	Call Agrif_Interp_1D_recursive(TypeInterp,
	986	& tempPextend%var%array1,tempC%var%array1,
	987	& indmin,indmax,
	988	& pttruetab,cetruetab,
	989	& s_Child_temp,s_Parent_temp,
	990	& ds_Child,ds_Parent,nbdim)
	991	elseif ( nbdim .EQ. 2 ) then
	992
	993	Call Agrif_Interp_2D_recursive(TypeInterp,
	994	& tempPextend%var%array2,tempC%var%array2,
	995	& indmin,indmax,
	996	& pttruetab,cetruetab,
	997	& s_Child_temp,s_Parent_temp,
	998	& ds_Child,ds_Parent,nbdim)
	999	elseif ( nbdim .EQ. 3 ) then
	1000
	1001	Call Agrif_Interp_3D_recursive(TypeInterp,
	1002	& tempPextend%var%array3,tempC%var%array3,
	1003	& indmin,indmax,
	1004	& pttruetab,cetruetab,
	1005	& s_Child_temp,s_Parent_temp,
	1006	& ds_Child,ds_Parent,nbdim)
	1007	elseif ( nbdim .EQ. 4 ) then
	1008	Call Agrif_Interp_4D_recursive(TypeInterp,
	1009	& tempPextend%var%array4,tempC%var%array4,
	1010	& indmin,indmax,
	1011	& pttruetab,cetruetab,
	1012	& s_Child_temp,s_Parent_temp,
	1013	& ds_Child,ds_Parent,nbdim)
	1014	elseif ( nbdim .EQ. 5 ) then
	1015	Call Agrif_Interp_5D_recursive(TypeInterp,
	1016	& tempPextend%var%array5,tempC%var%array5,
	1017	& indmin,indmax,
	1018	& pttruetab,cetruetab,
	1019	& s_Child_temp,s_Parent_temp,
	1020	& ds_Child,ds_Parent,nbdim)
	1021	elseif ( nbdim .EQ. 6 ) then
	1022	Call Agrif_Interp_6D_recursive(TypeInterp,
	1023	& tempPextend%var%array6,tempC%var%array6,
	1024	& indmin,indmax,
	1025	& pttruetab,cetruetab,
	1026	& s_Child_temp,s_Parent_temp,
	1027	& ds_Child,ds_Parent,nbdim)
	1028	endif
	1029
	1030
	1031	C
	1032
	1033	Call Agrif_nbdim_Get_bound_dimension(child % var,
	1034	& lowerbound,upperbound,nbdim)
	1035
	1036	#ifdef AGRIF_MPI
	1037	Call Agrif_GlobtoLocInd2(childarray,
	1038	& lowerbound,upperbound,
	1039	& pttruetab,cetruetab,
	1040	& nbdim,Agrif_Procrank,
	1041	& memberout)
	1042
	1043	#else
	1044	childarray(:,1,1) = pttruetab
	1045	childarray(:,2,1) = cetruetab
	1046	childarray(:,1,2) = pttruetab
	1047	childarray(:,2,2) = cetruetab
	1048	ccccccccccccccc memberout = .TRUE.
	1049	#endif
	1050
[1200]	1051
	1052	C
	1053	C
	1054	C Special values on the child grid
	1055	if (Agrif_UseSpecialValueFineGrid) then
	1056	C
	1057
	1058	Call GiveAgrif_SpecialValueToTab_mpi(child%var,tempC%var,
	1059	& childarray,
	1060	& pttruetab,cetruetab,
	1061	& Agrif_SpecialValueFineGrid,nbdim)
	1062
	1063	C
[396]	1064	endif
[1200]	1065
	1066	endif
[396]	1067
	1068	C
	1069	if (torestore) then
	1070	C
	1071	#ifdef AGRIF_MPI
	1072	C
	1073	SELECT CASE (nbdim)
	1074	CASE (1)
	1075	do i = pttruetab(1),cetruetab(1)
	1076	ChildarrayAModifier if (restore%var%restore1D(i) == 0)
	1077	ChildarrayAModifier & child%var%array1(childarray(i,1,2)
	1078	ChildarrayAModifier & ) =
	1079	ChildarrayAModifier & tempC%var%array1(i)
	1080	enddo
	1081	CASE (2)
	1082	do i = pttruetab(1),cetruetab(1)
	1083	do j = pttruetab(2),cetruetab(2)
	1084	ChildarrayAModifier if (restore%var%restore2D(i,j) == 0)
	1085	ChildarrayAModifier & child%var%array2(childarray(i,1,2),
	1086	ChildarrayAModifier & childarray(j,2,2)) =
	1087	ChildarrayAModifier & tempC%var%array2(i,j)
	1088	enddo
	1089	enddo
	1090	CASE (3)
	1091	do i = pttruetab(1),cetruetab(1)
	1092	do j = pttruetab(2),cetruetab(2)
	1093	do k = pttruetab(3),cetruetab(3)
	1094	ChildarrayAModifier if (restore%var%restore3D(i,j,k) == 0)
	1095	ChildarrayAModifier & child%var%array3(childarray(i,1,2),
	1096	ChildarrayAModifier & childarray(j,2,2),
	1097	ChildarrayAModifier & childarray(k,3,2)) =
	1098	ChildarrayAModifier & tempC%var%array3(i,j,k)
	1099	enddo
	1100	enddo
	1101	enddo
	1102	CASE (4)
	1103	do i = pttruetab(1),cetruetab(1)
	1104	do j = pttruetab(2),cetruetab(2)
	1105	do k = pttruetab(3),cetruetab(3)
	1106	do l = pttruetab(4),cetruetab(4)
	1107	ChildarrayAModifier if (restore%var%restore4D(i,j,k,l) == 0)
	1108	ChildarrayAModifier & child%var%array4(childarray(i,1,2),
	1109	ChildarrayAModifier & childarray(j,2,2),
	1110	ChildarrayAModifier & childarray(k,3,2),
	1111	ChildarrayAModifier & childarray(l,4,2)) =
	1112	ChildarrayAModifier & tempC%var%array4(i,j,k,l)
	1113	enddo
	1114	enddo
	1115	enddo
	1116	enddo
	1117	CASE (5)
	1118	do i = pttruetab(1),cetruetab(1)
	1119	do j = pttruetab(2),cetruetab(2)
	1120	do k = pttruetab(3),cetruetab(3)
	1121	do l = pttruetab(4),cetruetab(4)
	1122	do m = pttruetab(5),cetruetab(5)
	1123	ChildarrayAModifier if (restore%var%restore5D(i,j,k,l,m) == 0)
	1124	ChildarrayAModifier & child%var%array5(childarray(i,1,2),
	1125	ChildarrayAModifier & childarray(j,2,2),
	1126	ChildarrayAModifier & childarray(k,3,2),
	1127	ChildarrayAModifier & childarray(l,4,2),
	1128	ChildarrayAModifier & childarray(m,5,2)) =
	1129	ChildarrayAModifier & tempC%var%array5(i,j,k,l,m)
	1130	enddo
	1131	enddo
	1132	enddo
	1133	enddo
	1134	enddo
	1135	CASE (6)
	1136	do i = pttruetab(1),cetruetab(1)
	1137	do j = pttruetab(2),cetruetab(2)
	1138	do k = pttruetab(3),cetruetab(3)
	1139	do l = pttruetab(4),cetruetab(4)
	1140	do m = pttruetab(5),cetruetab(5)
	1141	do n = pttruetab(6),cetruetab(6)
	1142	ChildarrayAModifier if (restore%var%restore6D(i,j,k,l,m,n) == 0)
	1143	ChildarrayAModifier & child%var%array6(childarray(i,1,2),
	1144	ChildarrayAModifier & childarray(j,2,2),
	1145	ChildarrayAModifier & childarray(k,3,2),
	1146	ChildarrayAModifier & childarray(l,4,2),
	1147	ChildarrayAModifier & childarray(m,5,2),
	1148	ChildarrayAModifier & childarray(n,6,2)) =
	1149	ChildarrayAModifier & tempC%var%array6(i,j,k,l,m,n)
	1150	enddo
	1151	enddo
	1152	enddo
	1153	enddo
	1154	enddo
	1155	enddo
	1156	END SELECT
	1157	C
	1158	#else
	1159	SELECT CASE (nbdim)
	1160	CASE (1)
	1161	do i = pttruetab(1),cetruetab(1)
	1162	if (restore%var%restore1D(i) == 0)
	1163	& child % var % array1(i) =
	1164	& tempC % var % array1(i)
	1165	enddo
	1166	CASE (2)
	1167	do j = pttruetab(2),cetruetab(2)
[1200]	1168	do i = pttruetab(1),cetruetab(1)
[662]	1169	if (restore%var%restore2D(i,j) == 0)
[396]	1170	& child % var % array2(i,j) =
	1171	& tempC % var % array2(i,j)
	1172	enddo
	1173	enddo
	1174	CASE (3)
	1175	do k = pttruetab(3),cetruetab(3)
	1176	do j = pttruetab(2),cetruetab(2)
	1177	do i = pttruetab(1),cetruetab(1)
	1178	if (restore%var%restore3D(i,j,k) == 0)
	1179	& child % var % array3(i,j,k) =
	1180	& tempC % var % array3(i,j,k)
	1181	enddo
	1182	enddo
	1183	enddo
	1184	CASE (4)
	1185	do l = pttruetab(4),cetruetab(4)
	1186	do k = pttruetab(3),cetruetab(3)
	1187	do j = pttruetab(2),cetruetab(2)
	1188	do i = pttruetab(1),cetruetab(1)
	1189	if (restore%var%restore4D(i,j,k,l) == 0)
	1190	& child % var % array4(i,j,k,l) =
	1191	& tempC % var % array4(i,j,k,l)
	1192	enddo
	1193	enddo
	1194	enddo
	1195	enddo
	1196	CASE (5)
	1197	do m = pttruetab(5),cetruetab(5)
	1198	do l = pttruetab(4),cetruetab(4)
	1199	do k = pttruetab(3),cetruetab(3)
	1200	do j = pttruetab(2),cetruetab(2)
	1201	do i = pttruetab(1),cetruetab(1)
	1202	if (restore%var%restore5D(i,j,k,l,m) == 0)
	1203	& child % var % array5(i,j,k,l,m) =
	1204	& tempC % var % array5(i,j,k,l,m)
	1205	enddo
	1206	enddo
	1207	enddo
	1208	enddo
	1209	enddo
	1210	CASE (6)
	1211	do n = pttruetab(6),cetruetab(6)
	1212	do m = pttruetab(5),cetruetab(5)
	1213	do l = pttruetab(4),cetruetab(4)
	1214	do k = pttruetab(3),cetruetab(3)
	1215	do j = pttruetab(2),cetruetab(2)
	1216	do i = pttruetab(1),cetruetab(1)
	1217	if (restore%var%restore6D(i,j,k,l,m,n) == 0)
	1218	& child % var % array6(i,j,k,l,m,n) =
	1219	& tempC % var % array6(i,j,k,l,m,n)
	1220	enddo
	1221	enddo
	1222	enddo
	1223	enddo
	1224	enddo
	1225	enddo
	1226	END SELECT
	1227	C
	1228	#endif
	1229	C
	1230	else
	1231	C
	1232	C
	1233	IF (memberin) THEN
	1234	SELECT CASE (nbdim)
	1235	CASE (1)
	1236	child%var%array1(childarray(1,1,2):childarray(1,2,2)) =
	1237	& tempC%var%array1(childarray(1,1,1):childarray(1,2,1))
	1238	CASE (2)
	1239	child%var%array2(childarray(1,1,2):childarray(1,2,2),
	1240	& childarray(2,1,2):childarray(2,2,2)) =
	1241	& tempC%var%array2(childarray(1,1,1):childarray(1,2,1),
	1242	& childarray(2,1,1):childarray(2,2,1))
	1243	CASE (3)
	1244	child%var%array3(childarray(1,1,2):childarray(1,2,2),
	1245	& childarray(2,1,2):childarray(2,2,2),
	1246	& childarray(3,1,2):childarray(3,2,2)) =
	1247	& tempC%var%array3(childarray(1,1,1):childarray(1,2,1),
	1248	& childarray(2,1,1):childarray(2,2,1),
	1249	& childarray(3,1,1):childarray(3,2,1))
	1250	CASE (4)
	1251	child%var%array4(childarray(1,1,2):childarray(1,2,2),
	1252	& childarray(2,1,2):childarray(2,2,2),
	1253	& childarray(3,1,2):childarray(3,2,2),
	1254	& childarray(4,1,2):childarray(4,2,2)) =
	1255	& tempC%var%array4(childarray(1,1,1):childarray(1,2,1),
	1256	& childarray(2,1,1):childarray(2,2,1),
	1257	& childarray(3,1,1):childarray(3,2,1),
	1258	& childarray(4,1,1):childarray(4,2,1))
	1259	CASE (5)
	1260	child%var%array5(childarray(1,1,2):childarray(1,2,2),
	1261	& childarray(2,1,2):childarray(2,2,2),
	1262	& childarray(3,1,2):childarray(3,2,2),
	1263	& childarray(4,1,2):childarray(4,2,2),
	1264	& childarray(5,1,2):childarray(5,2,2)) =
	1265	& tempC%var%array5(childarray(1,1,1):childarray(1,2,1),
	1266	& childarray(2,1,1):childarray(2,2,1),
	1267	& childarray(3,1,1):childarray(3,2,1),
	1268	& childarray(4,1,1):childarray(4,2,1),
	1269	& childarray(5,1,1):childarray(5,2,1))
	1270	CASE (6)
	1271	child%var%array6(childarray(1,1,2):childarray(1,2,2),
	1272	& childarray(2,1,2):childarray(2,2,2),
	1273	& childarray(3,1,2):childarray(3,2,2),
	1274	& childarray(4,1,2):childarray(4,2,2),
	1275	& childarray(5,1,2):childarray(5,2,2),
	1276	& childarray(6,1,2):childarray(6,2,2)) =
	1277	& tempC%var%array6(childarray(1,1,1):childarray(1,2,1),
	1278	& childarray(2,1,1):childarray(2,2,1),
	1279	& childarray(3,1,1):childarray(3,2,1),
	1280	& childarray(4,1,1):childarray(4,2,1),
	1281	& childarray(5,1,1):childarray(5,2,1),
	1282	& childarray(6,1,1):childarray(6,2,1))
	1283	END SELECT
	1284	ENDIF
	1285	C
	1286	C
	1287	endif
	1288
	1289	Call Agrif_nbdim_deallocation(tempPextend%var,nbdim)
[662]	1290	C deallocate(tempPextend%var)
[396]	1291
	1292	Call Agrif_nbdim_deallocation(tempC%var,nbdim)
	1293
[662]	1294	C Deallocate(tempC % var)
[396]	1295	ELSE
	1296
[662]	1297	C deallocate(tempPextend%var)
[396]	1298
	1299	ENDIF
	1300	C
	1301	C
	1302	C Deallocations
	1303	#ifdef AGRIF_MPI
	1304	IF (member) THEN
	1305	Call Agrif_nbdim_deallocation(tempP%var,nbdim)
[662]	1306	C Deallocate(tempP % var)
[396]	1307	endif
	1308	#endif
	1309	C
	1310	C
	1311
	1312	C
	1313	C
	1314	End Subroutine Agrif_InterpnD
	1315	C
	1316	C
	1317	C
	1318	C
	1319	C
	1320	C **************************************************************************
	1321	CCC Subroutine Agrif_Parentbounds
	1322	C **************************************************************************
	1323	C
	1324	Subroutine Agrif_Parentbounds(TYPEinterp,nbdim,indmin,indmax,
	1325	& s_Parent_temp,
	1326	& s_Child_temp,s_Child,ds_Child,
	1327	& s_Parent,ds_Parent,
	1328	& pttruetab,cetruetab,pttab_Child,
	1329	& pttab_Parent,posvar,interptab)
	1330	C
	1331	CCC Description:
	1332	CCC Subroutine calculating the bounds of the parent grid for the interpolation
	1333	CCC of the child grid
	1334	C
	1335	C
	1336	C Declarations:
	1337	C
	1338	C
	1339	C Arguments
	1340	INTEGER :: nbdim
	1341	INTEGER, DIMENSION(6) :: TypeInterp
	1342	INTEGER,DIMENSION(nbdim) :: indmin,indmax
	1343	REAL,DIMENSION(nbdim) :: s_Parent_temp,s_child_temp
	1344	REAL,DIMENSION(nbdim) :: s_Child,ds_child
	1345	REAL,DIMENSION(nbdim) :: s_Parent,ds_Parent
	1346	INTEGER,DIMENSION(nbdim) :: pttruetab,cetruetab
	1347	INTEGER,DIMENSION(nbdim) :: pttab_Child,pttab_Parent
	1348	INTEGER,DIMENSION(nbdim) :: posvar
	1349	CHARACTER(6), DIMENSION(nbdim) :: interptab
	1350	C
	1351	C Local variables
	1352	INTEGER :: i
	1353	REAL,DIMENSION(nbdim) :: dim_newmin,dim_newmax
	1354	C
	1355	dim_newmin = s_Child + (pttruetab - pttab_Child) * ds_Child
	1356	dim_newmax = s_Child + (cetruetab - pttab_Child) * ds_Child
	1357
	1358	DO i = 1,nbdim
	1359	C
	1360	indmin(i) = pttab_Parent(i) +
	1361	& agrif_int((dim_newmin(i)-s_Parent(i))/ds_Parent(i))
	1362	C
	1363	indmax(i) = pttab_Parent(i) +
	1364	& agrif_ceiling((dim_newmax(i)-
	1365	& s_Parent(i))/ds_Parent(i))
	1366
	1367	C
	1368	C
	1369	C Necessary for the Quadratic interpolation
	1370	C
	1371
	1372	IF ((pttruetab(i) == cetruetab(i)) .AND.
	1373	& (posvar(i) == 1)) THEN
	1374	ELSEIF (interptab(i) .EQ. 'N') THEN
	1375	ELSEIF ( TYPEinterp(i) .eq. Agrif_ppm .or.
[662]	1376	& TYPEinterp(i) .eq. Agrif_eno .or.
	1377	& TYPEinterp(i) .eq. Agrif_weno) THEN
[396]	1378	indmin(i) = indmin(i) - 2
	1379	indmax(i) = indmax(i) + 2
[662]	1380	ELSE IF (( TYPEinterp(i) .ne. Agrif_constant )
	1381	& .AND.( TYPEinterp(i) .ne. Agrif_linear )) THEN
[396]	1382	indmin(i) = indmin(i) - 1
	1383	indmax(i) = indmax(i) + 1
	1384	ENDIF
	1385
	1386
	1387	C
	1388	ENDDO
	1389	C
	1390	s_Parent_temp = s_Parent + (indmin - pttab_Parent) * ds_Parent
	1391	C
	1392	s_Child_temp = s_Child + (pttruetab - pttab_Child) * ds_Child
	1393	C
	1394	C
	1395	Return
	1396	C
	1397	C
	1398	End Subroutine Agrif_Parentbounds
	1399	C
	1400	C
	1401	C
	1402	C **************************************************************************
	1403	CCC Subroutine Agrif_Interp_1D_Recursive
	1404	C **************************************************************************
	1405	C
	1406	Subroutine Agrif_Interp_1D_recursive(TypeInterp,tabin,tabout,
	1407	& indmin,indmax,
	1408	& pttab_child,petab_child,
	1409	& s_child,s_parent,ds_child,ds_parent,nbdim)
	1410	C
	1411	CCC Description:
	1412	CCC Subroutine for the interpolation of a 1D grid variable.
	1413	CCC It calls Agrif_InterpBase.
	1414	C
	1415	C Declarations:
	1416	C
	1417
	1418	C
	1419	C Arguments
	1420	INTEGER :: nbdim
	1421	INTEGER,DIMENSION(1) :: TypeInterp
	1422	INTEGER, DIMENSION(nbdim) :: indmin,indmax
	1423	INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
	1424	REAL, DIMENSION(nbdim) :: s_child,s_parent
	1425	REAL, DIMENSION(nbdim) :: ds_child,ds_parent
[662]	1426	REAL, INTENT(IN),DIMENSION(indmin(nbdim):indmax(nbdim)) :: tabin
	1427	REAL, INTENT(OUT),
	1428	& DIMENSION(pttab_child(nbdim):petab_child(nbdim)) :: tabout
	1429	INTEGER :: coeffraf
[396]	1430	C
	1431	C
	1432	C Commentaire perso : nbdim vaut toujours 1 ici.
	1433	C
[662]	1434	coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
	1435
[396]	1436	Call Agrif_InterpBase(TypeInterp(1),
	1437	& tabin(indmin(nbdim):indmax(nbdim)),
	1438	& tabout(pttab_child(nbdim):petab_child(nbdim)),
	1439	& indmin(nbdim),indmax(nbdim),
	1440	& pttab_child(nbdim),petab_child(nbdim),
	1441	& s_parent(nbdim),s_child(nbdim),
[662]	1442	& ds_parent(nbdim),ds_child(nbdim),coeffraf)
[779]	1443
[396]	1444	C
	1445	Return
	1446	C
	1447	C
	1448	End Subroutine Agrif_Interp_1D_recursive
	1449	C
	1450	C
	1451	C
	1452	C **************************************************************************
	1453	CCC Subroutine Agrif_Interp_2D_Recursive
	1454	C **************************************************************************
	1455	C
	1456	Subroutine Agrif_Interp_2D_recursive(TypeInterp,
	1457	& tabin,tabout,
	1458	& indmin,indmax,
	1459	& pttab_child,petab_child,
	1460	& s_child, s_parent,
	1461	& ds_child,ds_parent,
	1462	& nbdim)
	1463	C
	1464	CCC Description:
	1465	CCC Subroutine for the interpolation of a 2D grid variable.
	1466	CCC It calls Agrif_Interp_1D_recursive and Agrif_InterpBase.
	1467	C
	1468	C Declarations:
	1469	C
	1470
	1471	C
	1472	INTEGER :: nbdim
	1473	INTEGER,DIMENSION(2) :: TypeInterp
	1474	INTEGER, DIMENSION(nbdim) :: indmin,indmax
	1475	INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
	1476	REAL , DIMENSION(nbdim) :: s_child, s_parent
	1477	REAL , DIMENSION(nbdim) :: ds_child,ds_parent
[662]	1478	REAL ,INTENT(IN), DIMENSION(
[396]	1479	& indmin(nbdim-1):indmax(nbdim-1),
	1480	& indmin(nbdim):indmax(nbdim)
	1481	& ) :: tabin
[662]	1482	REAL ,INTENT(OUT), DIMENSION(
[396]	1483	& pttab_child(nbdim-1):petab_child(nbdim-1),
	1484	& pttab_child(nbdim):petab_child(nbdim)
	1485	& ) :: tabout
	1486	C
	1487	C Local variables
[662]	1488	REAL, DIMENSION(pttab_child(nbdim-1):petab_child(nbdim-1),
	1489	& indmin(nbdim):indmax(nbdim)) :: tabtemp
[396]	1490	INTEGER i,j
[662]	1491	INTEGER :: coeffraf
[779]	1492	REAL , DIMENSION(
	1493	& pttab_child(nbdim):petab_child(nbdim),
	1494	& pttab_child(nbdim-1):petab_child(nbdim-1)
	1495	& ) :: tabout_trsp
	1496	REAL, DIMENSION(indmin(nbdim):indmax(nbdim),
	1497	& pttab_child(nbdim-1):petab_child(nbdim-1)) :: tabtemp_trsp
	1498
[396]	1499	C
	1500	C
	1501	C
[662]	1502	C
[396]	1503	C Commentaire perso : nbdim vaut toujours 2 ici.
	1504	C
[779]	1505	coeffraf = nint ( ds_parent(1) / ds_child(1) )
	1506	IF((TypeInterp(1) == Agrif_Linear) .AND. (coeffraf /= 1 ) )THEN
	1507
	1508	!---CDIR NEXPAND
	1509	IF(.NOT. precomputedone(1) ) call linear1Dprecompute2D(
	1510	& indmax(2)-indmin(2)+1,
	1511	& indmax(1)-indmin(1)+1,
	1512	& petab_child(1)-pttab_child(1)+1,
	1513	& s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
	1514	!---CDIR NEXPAND
	1515	call linear1daftercompute(tabin,tabtemp,
	1516	& size(tabin), size(tabtemp),
	1517	& s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
	1518
	1519	ELSEIF((TypeInterp(1) == Agrif_PPM) .AND. (coeffraf /= 1 ) )THEN
	1520	!---CDIR NEXPAND
	1521	IF(.NOT. precomputedone(1) ) call ppm1Dprecompute2D(
	1522	& indmax(2)-indmin(2)+1,
	1523	& indmax(1)-indmin(1)+1,
	1524	& petab_child(1)-pttab_child(1)+1,
	1525	& s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
	1526	!---CDIR NEXPAND
	1527	call ppm1daftercompute(tabin,tabtemp,
	1528	& size(tabin), size(tabtemp),
	1529	& s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
	1530
	1531	ELSE
	1532
[396]	1533	do j = indmin(nbdim),indmax(nbdim)
	1534	C
[779]	1535	!---CDIR NEXPAND
[396]	1536	Call Agrif_Interp_1D_recursive(TypeInterp(1),
	1537	& tabin(indmin(nbdim-1):indmax(nbdim-1),j),
	1538	& tabtemp(pttab_child(nbdim-1):petab_child(nbdim-1),j),
	1539	& indmin(1:nbdim-1),indmax(1:nbdim-1),
	1540	& pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
	1541	& s_child(1:nbdim-1),s_parent(1:nbdim-1),
	1542	& ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
	1543	C
	1544	enddo
[779]	1545	ENDIF
	1546
[662]	1547	coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
	1548
[779]	1549	tabtemp_trsp = TRANSPOSE(tabtemp)
	1550
	1551	IF((TypeInterp(2) == Agrif_Linear) .AND. (coeffraf /= 1 ) )THEN
	1552
	1553	!---CDIR NEXPAND
	1554	IF(.NOT. precomputedone(2) ) call linear1Dprecompute2D(
	1555	& petab_child(1)-pttab_child(1)+1,
	1556	& indmax(2)-indmin(2)+1,
	1557	& petab_child(2)-pttab_child(2)+1,
	1558	& s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
	1559	!---CDIR NEXPAND
	1560	call linear1daftercompute(tabtemp_trsp,tabout_trsp,
	1561	& size(tabtemp_trsp), size(tabout_trsp),
	1562	& s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
	1563
	1564	ELSEIF((TypeInterp(2) == Agrif_PPM) .AND. (coeffraf /= 1 ) )THEN
	1565
	1566	!---CDIR NEXPAND
	1567	IF(.NOT. precomputedone(1) )call ppm1Dprecompute2D(
	1568	& petab_child(1)-pttab_child(1)+1,
	1569	& indmax(2)-indmin(2)+1,
	1570	& petab_child(2)-pttab_child(2)+1,
	1571	& s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
	1572	!---CDIR NEXPAND
	1573	call ppm1daftercompute(tabtemp_trsp,tabout_trsp,
	1574	& size(tabtemp_trsp), size(tabout_trsp),
	1575	& s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
	1576
	1577	ELSE
[396]	1578	do i=pttab_child(nbdim-1),petab_child(nbdim-1)
	1579	C
[779]	1580	!---CDIR NEXPAND
[396]	1581	Call Agrif_InterpBase(TypeInterp(2),
[779]	1582	& tabtemp_trsp(indmin(nbdim):indmax(nbdim),i),
	1583	& tabout_trsp(pttab_child(nbdim):petab_child(nbdim),i),
[396]	1584	& indmin(nbdim),indmax(nbdim),
	1585	& pttab_child(nbdim),petab_child(nbdim),
	1586	& s_parent(nbdim),s_child(nbdim),
[662]	1587	& ds_parent(nbdim),ds_child(nbdim),coeffraf)
[779]	1588
[396]	1589	C
	1590	enddo
[779]	1591	ENDIF
	1592
	1593	tabout = TRANSPOSE(tabout_trsp)
[396]	1594	C
	1595	Return
	1596	C
	1597	C
	1598	End Subroutine Agrif_Interp_2D_recursive
	1599	C
	1600	C
	1601	C
	1602	C **************************************************************************
	1603	CCC Subroutine Agrif_Interp_3D_Recursive
	1604	C **************************************************************************
	1605	C
	1606	Subroutine Agrif_Interp_3D_recursive(TypeInterp,tabin,tabout,
	1607	& indmin,indmax,
	1608	& pttab_child,petab_child,
	1609	& s_child,s_parent,ds_child,ds_parent,nbdim)
	1610	C
	1611	CCC Description:
	1612	CCC Subroutine for the interpolation of a 3D grid variable.
	1613	CCC It calls Agrif_Interp_2D_recursive and Agrif_InterpBase.
	1614	C
	1615	C Declarations:
	1616	C
	1617
	1618	C
	1619	INTEGER :: nbdim
	1620	INTEGER,DIMENSION(3) :: TypeInterp
	1621	INTEGER, DIMENSION(nbdim) :: indmin,indmax
	1622	INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
	1623	REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
[662]	1624	REAL,INTENT(IN), DIMENSION(indmin(nbdim-2):indmax(nbdim-2),
[396]	1625	& indmin(nbdim-1):indmax(nbdim-1),
	1626	& indmin(nbdim) :indmax(nbdim)) :: tabin
[662]	1627	REAL,INTENT(OUT),
	1628	& DIMENSION(pttab_child(nbdim-2):petab_child(nbdim-2),
[396]	1629	& pttab_child(nbdim-1):petab_child(nbdim-1),
	1630	& pttab_child(nbdim):petab_child(nbdim)) :: tabout
	1631	C
	1632	C Local variables
[662]	1633	REAL, DIMENSION(pttab_child(nbdim-2):petab_child(nbdim-2),
	1634	& pttab_child(nbdim-1):petab_child(nbdim-1),
	1635	& indmin(nbdim):indmax(nbdim)) :: tabtemp
[396]	1636	INTEGER i,j,k
[662]	1637	INTEGER :: coeffraf, locind_child_left, kdeb
[396]	1638	C
	1639	C
[779]	1640	coeffraf = nint ( ds_parent(1) / ds_child(1) )
	1641	IF((TypeInterp(1) == Agrif_Linear) .AND. (coeffraf/=1))THEN
	1642	Call linear1Dprecompute2D(
	1643	& indmax(2)-indmin(2)+1,
	1644	& indmax(1)-indmin(1)+1,
	1645	& petab_child(1)-pttab_child(1)+1,
	1646	& s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
	1647	precomputedone(1) = .TRUE.
	1648	ELSEIF((TypeInterp(1) == Agrif_PPM) .AND. (coeffraf/=1))THEN
	1649	Call ppm1Dprecompute2D(
	1650	& indmax(2)-indmin(2)+1,
	1651	& indmax(1)-indmin(1)+1,
	1652	& petab_child(1)-pttab_child(1)+1,
	1653	& s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
	1654	precomputedone(1) = .TRUE.
	1655	ENDIF
	1656
	1657	coeffraf = nint ( ds_parent(2) / ds_child(2) )
	1658	IF((TypeInterp(2) == Agrif_Linear) .AND. (coeffraf/=1)) THEN
	1659	Call linear1Dprecompute2D(
	1660	& petab_child(1)-pttab_child(1)+1,
	1661	& indmax(2)-indmin(2)+1,
	1662	& petab_child(2)-pttab_child(2)+1,
	1663	& s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
	1664	precomputedone(2) = .TRUE.
	1665	ELSEIF((TypeInterp(2) == Agrif_PPM) .AND. (coeffraf/=1)) THEN
	1666	Call ppm1Dprecompute2D(
	1667	& petab_child(1)-pttab_child(1)+1,
	1668	& indmax(2)-indmin(2)+1,
	1669	& petab_child(2)-pttab_child(2)+1,
	1670	& s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
	1671	precomputedone(2) = .TRUE.
	1672	ENDIF
	1673
[396]	1674	do k = indmin(nbdim),indmax(nbdim)
	1675	C
	1676	Call Agrif_Interp_2D_recursive(TypeInterp(1:2),
	1677	& tabin(indmin(nbdim-2):indmax(nbdim-2),
	1678	& indmin(nbdim-1):indmax(nbdim-1),k),
	1679	& tabtemp(pttab_child(nbdim-2):petab_child(nbdim-2),
	1680	& pttab_child(nbdim-1):petab_child(nbdim-1),k),
	1681	& indmin(1:nbdim-1),indmax(1:nbdim-1),
	1682	& pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
	1683	& s_child(1:nbdim-1),s_parent(1:nbdim-1),
	1684	& ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
	1685	C
	1686	enddo
[662]	1687
[779]	1688	precomputedone(1) = .FALSE.
	1689	precomputedone(2) = .FALSE.
	1690	coeffraf = nint ( ds_parent(3) / ds_child(3) )
[662]	1691
	1692	Call Agrif_Compute_nbdim_interp(s_parent(nbdim),s_child(nbdim),
	1693	& ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
	1694
	1695	IF (coeffraf == 1) THEN
	1696
	1697	kdeb = indmin(3)+locind_child_left-2
	1698	do k=pttab_child(3),petab_child(3)
	1699	kdeb = kdeb + 1
	1700	do j = pttab_child(2),petab_child(2)
	1701	do i = pttab_child(1),petab_child(1)
	1702	tabout(i,j,k) = tabtemp(i,j,kdeb)
	1703	enddo
	1704	enddo
	1705	enddo
	1706
	1707	ELSE
[396]	1708	C
	1709	do j=pttab_child(nbdim-1),petab_child(nbdim-1)
	1710	C
	1711	do i=pttab_child(nbdim-2),petab_child(nbdim-2)
	1712	C
	1713	Call Agrif_InterpBase(TypeInterp(3),
	1714	& tabtemp(i,j,indmin(nbdim):indmax(nbdim)),
	1715	& tabout(i,j,pttab_child(nbdim):petab_child(nbdim)),
	1716	& indmin(nbdim),indmax(nbdim),
	1717	& pttab_child(nbdim),petab_child(nbdim),
	1718	& s_parent(nbdim),s_child(nbdim),
[662]	1719	& ds_parent(nbdim),ds_child(nbdim),coeffraf)
[396]	1720	C
	1721	enddo
	1722	C
	1723	enddo
[662]	1724	ENDIF
[396]	1725	C
	1726	Return
	1727	C
	1728	C
	1729	End Subroutine Agrif_Interp_3D_recursive
	1730	C
	1731	C
	1732	C
	1733	C **************************************************************************
	1734	CCC Subroutine Agrif_Interp_4D_Recursive
	1735	C **************************************************************************
	1736	C
	1737	Subroutine Agrif_Interp_4D_recursive(TypeInterp,tabin,tabout,
	1738	& indmin,indmax,
	1739	& pttab_child,petab_child,
	1740	& s_child,s_parent,ds_child,ds_parent,nbdim)
	1741	C
	1742	CCC Description:
	1743	CCC Subroutine for the interpolation of a 4D grid variable.
	1744	CCC It calls Agrif_Interp_3D_recursive and Agrif_InterpBase.
	1745	C
	1746	C Declarations:
	1747	C
	1748
	1749	C
	1750	INTEGER :: nbdim
	1751	INTEGER,DIMENSION(4) :: TypeInterp
	1752	INTEGER, DIMENSION(nbdim) :: indmin,indmax
	1753	INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
	1754	REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
[662]	1755	REAL,INTENT(IN), DIMENSION(indmin(nbdim-3):indmax(nbdim-3),
[396]	1756	& indmin(nbdim-2):indmax(nbdim-2),
	1757	& indmin(nbdim-1):indmax(nbdim-1),
	1758	& indmin(nbdim):indmax(nbdim)) :: tabin
[662]	1759	REAL,INTENT(OUT),
	1760	& DIMENSION(pttab_child(nbdim-3):petab_child(nbdim-3),
[396]	1761	& pttab_child(nbdim-2):petab_child(nbdim-2),
	1762	& pttab_child(nbdim-1):petab_child(nbdim-1),
	1763	& pttab_child(nbdim):petab_child(nbdim)) :: tabout
	1764	C
	1765	C Local variables
[662]	1766	REAL, DIMENSION(pttab_child(nbdim-3):petab_child(nbdim-3),
[396]	1767	& pttab_child(nbdim-2):petab_child(nbdim-2),
	1768	& pttab_child(nbdim-1):petab_child(nbdim-1),
[662]	1769	& indmin(nbdim):indmax(nbdim)) :: tabtemp
	1770	INTEGER i,j,k,l
	1771	INTEGER :: coeffraf
[396]	1772	C
[662]	1773	C
[396]	1774	do l = indmin(nbdim),indmax(nbdim)
	1775	C
	1776	Call Agrif_Interp_3D_recursive(TypeInterp(1:3),
	1777	& tabin(indmin(nbdim-3):indmax(nbdim-3),
	1778	& indmin(nbdim-2):indmax(nbdim-2),
	1779	& indmin(nbdim-1):indmax(nbdim-1),l),
	1780	& tabtemp(pttab_child(nbdim-3):petab_child(nbdim-3),
	1781	& pttab_child(nbdim-2):petab_child(nbdim-2),
	1782	& pttab_child(nbdim-1):petab_child(nbdim-1),l),
	1783	& indmin(1:nbdim-1),indmax(1:nbdim-1),
	1784	& pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
	1785	& s_child(1:nbdim-1),s_parent(1:nbdim-1),
	1786	& ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
	1787	C
	1788	enddo
	1789	C
[662]	1790	coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
	1791
[396]	1792	do k = pttab_child(nbdim-1),petab_child(nbdim-1)
	1793	C
	1794	do j = pttab_child(nbdim-2),petab_child(nbdim-2)
	1795	C
	1796	do i = pttab_child(nbdim-3),petab_child(nbdim-3)
	1797	C
	1798	Call Agrif_InterpBase(TypeInterp(4),
	1799	& tabtemp(i,j,k,indmin(nbdim):indmax(nbdim)),
	1800	& tabout(i,j,k,pttab_child(nbdim):petab_child(nbdim)),
	1801	& indmin(nbdim),indmax(nbdim),
	1802	& pttab_child(nbdim),petab_child(nbdim),
	1803	& s_parent(nbdim),s_child(nbdim),
[662]	1804	& ds_parent(nbdim),ds_child(nbdim),coeffraf)
[396]	1805	C
	1806	enddo
	1807	C
	1808	enddo
	1809	C
	1810	enddo
	1811	C
	1812	Return
	1813	C
	1814	C
	1815	End Subroutine Agrif_Interp_4D_recursive
	1816	C
	1817	C
	1818	C
	1819	C **************************************************************************
	1820	CCC Subroutine Agrif_Interp_5D_Recursive
	1821	C **************************************************************************
	1822	C
	1823	Subroutine Agrif_Interp_5D_recursive(TypeInterp,tabin,tabout,
	1824	& indmin,indmax,
	1825	& pttab_child,petab_child,
	1826	& s_child,s_parent,ds_child,ds_parent,nbdim)
	1827	C
	1828	CCC Description:
	1829	CCC Subroutine for the interpolation of a 5D grid variable.
	1830	CCC It calls Agrif_Interp_4D_recursive and Agrif_InterpBase.
	1831	C
	1832	C Declarations:
	1833	C
	1834
	1835	C
	1836	INTEGER :: nbdim
	1837	INTEGER,DIMENSION(5) :: TypeInterp
	1838	INTEGER, DIMENSION(nbdim) :: indmin,indmax
	1839	INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
	1840	REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
[662]	1841	REAL,INTENT(IN), DIMENSION(indmin(nbdim-4):indmax(nbdim-4),
[396]	1842	& indmin(nbdim-3):indmax(nbdim-3),
	1843	& indmin(nbdim-2):indmax(nbdim-2),
	1844	& indmin(nbdim-1):indmax(nbdim-1),
	1845	& indmin(nbdim):indmax(nbdim)) :: tabin
[662]	1846	REAL,INTENT(OUT),
	1847	& DIMENSION(pttab_child(nbdim-4):petab_child(nbdim-4),
[396]	1848	& pttab_child(nbdim-3):petab_child(nbdim-3),
	1849	& pttab_child(nbdim-2):petab_child(nbdim-2),
	1850	& pttab_child(nbdim-1):petab_child(nbdim-1),
	1851	& pttab_child(nbdim):petab_child(nbdim)) :: tabout
	1852	C
	1853	C Local variables
[662]	1854	REAL, DIMENSION(pttab_child(nbdim-4):petab_child(nbdim-4),
[396]	1855	& pttab_child(nbdim-3):petab_child(nbdim-3),
	1856	& pttab_child(nbdim-2):petab_child(nbdim-2),
	1857	& pttab_child(nbdim-1):petab_child(nbdim-1),
[662]	1858	& indmin(nbdim):indmax(nbdim)) :: tabtemp
	1859	INTEGER i,j,k,l,m
	1860	INTEGER :: coeffraf
[396]	1861	C
[662]	1862	C
[396]	1863	do m = indmin(nbdim),indmax(nbdim)
	1864	C
	1865	Call Agrif_Interp_4D_recursive(TypeInterp(1:4),
	1866	& tabin(indmin(nbdim-4):indmax(nbdim-4),
	1867	& indmin(nbdim-3):indmax(nbdim-3),
	1868	& indmin(nbdim-2):indmax(nbdim-2),
	1869	& indmin(nbdim-1):indmax(nbdim-1),m),
	1870	& tabtemp(pttab_child(nbdim-4):petab_child(nbdim-4),
	1871	& pttab_child(nbdim-3):petab_child(nbdim-3),
	1872	& pttab_child(nbdim-2):petab_child(nbdim-2),
	1873	& pttab_child(nbdim-1):petab_child(nbdim-1),m),
	1874	& indmin(1:nbdim-1),indmax(1:nbdim-1),
	1875	& pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
	1876	& s_child(1:nbdim-1),s_parent(1:nbdim-1),
	1877	& ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
	1878	C
	1879	enddo
[662]	1880
	1881	coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
[396]	1882	C
	1883	do l = pttab_child(nbdim-1),petab_child(nbdim-1)
	1884	C
	1885	do k = pttab_child(nbdim-2),petab_child(nbdim-2)
	1886	C
	1887	do j = pttab_child(nbdim-3),petab_child(nbdim-3)
	1888	C
	1889	do i = pttab_child(nbdim-4),petab_child(nbdim-4)
	1890	C
	1891	Call Agrif_InterpBase(TypeInterp(5),
	1892	& tabtemp(i,j,k,l,indmin(nbdim):indmax(nbdim)),
	1893	& tabout(i,j,k,l,
	1894	& pttab_child(nbdim):petab_child(nbdim)),
	1895	& indmin(nbdim),indmax(nbdim),
	1896	& pttab_child(nbdim),petab_child(nbdim),
	1897	& s_parent(nbdim),s_child(nbdim),
[662]	1898	& ds_parent(nbdim),ds_child(nbdim),coeffraf)
[396]	1899	C
	1900	enddo
	1901	C
	1902	enddo
	1903	C
	1904	enddo
	1905	C
	1906	enddo
	1907	C
[662]	1908	C
[396]	1909	Return
	1910	C
	1911	C
	1912	End Subroutine Agrif_Interp_5D_recursive
	1913	C
	1914	C
	1915	C
	1916	C **************************************************************************
	1917	CCC Subroutine Agrif_Interp_6D_Recursive
	1918	C **************************************************************************
	1919	C
	1920	Subroutine Agrif_Interp_6D_recursive(TypeInterp,tabin,tabout,
	1921	& indmin,indmax,
	1922	& pttab_child,petab_child,
	1923	& s_child,s_parent,ds_child,ds_parent,nbdim)
	1924	C
	1925	CCC Description:
	1926	CCC Subroutine for the interpolation of a 6D grid variable.
	1927	CCC It calls Agrif_Interp_4D_recursive and Agrif_InterpBase.
	1928	C
	1929	C Declarations:
	1930	C
	1931
	1932	C
	1933	INTEGER :: nbdim
	1934	INTEGER,DIMENSION(6) :: TypeInterp
	1935	INTEGER, DIMENSION(nbdim) :: indmin,indmax
	1936	INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
	1937	REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
[662]	1938	REAL,INTENT(IN), DIMENSION(indmin(nbdim-5):indmax(nbdim-5),
[396]	1939	& indmin(nbdim-4):indmax(nbdim-4),
	1940	& indmin(nbdim-3):indmax(nbdim-3),
	1941	& indmin(nbdim-2):indmax(nbdim-2),
	1942	& indmin(nbdim-1):indmax(nbdim-1),
	1943	& indmin(nbdim):indmax(nbdim)) :: tabin
[662]	1944	REAL,INTENT(OUT),
	1945	& DIMENSION(pttab_child(nbdim-5):petab_child(nbdim-5),
[396]	1946	& pttab_child(nbdim-4):petab_child(nbdim-4),
	1947	& pttab_child(nbdim-3):petab_child(nbdim-3),
	1948	& pttab_child(nbdim-2):petab_child(nbdim-2),
	1949	& pttab_child(nbdim-1):petab_child(nbdim-1),
	1950	& pttab_child(nbdim):petab_child(nbdim)) :: tabout
	1951	C
	1952	C Local variables
[662]	1953	REAL, DIMENSION(pttab_child(nbdim-5):petab_child(nbdim-5),
[396]	1954	& pttab_child(nbdim-4):petab_child(nbdim-4),
	1955	& pttab_child(nbdim-3):petab_child(nbdim-3),
	1956	& pttab_child(nbdim-2):petab_child(nbdim-2),
	1957	& pttab_child(nbdim-1):petab_child(nbdim-1),
[662]	1958	& indmin(nbdim):indmax(nbdim)) :: tabtemp
	1959	INTEGER i,j,k,l,m,n
	1960	INTEGER :: coeffraf
[396]	1961	C
[662]	1962	C
	1963	C
[396]	1964	do n = indmin(nbdim),indmax(nbdim)
	1965	C
	1966	Call Agrif_Interp_5D_recursive(TypeInterp(1:5),
	1967	& tabin(indmin(nbdim-5):indmax(nbdim-5),
	1968	& indmin(nbdim-4):indmax(nbdim-4),
	1969	& indmin(nbdim-3):indmax(nbdim-3),
	1970	& indmin(nbdim-2):indmax(nbdim-2),
	1971	& indmin(nbdim-1):indmax(nbdim-1),n),
	1972	& tabtemp(pttab_child(nbdim-5):petab_child(nbdim-5),
	1973	& pttab_child(nbdim-4):petab_child(nbdim-4),
	1974	& pttab_child(nbdim-3):petab_child(nbdim-3),
	1975	& pttab_child(nbdim-2):petab_child(nbdim-2),
	1976	& pttab_child(nbdim-1):petab_child(nbdim-1),n),
	1977	& indmin(1:nbdim-1),indmax(1:nbdim-1),
	1978	& pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
	1979	& s_child(1:nbdim-1),s_parent(1:nbdim-1),
	1980	& ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
	1981	C
	1982	enddo
[662]	1983
	1984	coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
[396]	1985	C
	1986	do m = pttab_child(nbdim-1),petab_child(nbdim-1)
	1987	do l = pttab_child(nbdim-2),petab_child(nbdim-2)
	1988	C
	1989	do k = pttab_child(nbdim-3),petab_child(nbdim-3)
	1990	C
	1991	do j = pttab_child(nbdim-4),petab_child(nbdim-4)
	1992	C
	1993	do i = pttab_child(nbdim-5),petab_child(nbdim-5)
	1994	C
	1995	Call Agrif_InterpBase(TypeInterp(6),
	1996	& tabtemp(i,j,k,l,m,indmin(nbdim):indmax(nbdim)),
	1997	& tabout(i,j,k,l,m,
	1998	& pttab_child(nbdim):petab_child(nbdim)),
	1999	& indmin(nbdim),indmax(nbdim),
	2000	& pttab_child(nbdim),petab_child(nbdim),
	2001	& s_parent(nbdim),s_child(nbdim),
[662]	2002	& ds_parent(nbdim),ds_child(nbdim),coeffraf)
[396]	2003	C
	2004	enddo
	2005	C
	2006	enddo
	2007	C
	2008	enddo
	2009	C
	2010	enddo
	2011	enddo
	2012	C
	2013	C
	2014	Return
	2015	C
	2016	C
	2017	End Subroutine Agrif_Interp_6D_recursive
	2018	C
	2019	C
	2020	C
	2021	C **************************************************************************
	2022	CCC Subroutine Agrif_InterpBase
	2023	C **************************************************************************
	2024	C
	2025	Subroutine Agrif_InterpBase(TypeInterp,
	2026	& parenttab,childtab,
	2027	& indmin,indmax,pttab_child,petab_child,
[662]	2028	& s_parent,s_child,ds_parent,ds_child,
	2029	& coeffraf)
[396]	2030	C
	2031	CCC Description:
	2032	CCC Subroutine calling the interpolation method chosen by the user (linear,
	2033	CCC lagrange or spline).
	2034	C
	2035	C Declarations:
	2036	C
	2037
	2038	C
	2039	INTEGER :: TypeInterp
	2040	INTEGER :: indmin,indmax
	2041	INTEGER :: pttab_child,petab_child
[662]	2042	REAL,INTENT(IN),DIMENSION(indmin:indmax) :: parenttab
	2043	REAL,INTENT(OUT),DIMENSION(pttab_child:petab_child) :: childtab
[396]	2044	REAL :: s_parent,s_child,ds_parent,ds_child
[662]	2045	INTEGER :: coeffraf
[396]	2046	C
	2047	C
	2048	IF ((indmin == indmax).AND.(pttab_child == petab_child)) THEN
	2049	childtab(pttab_child) = parenttab(indmin)
	2050	ELSEIF (TYPEinterp .EQ. AGRIF_LINEAR) then
	2051	C
[779]	2052	C Linear interpolation
	2053
[396]	2054	Call linear1D
	2055	& (parenttab,childtab,
	2056	& indmax-indmin+1,petab_child-pttab_child+1,
	2057	& s_parent,s_child,ds_parent,ds_child)
	2058	C
[779]	2059	elseif ( TYPEinterp .EQ. AGRIF_PPM ) then
	2060
	2061	Call ppm1D
	2062	& (parenttab,childtab,
	2063	& indmax-indmin+1,petab_child-pttab_child+1,
	2064	& s_parent,s_child,ds_parent,ds_child)
	2065	C
	2066
[396]	2067	elseif (TYPEinterp .EQ. AGRIF_LAGRANGE) then
	2068	C
	2069	C Lagrange interpolation
	2070	Call lagrange1D
	2071	& (parenttab,childtab,
	2072	& indmax-indmin+1,petab_child-pttab_child+1,
	2073	& s_parent,s_child,ds_parent,ds_child)
	2074	C
	2075	elseif (TYPEinterp .EQ. AGRIF_ENO) then
	2076	C
	2077	C Eno interpolation
	2078	Call eno1D
	2079	& (parenttab,childtab,
	2080	& indmax-indmin+1,petab_child-pttab_child+1,
	2081	& s_parent,s_child,ds_parent,ds_child)
[662]	2082	C
	2083	elseif (TYPEinterp .EQ. AGRIF_WENO) then
	2084	C
	2085	C Eno interpolation
	2086	Call weno1D
	2087	& (parenttab,childtab,
	2088	& indmax-indmin+1,petab_child-pttab_child+1,
	2089	& s_parent,s_child,ds_parent,ds_child)
	2090	C
[396]	2091	Else if (TYPEinterp .EQ. AGRIF_LINEARCONSERV) then
	2092	C
	2093	C Linear conservative interpolation
	2094
	2095	Call linear1Dconserv
	2096	& (parenttab,childtab,
	2097	& indmax-indmin+1,petab_child-pttab_child+1,
	2098	& s_parent,s_child,ds_parent,ds_child)
	2099	C
	2100	Else if (TYPEinterp .EQ. AGRIF_LINEARCONSERVLIM) then
	2101	C
	2102	C Linear conservative interpolation
	2103
	2104	Call linear1Dconservlim
	2105	& (parenttab,childtab,
	2106	& indmax-indmin+1,petab_child-pttab_child+1,
	2107	& s_parent,s_child,ds_parent,ds_child)
	2108	C
	2109	elseif (TYPEinterp .EQ. AGRIF_CONSTANT) then
	2110	C
	2111	Call constant1D
	2112	& (parenttab,childtab,
	2113	& indmax-indmin+1,petab_child-pttab_child+1,
	2114	& s_parent,s_child,ds_parent,ds_child)
	2115	C
	2116	endif
	2117	C
	2118	C
	2119	End Subroutine Agrif_InterpBase
	2120	C
	2121
[662]	2122	Subroutine Agrif_Compute_nbdim_interp(s_parent,s_child,
	2123	& ds_parent,ds_child,coeffraf,locind_child_left)
	2124	real :: s_parent,s_child,ds_parent,ds_child
	2125	integer :: coeffraf,locind_child_left
	2126
	2127	coeffraf = nint(ds_parent/ds_child)
	2128	locind_child_left = 1 + agrif_int((s_child-s_parent)/ds_parent)
	2129	End Subroutine Agrif_Compute_nbdim_interp
	2130	C
[396]	2131
[662]	2132	Subroutine Agrif_Find_list_interp(list_interp,pttab,petab,
	2133	& pttab_Child,pttab_Parent,nbdim,
	2134	& indmin,indmax,indminglob,
	2135	& indmaxglob,indminglob2,indmaxglob2,parentarray,
	2136	& pttruetab,cetruetab,member,memberin,
	2137	& find_list_interp
	2138	#if defined AGRIF_MPI
[898]	2139	& ,tab4t,memberinall,sendtoproc1,recvfromproc1
[662]	2140	#endif
	2141	& )
	2142	TYPE(Agrif_List_Interp_Loc), Pointer :: list_interp
	2143	INTEGER :: nbdim
	2144	INTEGER,DIMENSION(nbdim) :: pttab,petab,pttab_Child,pttab_Parent
	2145	LOGICAL :: find_list_interp
	2146	Type(Agrif_List_Interp_loc), Pointer :: parcours
	2147	INTEGER,DIMENSION(nbdim) :: indmin,indmax
	2148	INTEGER,DIMENSION(nbdim) :: indminglob,indmaxglob
	2149	INTEGER,DIMENSION(nbdim) :: pttruetab,cetruetab
	2150	INTEGER,DIMENSION(nbdim) :: indminglob2,indmaxglob2
	2151	INTEGER,DIMENSION(nbdim,2,2) :: parentarray
	2152	LOGICAL :: member, memberin
	2153	INTEGER :: i
	2154	#ifdef AGRIF_MPI
	2155	C
[898]	2156	INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
[662]	2157	LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall
[898]	2158	LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1
[662]	2159	#endif
	2160
	2161	find_list_interp = .FALSE.
	2162
	2163	parcours => list_interp
	2164	Find_loop : Do While (associated(parcours))
	2165	Do i=1,nbdim
	2166	IF ((pttab(i) /= parcours%interp_loc%pttab(i)).OR.
	2167	& (petab(i) /= parcours%interp_loc%petab(i)).OR.
	2168	& (pttab_child(i) /= parcours%interp_loc%pttab_child(i)).OR.
	2169	& (pttab_parent(i) /= parcours%interp_loc%pttab_parent(i)))
	2170	& THEN
	2171	parcours=>parcours%suiv
	2172	Cycle Find_loop
	2173	ENDIF
	2174	EndDo
[1200]	2175
[662]	2176	indmin = parcours%interp_loc%indmin(1:nbdim)
	2177	indmax = parcours%interp_loc%indmax(1:nbdim)
	2178
	2179	pttruetab = parcours%interp_loc%pttruetab(1:nbdim)
	2180	cetruetab = parcours%interp_loc%cetruetab(1:nbdim)
	2181
	2182	#if !defined AGRIF_MPI
	2183	indminglob = parcours%interp_loc%indminglob(1:nbdim)
	2184	indmaxglob = parcours%interp_loc%indmaxglob(1:nbdim)
	2185	#else
	2186	indminglob2 = parcours%interp_loc%indminglob2(1:nbdim)
	2187	indmaxglob2 = parcours%interp_loc%indmaxglob2(1:nbdim)
	2188	parentarray = parcours%interp_loc%parentarray(1:nbdim,:,:)
	2189	member = parcours%interp_loc%member
[898]	2190	tab4t = parcours%interp_loc%tab4t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
[662]	2191	memberinall = parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1)
[898]	2192	sendtoproc1 = parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1)
	2193	recvfromproc1 =
	2194	& parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1)
[662]	2195	#endif
	2196	memberin = parcours%interp_loc%memberin
	2197	find_list_interp = .TRUE.
	2198	Exit Find_loop
	2199	End Do Find_loop
	2200
	2201	End Subroutine Agrif_Find_list_interp
	2202
	2203	Subroutine Agrif_AddTo_list_interp(list_interp,pttab,petab,
	2204	& pttab_Child,pttab_Parent,indmin,indmax,
	2205	& indminglob,indmaxglob,
	2206	& indminglob2,indmaxglob2,
	2207	& parentarray,pttruetab,cetruetab,
	2208	& member,memberin,nbdim
	2209	#if defined AGRIF_MPI
[898]	2210	& ,tab4t,memberinall,sendtoproc1,recvfromproc1
[662]	2211	#endif
	2212	& )
	2213
	2214	TYPE(Agrif_List_Interp_Loc), Pointer :: list_interp
	2215	INTEGER :: nbdim
	2216	INTEGER,DIMENSION(nbdim) :: pttab,petab,pttab_Child,pttab_Parent
	2217	INTEGER,DIMENSION(nbdim) :: indmin,indmax
	2218	INTEGER,DIMENSION(nbdim) :: indminglob,indmaxglob
	2219	INTEGER,DIMENSION(nbdim) :: indminglob2,indmaxglob2
	2220	INTEGER,DIMENSION(nbdim) :: pttruetab,cetruetab
	2221	INTEGER,DIMENSION(nbdim,2,2) :: parentarray
	2222	LOGICAL :: member, memberin
	2223	#ifdef AGRIF_MPI
	2224	C
[898]	2225	INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
[662]	2226	LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: memberinall
[898]	2227	LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1
	2228	LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: recvfromproc1
[662]	2229	#endif
	2230	Type(Agrif_List_Interp_loc), Pointer :: parcours
	2231
	2232	Allocate(parcours)
	2233	Allocate(parcours%interp_loc)
	2234
	2235	parcours%interp_loc%pttab(1:nbdim) = pttab(1:nbdim)
	2236	parcours%interp_loc%petab(1:nbdim) = petab(1:nbdim)
	2237	parcours%interp_loc%pttab_child(1:nbdim) = pttab_child(1:nbdim)
	2238	parcours%interp_loc%pttab_parent(1:nbdim) = pttab_parent(1:nbdim)
	2239
	2240
	2241	parcours%interp_loc%indmin(1:nbdim) = indmin(1:nbdim)
	2242	parcours%interp_loc%indmax(1:nbdim) = indmax(1:nbdim)
	2243
	2244	parcours%interp_loc%memberin = memberin
	2245	#if !defined AGRIF_MPI
	2246	parcours%interp_loc%indminglob(1:nbdim) = indminglob(1:nbdim)
	2247	parcours%interp_loc%indmaxglob(1:nbdim) = indmaxglob(1:nbdim)
	2248	#else
	2249	parcours%interp_loc%indminglob2(1:nbdim) = indminglob2(1:nbdim)
	2250	parcours%interp_loc%indmaxglob2(1:nbdim) = indmaxglob2(1:nbdim)
	2251	parcours%interp_loc%parentarray(1:nbdim,:,:)
	2252	& = parentarray(1:nbdim,:,:)
	2253	parcours%interp_loc%member = member
[898]	2254	Allocate(parcours%interp_loc%tab4t(nbdim,0:Agrif_Nbprocs-1,8))
[662]	2255	Allocate(parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1))
[898]	2256	Allocate(parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1))
	2257	Allocate(parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1))
[662]	2258	parcours%interp_loc%tab4t=tab4t
	2259	parcours%interp_loc%memberinall=memberinall
[898]	2260	parcours%interp_loc%sendtoproc1=sendtoproc1
	2261	parcours%interp_loc%recvfromproc1=recvfromproc1
[662]	2262	#endif
	2263
	2264	parcours%interp_loc%pttruetab(1:nbdim) = pttruetab(1:nbdim)
	2265	parcours%interp_loc%cetruetab(1:nbdim) = cetruetab(1:nbdim)
	2266
	2267	parcours%suiv => list_interp
	2268
	2269	list_interp => parcours
	2270	End Subroutine Agrif_Addto_list_interp
	2271
[396]	2272	End Module Agrif_Interpolation

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

Download in other formats: