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

Last change on this file since 662 was 662, checked in by opalod, 17 years ago
RB: update Agrif internal routines with a new update scheme and performance improvment
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 73.3 KB

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

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

Download in other formats: