Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

modupdate.f @ 2

Last change on this file since 2 was 2, checked in by pinsard, 17 years ago
initial import from official romsagrif distribution without any svn and CVS directories
File size: 70.7 KB

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

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

Context Navigation

source: trunk/AGRIFZOOM/AGRIF_YOURFILES/modupdate.f @ 2

Download in other formats: