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.

modupdate.F in trunk/AGRIF/AGRIF_FILES – NEMO

Context Navigation

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

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

Download in other formats: