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.
modbcfunction.F in vendors/AGRIF/current/AGRIF_FILES – NEMO

source: vendors/AGRIF/current/AGRIF_FILES/modbcfunction.F @ 1901

Last change on this file since 1901 was 1901, checked in by flavoni, 14 years ago

importing AGRIF vendor
File size: 67.9 KB
Line 
1!
2! $Id: modbcfunction.F 1200 2008-09-24 13:05:20Z rblod $
3!
4C     AGRIF (Adaptive Grid Refinement In Fortran)
5C
6C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
7C                        Christophe Vouland (Christophe.Vouland@imag.fr)   
8C
9C     This program is free software; you can redistribute it and/or modify
10C     it under the terms of the GNU General Public License as published by
11C     the Free Software Foundation; either version 2 of the License, or
12C     (at your option) any later version.
13C
14C     This program is distributed in the hope that it will be useful,
15C     but WITHOUT ANY WARRANTY; without even the implied warranty of
16C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17C     GNU General Public License for more details.
18C
19C     You should have received a copy of the GNU General Public License
20C     along with this program; if not, write to the Free Software
21C     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
22C
23C
24C
25CCC   Module AGRIF_bcfunction
26C
27C 
28      Module  Agrif_bcfunction
29CCC   Description:
30CCC   
31C
32C     Modules used:
33C 
34      Use Agrif_Boundary
35      Use Agrif_Update
36      Use Agrif_fluxmod
37C             
38      IMPLICIT NONE
39C
40      interface Agrif_Bc_variable
41          module procedure Agrif_Bc_variable0d,
42     &                     Agrif_Bc_variable1d,
43     &                     Agrif_Bc_variable2d,
44     &                     Agrif_Bc_variable3d,
45     &                     Agrif_Bc_variable4d,
46     &                     Agrif_Bc_variable5d
47      end interface       
48C
49      interface Agrif_Set_Parent
50          module procedure Agrif_Set_Parent_int,
51     &                     Agrif_Set_Parent_real
52      end interface       
53C
54      interface Agrif_Interp_variable
55          module procedure Agrif_Interp_var0d,
56     &                     Agrif_Interp_var1d,
57     &                     Agrif_Interp_var2d,
58     &                     Agrif_Interp_var3d,
59     &                     Agrif_Interp_var4d,
60     &                     Agrif_Interp_var5d
61      end interface       
62C
63      interface Agrif_Init_variable
64          module procedure Agrif_Init_variable0d,
65     &                     Agrif_Init_variable1d,
66     &                     Agrif_Init_variable2d,
67     &                     Agrif_Init_variable3d
68      end interface       
69C
70      interface Agrif_update_variable
71          module procedure Agrif_update_var0d,
72     &                     Agrif_update_var1d,
73     &                     Agrif_update_var2d,
74     &                     Agrif_update_var3d,
75     &                     Agrif_update_var4d,
76     &                     Agrif_update_var5d
77      end interface       
78C
79      Contains
80C
81C     **************************************************************************
82CCC   Subroutine Agrif_Set_type
83C     **************************************************************************
84C 
85      Subroutine Agrif_Set_type(tabvarsindic,posvar,point)
86C
87CCC   Description:
88CCC   To set the TYPE of the variable.
89C
90C     Modules used:
91C     
92
93C
94C     Declarations:
95C     
96C
97C
98C     Arguments     
99C
100      INTEGER, DIMENSION(:) :: posvar
101      INTEGER, DIMENSION(:) :: point
102C
103      INTEGER :: tabvarsindic ! indice of the variable in tabvars
104      INTEGER :: dimensio ! DIMENSION of the variable
105      INTEGER :: i
106C
107C
108C     Begin 
109C
110      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim
111C
112      if (.not.associated(Agrif_Mygrid % tabvars(tabvarsindic)
113     &                                 %var % posvar)) then
114      Allocate( 
115     & Agrif_Mygrid % tabvars(tabvarsindic)%var % posvar(dimensio))
116      endif
117           
118      do i = 1 , dimensio
119         Agrif_Mygrid % tabvars(tabvarsindic) %var % posvar(i)
120     &                       = posvar(i)
121         Agrif_Mygrid % tabvars(tabvarsindic) %var % point(i) 
122     &                       = point(i)
123      enddo
124C
125C
126      End Subroutine Agrif_Set_type
127C
128C
129C     **************************************************************************
130CCC   Subroutine Agrif_Set_parent_int
131C     **************************************************************************
132C 
133      Subroutine Agrif_Set_parent_int(tabvarsindic,value)
134C
135CCC   Description:
136CCC   To set the TYPE of the variable.
137C
138C     Modules used:
139C     
140
141C
142C     Declarations:
143C     
144C
145C
146C     Arguments     
147C
148      INTEGER :: tabvarsindic ! indice of the variable in tabvars
149      INTEGER :: Value
150C
151C     Begin 
152C
153      Agrif_Curgrid % parent % tabvars(tabvarsindic) % 
154     &         var % iarray0 = value
155C
156C
157      End Subroutine Agrif_Set_parent_int
158C
159C
160C     **************************************************************************
161CCC   Subroutine Agrif_Set_parent_real
162C     **************************************************************************
163C 
164      Subroutine Agrif_Set_parent_real(tabvarsindic,value)
165C
166CCC   Description:
167CCC   To set the TYPE of the variable.
168C
169C     Modules used:
170C     
171
172C
173C     Declarations:
174C     
175C
176C
177C     Arguments     
178C
179      INTEGER :: tabvarsindic ! indice of the variable in tabvars
180      REAL :: Value
181C
182C     Begin 
183C
184      Agrif_Curgrid % parent % tabvars(tabvarsindic) % 
185     &          var % array0 = value
186C
187C
188      End Subroutine Agrif_Set_parent_real
189C
190C
191C
192C     **************************************************************************
193CCC   Subroutine Agrif_Set_raf
194C     **************************************************************************
195C 
196      Subroutine Agrif_Set_raf(tabvarsindic,tabraf)
197C
198CCC   Description:
199CCC   Attention tabraf est de taille trois si on ne raffine pas suivant z la
200CCC             troisieme entree du tableau tabraf est 'N'
201C
202C     Modules used:
203C     
204
205C
206C     Declarations:
207C     
208C     Arguments     
209C
210      CHARACTER(*) ,DIMENSION(:) :: tabraf
211C
212      INTEGER :: tabvarsindic ! indice of the variable in tabvars
213      INTEGER :: dimensio ! DIMENSION of the variable
214      INTEGER :: i
215C
216C
217C     Begin 
218C
219      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim
220C       
221      if (.not.associated(Agrif_Mygrid % tabvars(tabvarsindic)
222     &                                 %var % interptab)) then
223      Allocate(
224     & Agrif_Mygrid % tabvars(tabvarsindic)%var% interptab(dimensio))
225      endif
226
227      do i = 1 , dimensio
228         Agrif_Mygrid % tabvars(tabvarsindic) %var % interptab(i) 
229     &                 = TRIM(tabraf(i))
230      enddo
231C
232      End Subroutine Agrif_Set_raf
233C
234C
235C
236C     **************************************************************************
237CCC   Subroutine Agrif_Set_bc
238C     **************************************************************************
239C 
240      Subroutine Agrif_Set_bc(tabvarsindic,point,
241     &          Interpolationshouldbemade)
242C
243CCC   Description:
244CCC
245C
246C     Modules used:
247C     
248
249C
250C     Declarations:
251C     
252C     Arguments     
253C
254      INTEGER, DIMENSION(2) :: point
255      LOGICAL, OPTIONAL :: Interpolationshouldbemade
256C
257      INTEGER :: tabvarsindic ! indice of the variable in tabvars
258      TYPE(Agrif_PVariable),Pointer ::tabvars
259     
260   
261C
262C
263C     Begin 
264C
265C     
266
267      if (tabvarsindic <=0) then
268      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-tabvarsindic)
269      else
270      tabvars=>Agrif_Curgrid % tabvars(tabvarsindic)
271      endif 
272     
273      if (Agrif_Curgrid % fixedrank .NE. 0) then 
274       IF (.Not.Associated(tabvars%var% interpIndex)) THEN
275        Allocate(tabvars%var % interpIndex)
276          tabvars%var % interpIndex = -1
277
278        Allocate(tabvars%var % oldvalues2D(2,1))
279          tabvars%var % oldvalues2D = 0. 
280       ENDIF     
281       if ( PRESENT(Interpolationshouldbemade) ) then
282         tabvars%var %
283     &     Interpolationshouldbemade = Interpolationshouldbemade
284       endif
285
286      endif
287C
288      tabvars%var % bcinf = point(1)
289      tabvars%var % bcsup = point(2)
290C
291      End Subroutine Agrif_Set_bc
292C
293C
294C     **************************************************************************
295CCC   Subroutine Agrif_Set_interp
296C     **************************************************************************
297C 
298      Subroutine Agrif_Set_interp(tabvarsindic,interp,interp1,interp2,
299     &                interp3)
300C
301CCC   Description:
302C
303C     Declarations:
304C     
305C     Arguments     
306C
307      INTEGER, OPTIONAL      :: interp,interp1,interp2,interp3
308C
309      INTEGER :: tabvarsindic ! indice of the variable in tabvars
310C
311C     Begin 
312C
313      Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp = 
314     &    Agrif_Constant
315      IF (present(interp)) THEN
316      Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp = 
317     &           interp
318      ENDIF
319      IF (present(interp1)) THEN
320      Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp(1) = 
321     &           interp1
322      ENDIF
323      IF (present(interp2)) THEN
324      Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp(2) = 
325     &           interp2
326      ENDIF
327      IF (present(interp3)) THEN
328      Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp(3) = 
329     &           interp3
330      ENDIF
331C
332      End Subroutine Agrif_Set_interp
333C
334C     **************************************************************************
335CCC   Subroutine Agrif_Set_bcinterp
336C     **************************************************************************
337C 
338      Subroutine Agrif_Set_bcinterp(tabvarsindic,interp,interp1,
339     &      interp2,interp3,interp11,interp12,interp21,interp22)
340C
341CCC   Description:
342
343C
344C     Modules used:
345C     
346
347C
348C     Declarations:
349C     
350C     Arguments     
351C
352      INTEGER, OPTIONAL      :: interp,interp1,interp2,interp3
353      INTEGER, OPTIONAL      :: interp11,interp12,interp21,interp22
354C
355      INTEGER :: tabvarsindic ! indice of the variable in tabvars
356      TYPE(Agrif_PVariable),Pointer ::tabvars
357     
358   
359C
360C
361C     Begin 
362C
363C     
364
365      if (tabvarsindic <=0) then
366      tabvars => Agrif_Search_Variable(Agrif_Mygrid,-tabvarsindic)
367      else
368      tabvars=>Agrif_Mygrid % tabvars(tabvarsindic)
369      endif
370C
371      tabvars% var % bctypeinterp = 
372     &           Agrif_Constant   
373      IF (present(interp)) THEN
374      tabvars% var % bctypeinterp = 
375     &           interp
376      ENDIF       
377      IF (present(interp1)) THEN
378      tabvars% var % bctypeinterp(1:2,1) = 
379     &           interp1
380      ENDIF       
381      IF (present(interp11)) THEN
382      tabvars% var % bctypeinterp(1,1) = 
383     &           interp11
384      ENDIF
385      IF (present(interp12)) THEN
386      tabvars% var % bctypeinterp(1,2) = 
387     &           interp12
388      ENDIF         
389      IF (present(interp2)) THEN
390      tabvars% var % bctypeinterp(1:2,2) = 
391     &           interp2
392      ENDIF
393      IF (present(interp21)) THEN
394      tabvars% var % bctypeinterp(2,1) = 
395     &           interp21
396      ENDIF     
397      IF (present(interp22)) THEN
398      tabvars% var % bctypeinterp(2,2) = 
399     &           interp22
400      ENDIF           
401      IF (present(interp3)) THEN
402      tabvars% var % bctypeinterp(1:2,3) =
403     &           interp3
404      ENDIF
405C
406      End Subroutine Agrif_Set_bcinterp
407C
408C
409C     **************************************************************************
410CCC   Subroutine Agrif_Set_Update
411C     **************************************************************************
412C 
413      Subroutine Agrif_Set_Update(tabvarsindic,point)
414C
415CCC   Description:
416CCC
417C
418C     Modules used:
419C     
420
421C
422C     Declarations:
423C     
424C     Arguments     
425C
426      INTEGER, DIMENSION(2) :: point
427C
428      INTEGER :: tabvarsindic ! indice of the variable in tabvars
429C
430C
431C     Begin 
432C
433      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = point(1)
434      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = point(2)
435C
436      End Subroutine Agrif_Set_Update
437C
438C
439C
440C     **************************************************************************
441CCC   Subroutine Agrif_Set_UpdateType
442C     **************************************************************************
443C 
444      Subroutine Agrif_Set_UpdateType(tabvarsindic,
445     &                                  update,update1,update2,
446     &                                  update3,update4,update5)
447C
448CCC   Description:
449
450C
451C     Modules used:
452C     
453
454C
455C     Declarations:
456C     
457C     Arguments     
458C
459      INTEGER, OPTIONAL           :: update, update1,
460     &       update2, update3,update4,update5
461C
462      INTEGER :: tabvarsindic ! indice of the variable in tabvars
463C
464C
465C     Begin 
466C
467      Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate = 
468     &                   Agrif_Update_Copy
469     
470      IF (present(update)) THEN
471        Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate = 
472     &           update
473      ENDIF
474      IF (present(update1)) THEN
475        Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(1) = 
476     &           update1
477      ENDIF 
478      IF (present(update2)) THEN
479        Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(2) = 
480     &           update2
481      ENDIF 
482      IF (present(update3)) THEN
483        Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(3) = 
484     &           update3
485      ENDIF
486      IF (present(update4)) THEN
487        Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(4) = 
488     &           update4
489      ENDIF       
490      IF (present(update5)) THEN
491        Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(5) = 
492     &           update5
493      ENDIF                 
494C
495      End Subroutine Agrif_Set_UpdateType           
496C
497C
498C     **************************************************************************
499CCC   Subroutine Agrif_Set_restore
500C     **************************************************************************
501C 
502      Subroutine Agrif_Set_restore(tabvarsindic)
503C
504CCC   Description:
505CCC   
506C
507C     Modules used:
508C     
509
510C
511C     Declarations:
512C     
513C     Arguments     
514C
515      INTEGER :: tabvarsindic ! indice of the variable in tabvars
516C
517C     Begin 
518C
519C
520      Agrif_Mygrid%tabvars(tabvarsindic)%var % restaure = .TRUE.
521C
522      End Subroutine Agrif_Set_restore
523C
524C
525C     **************************************************************************
526CCC   Subroutine Agrif_Init_variable0d
527C     **************************************************************************
528      Subroutine Agrif_Init_variable0d(tabvarsindic0,tabvarsindic,
529     &        procname)
530
531      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
532      INTEGER :: tabvarsindic ! indice of the variable in tabvars
533      External :: procname
534      Optional ::  procname
535C
536      if (Agrif_Root()) Return
537C     
538      if (present(procname)) then
539      CALL Agrif_Interp_variable(tabvarsindic0,tabvarsindic,procname)
540      CALL Agrif_Bc_variable(tabvarsindic0,tabvarsindic,1.,procname)
541      else
542      CALL Agrif_Interp_variable(tabvarsindic0,tabvarsindic)
543      CALL Agrif_Bc_variable(tabvarsindic0,tabvarsindic,1.)
544      endif
545
546      End Subroutine Agrif_Init_variable0d
547C
548C
549C     **************************************************************************
550CCC   Subroutine Agrif_Init_variable1d
551C     **************************************************************************
552      Subroutine Agrif_Init_variable1d(q,tabvarsindic,procname)
553
554      REAL, DIMENSION(:) :: q
555      INTEGER :: tabvarsindic ! indice of the variable in tabvars
556      External :: procname
557      Optional ::  procname
558
559C
560      if (Agrif_Root()) Return
561C
562      if (present(procname)) then
563      CALL Agrif_Interp_variable(q,tabvarsindic,procname)
564      CALL Agrif_Bc_variable(q,tabvarsindic,1.,procname)
565      else
566      CALL Agrif_Interp_variable(q,tabvarsindic)
567      CALL Agrif_Bc_variable(q,tabvarsindic,1.)
568      endif
569
570      End Subroutine Agrif_Init_variable1d
571C
572C     **************************************************************************
573CCC   Subroutine Agrif_Init_variable2d
574C     **************************************************************************
575      Subroutine Agrif_Init_variable2d(q,tabvarsindic,procname)
576
577      REAL,  DIMENSION(:,:) :: q
578      INTEGER :: tabvarsindic ! indice of the variable in tabvars
579      External :: procname
580      Optional ::  procname
581
582C
583      if (Agrif_Root()) Return
584C
585      if (present(procname)) then
586      CALL Agrif_Interp_variable(q,tabvarsindic,procname)
587      CALL Agrif_Bc_variable(q,tabvarsindic,1.,procname)
588      else
589      CALL Agrif_Interp_variable(q,tabvarsindic)
590      CALL Agrif_Bc_variable(q,tabvarsindic,1.)
591      endif
592
593
594      End Subroutine Agrif_Init_variable2d
595C
596C
597C     **************************************************************************
598CCC   Subroutine Agrif_Init_variable3d
599C     **************************************************************************
600      Subroutine Agrif_Init_variable3d(q,tabvarsindic,procname)
601
602      REAL,  DIMENSION(:,:,:) :: q
603      INTEGER :: tabvarsindic ! indice of the variable in tabvars
604      External :: procname
605      Optional ::  procname
606C
607      if (Agrif_Root()) Return
608C
609      if (present(procname)) then
610      CALL Agrif_Interp_variable(q,tabvarsindic,procname)
611      CALL Agrif_Bc_variable(q,tabvarsindic,1.,procname)
612      else
613      CALL Agrif_Interp_variable(q,tabvarsindic)
614      CALL Agrif_Bc_variable(q,tabvarsindic,1.)
615      endif
616
617C
618      End Subroutine Agrif_Init_variable3d
619C
620C
621C     **************************************************************************
622CCC   Subroutine Agrif_Init_variable4d
623C     **************************************************************************
624      Subroutine Agrif_Init_variable4d(q,tabvarsindic,procname)
625
626      REAL,  DIMENSION(:,:,:,:) :: q
627      INTEGER :: tabvarsindic ! indice of the variable in tabvars
628      External :: procname
629      Optional ::  procname
630C
631      if (Agrif_Root()) Return
632C
633      if (present(procname)) then
634      CALL Agrif_Interp_variable(q,tabvarsindic,procname)
635      CALL Agrif_Bc_variable(q,tabvarsindic,1.,procname)
636      else
637      CALL Agrif_Interp_variable(q,tabvarsindic)
638      CALL Agrif_Bc_variable(q,tabvarsindic,1.)
639      endif
640
641C
642      End Subroutine Agrif_Init_variable4d     
643C
644C
645C     **************************************************************************
646CCC   Subroutine Agrif_Bc_variable0d
647C     **************************************************************************
648      Subroutine Agrif_Bc_variable0d(tabvarsindic0,tabvarsindic,
649     &                               calledweight,procname)
650
651      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
652      INTEGER :: tabvarsindic ! indice of the variable in tabvars
653C       
654      External :: procname
655      Optional ::  procname
656      REAL, OPTIONAL :: calledweight
657      REAL    :: weight
658      LOGICAL :: pweight
659C
660      INTEGER :: dimensio     
661
662      if (Agrif_Root()) Return
663C
664      dimensio =  Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim   
665C
666      if ( PRESENT(calledweight) ) then
667        weight=calledweight     
668        pweight = .TRUE.
669      else
670        weight = 0.
671        pweight = .FALSE.
672      endif
673C     
674C
675
676     
677      if ( dimensio .EQ. 1 ) Call Agrif_Interp_Bc_1D(
678     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
679     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
680     & Agrif_Curgrid % tabvars(tabvarsindic),
681     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array1,
682     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
683     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
684     & weight,
685     & pweight)
686C
687      if ( dimensio .EQ. 2 ) then
688      IF (present(procname)) THEN
689      Call Agrif_Interp_Bc_2D(
690     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
691     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
692     & Agrif_Curgrid % tabvars(tabvarsindic),
693     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array2,
694     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
695     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
696     & weight,pweight,procname)
697      ELSE
698         
699      Call Agrif_Interp_Bc_2D(
700     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
701     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
702     & Agrif_Curgrid % tabvars(tabvarsindic),
703     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array2,
704     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
705     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
706     & weight,pweight)
707      ENDIF
708      endif
709C
710      if ( dimensio .EQ. 3 ) then
711      IF (present(procname)) THEN
712
713      Call Agrif_Interp_Bc_3D(
714     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
715     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
716     & Agrif_Curgrid % tabvars(tabvarsindic),
717     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array3,
718     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
719     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
720     & weight,pweight,procname)     
721      ELSE
722      Call Agrif_Interp_Bc_3D(
723     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
724     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
725     & Agrif_Curgrid % tabvars(tabvarsindic),
726     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array3,
727     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
728     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
729     & weight,pweight)
730      ENDIF
731      endif
732C
733      if ( dimensio .EQ. 4 ) then
734      IF (present(procname)) THEN
735      Call Agrif_Interp_Bc_4D(
736     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
737     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
738     & Agrif_Curgrid % tabvars(tabvarsindic),
739     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array4,     
740     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
741     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
742     & weight,pweight,procname)     
743      ELSE
744      Call Agrif_Interp_Bc_4D(
745     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
746     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
747     & Agrif_Curgrid % tabvars(tabvarsindic),
748     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array4,     
749     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
750     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
751     & weight,pweight)
752      ENDIF
753      endif
754C
755      if ( dimensio .EQ. 5 ) then
756      IF (present(procname)) THEN
757      Call Agrif_Interp_Bc_5D(
758     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
759     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
760     & Agrif_Curgrid % tabvars(tabvarsindic),
761     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array5,
762     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
763     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
764     & weight,pweight,procname)     
765      ELSE
766      Call Agrif_Interp_Bc_5D(
767     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
768     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
769     & Agrif_Curgrid % tabvars(tabvarsindic),
770     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array5,
771     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
772     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
773     & weight,pweight)
774      ENDIF
775      endif
776C
777      if ( dimensio .EQ. 6 ) Call Agrif_Interp_Bc_6D(
778     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
779     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
780     & Agrif_Curgrid % tabvars(tabvarsindic),
781     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array6,
782     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
783     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
784     & weight,
785     & pweight)
786C
787C
788      End Subroutine Agrif_Bc_variable0d
789C
790C
791C     **************************************************************************
792CCC   Subroutine Agrif_Bc_variable1d
793C     **************************************************************************
794      Subroutine Agrif_Bc_variable1d(q,tabvarsindic,calledweight,
795     &                               procname)
796
797      REAL   , Dimension(:)          :: q
798      External :: procname
799      Optional ::  procname
800      INTEGER :: tabvarsindic ! indice of the variable in tabvars
801C       
802      REAL, OPTIONAL :: calledweight
803      REAL    :: weight
804      LOGICAL :: pweight
805      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
806C
807C     
808C     
809      If (Agrif_Root()) Return
810     
811      if ( PRESENT(calledweight) ) then
812        weight=calledweight     
813        pweight = .TRUE.
814      else
815        weight = 0.
816        pweight = .FALSE.
817      endif
818     
819      if (tabvarsindic <=0) then
820      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-tabvarsindic)
821      parenttabvars => tabvars%parent_var
822      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-tabvarsindic)
823      else
824      tabvars=>Agrif_Curgrid % tabvars(tabvarsindic)
825      parenttabvars => Agrif_Curgrid % parent % tabvars(tabvarsindic)
826      roottabvars => Agrif_Mygrid % tabvars(tabvarsindic)
827      endif
828           
829      IF (present(procname)) THEN
830      Call Agrif_Interp_Bc_1D(
831     & roottabvars % var % bctypeinterp,
832     & parenttabvars,
833     & tabvars,q,
834     & tabvars % var % bcinf,
835     & tabvars % var % bcsup,
836     & weight,pweight,procname)     
837      ELSE
838      Call Agrif_Interp_Bc_1D(
839     & roottabvars % var % bctypeinterp,
840     & parenttabvars,
841     & tabvars,q,
842     & tabvars % var % bcinf,
843     & tabvars % var % bcsup,
844     & weight,pweight)
845      ENDIF
846      End Subroutine Agrif_Bc_variable1d 
847     
848C
849C     **************************************************************************
850CCC   Subroutine Agrif_Bc_variable2d
851C     **************************************************************************
852      Subroutine Agrif_Bc_variable2d(q,tabvarsindic,calledweight,
853     &                               procname)
854
855      REAL   , Dimension(:,:)          :: q
856      External :: procname
857      Optional ::  procname
858      INTEGER :: tabvarsindic ! indice of the variable in tabvars
859C       
860      REAL, OPTIONAL :: calledweight
861      REAL    :: weight
862      LOGICAL :: pweight
863      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
864C
865C     
866C     
867      If (Agrif_Root()) Return
868     
869      if ( PRESENT(calledweight) ) then
870        weight=calledweight     
871        pweight = .TRUE.
872      else
873        weight = 0.
874        pweight = .FALSE.
875      endif
876     
877      if (tabvarsindic <=0) then
878      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-tabvarsindic)
879      parenttabvars => tabvars%parent_var
880      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-tabvarsindic)
881      else
882      tabvars=>Agrif_Curgrid % tabvars(tabvarsindic)
883      parenttabvars => Agrif_Curgrid % parent % tabvars(tabvarsindic)
884      roottabvars => Agrif_Mygrid % tabvars(tabvarsindic)
885      endif
886           
887      IF (present(procname)) THEN
888      Call Agrif_Interp_Bc_2D(
889     & roottabvars % var % bctypeinterp,
890     & parenttabvars,
891     & tabvars,q,
892     & tabvars % var % bcinf,
893     & tabvars % var % bcsup,
894     & weight,pweight,procname)     
895      ELSE
896      Call Agrif_Interp_Bc_2D(
897     & roottabvars % var % bctypeinterp,
898     & parenttabvars,
899     & tabvars,q,
900     & tabvars % var % bcinf,
901     & tabvars % var % bcsup,
902     & weight,pweight)
903      ENDIF
904      End Subroutine Agrif_Bc_variable2d
905           
906C
907C     **************************************************************************
908CCC   Subroutine Agrif_Bc_variable3d
909C     **************************************************************************
910      Subroutine Agrif_Bc_variable3d(q,tabvarsindic,calledweight,
911     &                               procname)
912
913      REAL   , Dimension(:,:,:)          :: q
914      External :: procname
915      Optional ::  procname
916      INTEGER :: tabvarsindic ! indice of the variable in tabvars
917C       
918      REAL, OPTIONAL :: calledweight
919      REAL    :: weight
920      LOGICAL :: pweight
921      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
922C
923C     
924C     
925      If (Agrif_Root()) Return
926     
927      if ( PRESENT(calledweight) ) then
928        weight=calledweight     
929        pweight = .TRUE.
930      else
931        weight = 0.
932        pweight = .FALSE.
933      endif
934     
935      if (tabvarsindic <=0) then
936      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-tabvarsindic)
937      parenttabvars => tabvars%parent_var
938      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-tabvarsindic)
939      else
940      tabvars=>Agrif_Curgrid % tabvars(tabvarsindic)
941      parenttabvars => Agrif_Curgrid % parent % tabvars(tabvarsindic)
942      roottabvars => Agrif_Mygrid % tabvars(tabvarsindic)
943      endif
944           
945      IF (present(procname)) THEN
946      Call Agrif_Interp_Bc_3D(
947     & roottabvars % var % bctypeinterp,
948     & parenttabvars,
949     & tabvars,q,
950     & tabvars % var % bcinf,
951     & tabvars % var % bcsup,
952     & weight,pweight,procname)     
953      ELSE
954      Call Agrif_Interp_Bc_3D(
955     & roottabvars % var % bctypeinterp,
956     & parenttabvars,
957     & tabvars,q,
958     & tabvars % var % bcinf,
959     & tabvars % var % bcsup,
960     & weight,pweight)
961      ENDIF
962      End Subroutine Agrif_Bc_variable3d
963     
964C
965C     **************************************************************************
966CCC   Subroutine Agrif_Bc_variable4d
967C     **************************************************************************
968      Subroutine Agrif_Bc_variable4d(q,tabvarsindic,calledweight,
969     &                               procname)
970
971      REAL   , Dimension(:,:,:,:)          :: q
972      External :: procname
973      Optional ::  procname
974      INTEGER :: tabvarsindic ! indice of the variable in tabvars
975C       
976      REAL, OPTIONAL :: calledweight
977      REAL    :: weight
978      LOGICAL :: pweight
979      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
980C
981C     
982C     
983      If (Agrif_Root()) Return
984     
985      if ( PRESENT(calledweight) ) then
986        weight=calledweight     
987        pweight = .TRUE.
988      else
989        weight = 0.
990        pweight = .FALSE.
991      endif
992     
993      if (tabvarsindic <=0) then
994      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-tabvarsindic)
995      parenttabvars => tabvars%parent_var
996      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-tabvarsindic)
997      else
998      tabvars=>Agrif_Curgrid % tabvars(tabvarsindic)
999      parenttabvars => Agrif_Curgrid % parent % tabvars(tabvarsindic)
1000      roottabvars => Agrif_Mygrid % tabvars(tabvarsindic)
1001      endif
1002           
1003      IF (present(procname)) THEN
1004      Call Agrif_Interp_Bc_4D(
1005     & roottabvars % var % bctypeinterp,
1006     & parenttabvars,
1007     & tabvars,q,
1008     & tabvars % var % bcinf,
1009     & tabvars % var % bcsup,
1010     & weight,pweight,procname)     
1011      ELSE
1012      Call Agrif_Interp_Bc_4D(
1013     & roottabvars % var % bctypeinterp,
1014     & parenttabvars,
1015     & tabvars,q,
1016     & tabvars % var % bcinf,
1017     & tabvars % var % bcsup,
1018     & weight,pweight)
1019      ENDIF
1020      End Subroutine Agrif_Bc_variable4d
1021           
1022C
1023C     **************************************************************************
1024CCC   Subroutine Agrif_Bc_variable5d
1025C     **************************************************************************
1026      Subroutine Agrif_Bc_variable5d(q,tabvarsindic,calledweight,
1027     &                               procname)
1028
1029      REAL   , Dimension(:,:,:,:,:)          :: q
1030      External :: procname
1031      Optional ::  procname
1032      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1033C       
1034      REAL, OPTIONAL :: calledweight
1035      REAL    :: weight
1036      LOGICAL :: pweight
1037      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
1038C
1039C     
1040C     
1041      If (Agrif_Root()) Return
1042     
1043      if ( PRESENT(calledweight) ) then
1044        weight=calledweight     
1045        pweight = .TRUE.
1046      else
1047        weight = 0.
1048        pweight = .FALSE.
1049      endif
1050     
1051      if (tabvarsindic <=0) then
1052      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-tabvarsindic)
1053      parenttabvars => tabvars%parent_var
1054      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-tabvarsindic)
1055      else
1056      tabvars=>Agrif_Curgrid % tabvars(tabvarsindic)
1057      parenttabvars => Agrif_Curgrid % parent % tabvars(tabvarsindic)
1058      roottabvars => Agrif_Mygrid % tabvars(tabvarsindic)
1059      endif
1060           
1061      IF (present(procname)) THEN
1062      Call Agrif_Interp_Bc_5d(
1063     & roottabvars % var % bctypeinterp,
1064     & parenttabvars,
1065     & tabvars,q,
1066     & tabvars % var % bcinf,
1067     & tabvars % var % bcsup,
1068     & weight,pweight,procname)     
1069      ELSE
1070      Call Agrif_Interp_Bc_5d(
1071     & roottabvars % var % bctypeinterp,
1072     & parenttabvars,
1073     & tabvars,q,
1074     & tabvars % var % bcinf,
1075     & tabvars % var % bcsup,
1076     & weight,pweight)
1077      ENDIF
1078      End Subroutine Agrif_Bc_variable5d
1079     
1080C
1081C     **************************************************************************
1082CCC   Subroutine Agrif_Interp_var0D
1083C     **************************************************************************
1084C 
1085      Subroutine Agrif_Interp_var0d(tabvarsindic0,tabvarsindic,procname)
1086
1087      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
1088      INTEGER :: tabvarsindic  ! indice of the variable in tabvars
1089      INTEGER :: dimensio  ! indice of the variable in tabvars
1090      External :: procname
1091      Optional ::  procname
1092C     
1093      if (Agrif_Root()) Return
1094C     
1095      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim 
1096C
1097      if ( dimensio .EQ. 1 ) then
1098       if (present(procname)) then
1099       Call Agrif_Interp_1D(
1100     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1101     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1102     & Agrif_Curgrid % tabvars(tabvarsindic),
1103     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
1104     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1105     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname)
1106       else
1107       Call Agrif_Interp_1D(
1108     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1109     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1110     & Agrif_Curgrid % tabvars(tabvarsindic),
1111     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
1112     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1113     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
1114       endif
1115       endif
1116C
1117      if ( dimensio .EQ. 2 ) then
1118      if (present(procname)) then
1119       Call Agrif_Interp_2D(
1120     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1121     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1122     & Agrif_Curgrid % tabvars(tabvarsindic),
1123     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
1124     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1125     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname)
1126      else
1127       Call Agrif_Interp_2D(
1128     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1129     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1130     & Agrif_Curgrid % tabvars(tabvarsindic),
1131     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
1132     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1133     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
1134      endif
1135      endif
1136C
1137      if ( dimensio .EQ. 3 ) then
1138      if (present(procname)) then
1139       Call Agrif_Interp_3D(
1140     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1141     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1142     & Agrif_Curgrid % tabvars(tabvarsindic),
1143     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
1144     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1145     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname)
1146      else
1147       Call Agrif_Interp_3D(
1148     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1149     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1150     & Agrif_Curgrid % tabvars(tabvarsindic),
1151     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
1152     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1153     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
1154      endif
1155      endif
1156C
1157      if ( dimensio .EQ. 4 ) then
1158      if (present(procname)) then
1159       Call Agrif_Interp_4D(
1160     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1161     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1162     & Agrif_Curgrid % tabvars(tabvarsindic),
1163     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
1164     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1165     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname)
1166      else
1167       Call Agrif_Interp_4D(
1168     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1169     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1170     & Agrif_Curgrid % tabvars(tabvarsindic),
1171     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
1172     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1173     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
1174      endif
1175      endif
1176C
1177      if ( dimensio .EQ. 5 ) then
1178      if (present(procname)) then
1179       Call Agrif_Interp_5D(
1180     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1181     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1182     & Agrif_Curgrid % tabvars(tabvarsindic),
1183     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
1184     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1185     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname)
1186      else
1187       Call Agrif_Interp_5D(
1188     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1189     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1190     & Agrif_Curgrid % tabvars(tabvarsindic),
1191     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
1192     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1193     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
1194       endif
1195       endif
1196C
1197      if ( dimensio .EQ. 6 ) then
1198      if (present(procname)) then
1199       Call Agrif_Interp_6D(
1200     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1201     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1202     & Agrif_Curgrid % tabvars(tabvarsindic),
1203     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array6 ,     
1204     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1205     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname)
1206      else
1207       Call Agrif_Interp_6D(
1208     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1209     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1210     & Agrif_Curgrid % tabvars(tabvarsindic),
1211     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array6 ,     
1212     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1213     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
1214      endif
1215      endif
1216C
1217      Return
1218      End Subroutine Agrif_Interp_var0d
1219C
1220C     **************************************************************************
1221CCC   Subroutine Agrif_Interp_var1d
1222C     **************************************************************************
1223C 
1224      Subroutine Agrif_Interp_var1d(q,tabvarsindic,procname)
1225
1226      REAL, DIMENSION(:) :: q
1227      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1228      External :: procname
1229      Optional ::  procname
1230C
1231      if (Agrif_Root()) Return
1232C     
1233      if (present(procname)) then
1234      Call Agrif_Interp_1D(
1235     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1236     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1237     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1238     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1239     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname)
1240      else
1241      Call Agrif_Interp_1D(
1242     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1243     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1244     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1245     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1246     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
1247      endif
1248      Return
1249      End Subroutine Agrif_Interp_var1d
1250C
1251C     **************************************************************************
1252CCC   Subroutine Agrif_Interp_var2d
1253C     **************************************************************************
1254C 
1255      Subroutine Agrif_Interp_var2d(q,tabvarsindic,procname)
1256
1257      REAL,  DIMENSION(:,:) :: q
1258      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1259      External :: procname
1260      Optional ::  procname
1261
1262C
1263       if (Agrif_Root()) Return
1264C
1265       if (present(procname)) then
1266       Call Agrif_Interp_2D(
1267     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1268     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1269     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1270     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1271     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname)
1272       else
1273       Call Agrif_Interp_2D(
1274     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1275     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1276     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1277     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1278     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
1279       endif
1280      Return
1281      End Subroutine Agrif_Interp_var2d
1282C
1283C     **************************************************************************
1284CCC   Subroutine Agrif_Interp_var3d
1285C     **************************************************************************
1286C 
1287      Subroutine Agrif_Interp_var3d(q,tabvarsindic,procname)
1288
1289      REAL,  DIMENSION(:,:,:) :: q
1290      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1291      External :: procname
1292      Optional ::  procname
1293
1294C
1295      if (Agrif_Root()) Return
1296C
1297      if (present(procname)) then
1298      Call Agrif_Interp_3D(
1299     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1300     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1301     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1302     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1303     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname)
1304      else
1305      Call Agrif_Interp_3D(
1306     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1307     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1308     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1309     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1310     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
1311      endif
1312      Return
1313      End Subroutine Agrif_Interp_var3d
1314C
1315C     **************************************************************************
1316CCC   Subroutine Agrif_Interp_var4d
1317C     **************************************************************************
1318C 
1319      Subroutine Agrif_Interp_var4d(q,tabvarsindic,procname)
1320
1321      REAL,  DIMENSION(:,:,:,:) :: q
1322      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1323      External :: procname
1324      Optional ::  procname
1325
1326C
1327      if (Agrif_Root()) Return
1328C
1329      if (present(procname)) then
1330      Call Agrif_Interp_4D(
1331     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1332     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1333     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1334     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1335     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname)
1336      else
1337      Call Agrif_Interp_4D(
1338     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1339     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1340     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1341     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1342     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
1343      endif
1344      Return
1345      End Subroutine Agrif_Interp_var4d     
1346C
1347C     **************************************************************************
1348CCC   Subroutine Agrif_Interp_var5d
1349C     **************************************************************************
1350C 
1351      Subroutine Agrif_Interp_var5d(q,tabvarsindic,procname)
1352
1353      REAL,  DIMENSION(:,:,:,:,:) :: q
1354      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1355      External :: procname
1356      Optional ::  procname
1357
1358C
1359      if (Agrif_Root()) Return
1360C
1361      if (present(procname)) then
1362      Call Agrif_Interp_5D(
1363     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1364     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1365     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1366     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1367     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname)
1368      else
1369      Call Agrif_Interp_5D(
1370     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1371     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1372     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1373     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1374     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
1375      endif
1376      Return
1377      End Subroutine Agrif_Interp_var5d       
1378C
1379C     **************************************************************************
1380CCC   Subroutine Agrif_update_var0d
1381C     **************************************************************************
1382C 
1383      Subroutine Agrif_update_var0d(tabvarsindic0,tabvarsindic,
1384     &                              locupdate,locupdate1,
1385     &                  locupdate2,procname)
1386
1387      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1388      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
1389      External :: procname
1390      Optional ::  procname     
1391      INTEGER :: dimensio
1392      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
1393      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
1394      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2           
1395C
1396      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim 
1397C     
1398      if (Agrif_Root()) Return
1399     
1400C     
1401      IF (present(locupdate)) THEN
1402      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:dimensio)
1403     &      = locupdate(1)
1404      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:dimensio) 
1405     &      = locupdate(2)
1406      ELSE
1407      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:dimensio) 
1408     &      = -99
1409      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:dimensio) 
1410     &      = -99
1411      ENDIF
1412     
1413      IF (present(locupdate1)) THEN
1414      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1) 
1415     &      = locupdate1(1)
1416      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1) 
1417     &      = locupdate1(2)
1418      ENDIF 
1419     
1420      IF (present(locupdate2)) THEN
1421      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2) 
1422     &      = locupdate2(1)
1423      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2) 
1424     &      = locupdate2(2)
1425      ENDIF             
1426 
1427      if ( dimensio .EQ. 1 ) then
1428      IF (present(procname)) THEN
1429      Call Agrif_Update_1D(
1430     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1431     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1432     & Agrif_Curgrid % tabvars(tabvarsindic),
1433     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
1434     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1435     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1436     & procname)
1437      ELSE
1438      Call Agrif_Update_1D(
1439     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1440     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1441     & Agrif_Curgrid % tabvars(tabvarsindic),
1442     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
1443     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1444     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1445      ENDIF
1446      endif
1447      if ( dimensio .EQ. 2 ) then
1448      IF (present(procname)) THEN
1449      Call Agrif_Update_2D(
1450     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1451     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1452     & Agrif_Curgrid % tabvars(tabvarsindic),
1453     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
1454     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1455     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1456     & procname)
1457      ELSE
1458      Call Agrif_Update_2D(
1459     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1460     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1461     & Agrif_Curgrid % tabvars(tabvarsindic),
1462     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
1463     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1464     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1465      ENDIF
1466      endif
1467      if ( dimensio .EQ. 3 ) then
1468      IF (present(procname)) THEN
1469      Call Agrif_Update_3D(
1470     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1471     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1472     & Agrif_Curgrid % tabvars(tabvarsindic),
1473     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
1474     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1475     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1476     & procname)
1477      ELSE
1478      Call Agrif_Update_3D(
1479     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1480     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1481     & Agrif_Curgrid % tabvars(tabvarsindic),
1482     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
1483     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1484     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1485      ENDIF
1486      endif
1487      if ( dimensio .EQ. 4 ) then
1488      IF (present(procname)) THEN
1489      Call Agrif_Update_4D(
1490     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1491     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1492     & Agrif_Curgrid % tabvars(tabvarsindic),
1493     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
1494     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1495     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1496     & procname)
1497      ELSE
1498      Call Agrif_Update_4D(
1499     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1500     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1501     & Agrif_Curgrid % tabvars(tabvarsindic),
1502     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
1503     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1504     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1505      ENDIF
1506      endif
1507      if ( dimensio .EQ. 5 ) then
1508      IF (present(procname)) THEN
1509      Call Agrif_Update_5D(
1510     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1511     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1512     & Agrif_Curgrid % tabvars(tabvarsindic),
1513     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
1514     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1515     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1516     & procname)
1517      ELSE
1518      Call Agrif_Update_5D(
1519     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1520     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1521     & Agrif_Curgrid % tabvars(tabvarsindic),
1522     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
1523     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1524     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1525      ENDIF
1526      endif
1527
1528      Return
1529      End Subroutine Agrif_update_var0d
1530C
1531C
1532C     **************************************************************************
1533CCC   Subroutine Agrif_update_var1d
1534C     **************************************************************************
1535C 
1536      Subroutine Agrif_update_var1d(q,tabvarsindic,locupdate,
1537     &  locupdate1,locupdate2,procname)
1538
1539      REAL,  DIMENSION(:) :: q
1540      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1541      External :: procname
1542      Optional ::  procname     
1543      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
1544      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
1545      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2       
1546C     
1547      if (Agrif_Root()) Return
1548C     
1549      IF (present(locupdate)) THEN
1550      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:1) 
1551     &      = locupdate(1)
1552      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:1) 
1553     &      = locupdate(2)
1554      ELSE
1555      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:1) 
1556     &      = -99
1557      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:1) 
1558     &      = -99
1559      ENDIF
1560     
1561      IF (present(locupdate1)) THEN
1562      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1) 
1563     &      = locupdate1(1)
1564      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1) 
1565     &      = locupdate1(2)
1566      ENDIF 
1567     
1568      IF (present(locupdate2)) THEN
1569      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2) 
1570     &      = locupdate2(1)
1571      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2) 
1572     &      = locupdate2(2)
1573      ENDIF       
1574 
1575      IF (present(procname)) THEN
1576      Call Agrif_Update_1D(
1577     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1578     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1579     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1580     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1581     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1582     & procname)
1583      ELSE
1584      Call Agrif_Update_1D(
1585     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1586     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1587     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1588     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1589     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1590      ENDIF
1591
1592      Return
1593      End Subroutine Agrif_update_var1d
1594C
1595C
1596C     **************************************************************************
1597CCC   Subroutine Agrif_update_var2d
1598C     **************************************************************************
1599C 
1600      Subroutine Agrif_update_var2d(q,tabvarsindic,locupdate,
1601     &  locupdate1,locupdate2,procname)
1602
1603      REAL,  DIMENSION(:,:) :: q
1604      External :: procname
1605      Optional ::  procname
1606      INTEGER, DIMENSION(2), OPTIONAL :: locupdate 
1607      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
1608      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2       
1609      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1610C     
1611      IF (Agrif_Root()) RETURN
1612     
1613C 
1614      IF (present(locupdate)) THEN
1615      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:2) 
1616     &      = locupdate(1)
1617      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:2) 
1618     &      = locupdate(2)
1619      ELSE
1620      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:2) 
1621     &      = -99
1622      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:2) 
1623     &      = -99
1624      ENDIF
1625     
1626      IF (present(locupdate1)) THEN
1627      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1) 
1628     &      = locupdate1(1)
1629      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1) 
1630     &      = locupdate1(2)
1631      ENDIF 
1632     
1633      IF (present(locupdate2)) THEN
1634      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2) 
1635     &      = locupdate2(1)
1636      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2) 
1637     &      = locupdate2(2)
1638      ENDIF
1639 
1640      IF (present(procname)) THEN
1641      Call Agrif_Update_2D(
1642     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1643     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1644     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1645     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1646     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1647     & procname)
1648      ELSE
1649      Call Agrif_Update_2D(
1650     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1651     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1652     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1653     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1654     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1655      ENDIF
1656
1657      Return
1658      End Subroutine Agrif_update_var2d
1659C 
1660C
1661C     **************************************************************************
1662CCC   Subroutine Agrif_update_var3d
1663C     **************************************************************************
1664C 
1665      Subroutine Agrif_update_var3d(q,tabvarsindic,locupdate,
1666     &  locupdate1,locupdate2,procname)
1667
1668      REAL,  DIMENSION(:,:,:) :: q
1669      External :: procname
1670      Optional ::  procname
1671      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
1672      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
1673      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2       
1674      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1675C     
1676      IF (Agrif_Root()) RETURN
1677C     
1678
1679      IF (present(locupdate)) THEN
1680      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:3) 
1681     &      = locupdate(1)
1682      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:3) 
1683     &      = locupdate(2)
1684      ELSE
1685      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:3) 
1686     &      = -99
1687      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:3) 
1688     &      = -99
1689      ENDIF     
1690     
1691      IF (present(locupdate1)) THEN
1692      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1) 
1693     &      = locupdate1(1)
1694      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1) 
1695     &      = locupdate1(2)
1696      ENDIF 
1697     
1698      IF (present(locupdate2)) THEN
1699      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2) 
1700     &      = locupdate2(1)
1701      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2) 
1702     &      = locupdate2(2)
1703      ENDIF
1704
1705      IF (present(procname)) THEN
1706      Call Agrif_Update_3D(
1707     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1708     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1709     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1710     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1711     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1712     & procname)
1713      ELSE
1714      Call Agrif_Update_3D(
1715     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1716     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1717     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1718     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1719     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1720      ENDIF
1721
1722      Return
1723      End Subroutine Agrif_update_var3d
1724C 
1725C
1726C     **************************************************************************
1727CCC   Subroutine Agrif_update_var4d
1728C     **************************************************************************
1729C 
1730      Subroutine Agrif_update_var4d(q,tabvarsindic,locupdate,
1731     &  locupdate1,locupdate2,procname)
1732
1733      REAL,  DIMENSION(:,:,:,:) :: q
1734      External :: procname
1735      Optional ::  procname
1736      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
1737      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
1738      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2       
1739      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1740C     
1741      IF (Agrif_Root()) RETURN
1742C     
1743      IF (present(locupdate)) THEN
1744      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:4) 
1745     &      = locupdate(1)
1746      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:4) 
1747     &      = locupdate(2)
1748      ELSE
1749      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:4) 
1750     &      = -99
1751      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:4) 
1752     &      = -99
1753      ENDIF
1754     
1755      IF (present(locupdate1)) THEN
1756      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1) 
1757     &      = locupdate1(1)
1758      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1) 
1759     &      = locupdate1(2)
1760      ENDIF 
1761     
1762      IF (present(locupdate2)) THEN
1763      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2) 
1764     &      = locupdate2(1)
1765      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2) 
1766     &      = locupdate2(2)
1767      ENDIF
1768
1769      IF (present(procname)) THEN
1770      Call Agrif_Update_4D(
1771     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1772     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1773     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1774     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1775     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1776     & procname)
1777      ELSE
1778      Call Agrif_Update_4D(
1779     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1780     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1781     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1782     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1783     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1784      ENDIF
1785
1786      Return
1787      End Subroutine Agrif_update_var4d 
1788C 
1789C
1790C     **************************************************************************
1791CCC   Subroutine Agrif_update_var5d
1792C     **************************************************************************
1793C 
1794      Subroutine Agrif_update_var5d(q,tabvarsindic,locupdate,
1795     &  locupdate1,locupdate2,procname)
1796
1797      REAL,  DIMENSION(:,:,:,:,:) :: q
1798      External :: procname
1799      Optional ::  procname
1800      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
1801      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
1802      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2       
1803      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1804C
1805      IF (Agrif_Root()) RETURN
1806C     
1807      IF (present(locupdate)) THEN
1808      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:5) 
1809     &      = locupdate(1)
1810      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:5) 
1811     &      = locupdate(2)
1812      ELSE
1813      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:5) 
1814     &      = -99
1815      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:5) 
1816     &      = -99
1817      ENDIF
1818     
1819      IF (present(locupdate1)) THEN
1820      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1) 
1821     &      = locupdate1(1)
1822      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1) 
1823     &      = locupdate1(2)
1824      ENDIF 
1825     
1826      IF (present(locupdate2)) THEN
1827      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2) 
1828     &      = locupdate2(1)
1829      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2) 
1830     &      = locupdate2(2)
1831      ENDIF
1832
1833      IF (present(procname)) THEN
1834      Call Agrif_Update_5D(
1835     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1836     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1837     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1838     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1839     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1840     & procname)
1841      ELSE
1842      Call Agrif_Update_5D(
1843     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1844     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1845     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1846     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1847     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1848      ENDIF
1849
1850      Return
1851      End Subroutine Agrif_update_var5d 
1852         
1853      Subroutine Agrif_Declare_Flux(fluxname,profilename) 
1854      character*(*) :: fluxname, profilename
1855      Type(Agrif_Flux), pointer :: newflux
1856      Type(Agrif_Profile), pointer  :: parcours
1857      logical :: foundprofile
1858      integer :: i,j,n
1859           
1860      foundprofile = .FALSE.
1861      parcours => Agrif_Myprofiles
1862     
1863      Do While (Associated(parcours))
1864         IF (parcours % profilename == profilename) THEN
1865           foundprofile = .TRUE.
1866           EXIT
1867         ENDIF
1868         parcours => parcours%nextprofile
1869      End Do     
1870     
1871      IF (.NOT.foundprofile) THEN
1872      write(*,*) 'The profile '''
1873     &           //TRIM(profilename)//''' has not been declared' 
1874      stop   
1875      ENDIF
1876     
1877      Allocate(Newflux)
1878     
1879      Newflux % fluxname = fluxname
1880     
1881      Newflux % profile => parcours
1882     
1883      Newflux % nextflux => Agrif_Curgrid % fluxes
1884     
1885      Agrif_Curgrid % fluxes => Newflux
1886     
1887      End Subroutine Agrif_Declare_Flux 
1888       
1889      Subroutine Agrif_Save_Flux(fluxname, fluxtab)
1890      character*(*) :: fluxname
1891      REAL, DIMENSION(:,:) :: fluxtab
1892     
1893     
1894      Type(Agrif_Flux), pointer :: Flux
1895     
1896      Type(Agrif_pgrid), pointer :: parcours_child
1897     
1898      Type(Agrif_grid), Pointer :: currentgrid,oldcurgrid
1899     
1900      IF (.Not.Agrif_Root()) THEN
1901      Flux => Agrif_Search_Flux(fluxname)
1902
1903      IF (.NOT.Flux%fluxallocated) THEN
1904        CALL Agrif_AllocateFlux(Flux,fluxtab)
1905      ENDIF
1906     
1907      Call Agrif_Save_Fluxtab(Flux,fluxtab)
1908     
1909      ENDIF
1910     
1911      oldcurgrid=> Agrif_Curgrid
1912     
1913      parcours_child => Agrif_Curgrid%child_grids
1914     
1915      Do While (Associated(parcours_child))
1916        currentgrid => parcours_child%gr
1917        Agrif_Curgrid => parcours_child%gr
1918        Flux => Agrif_Search_Flux(fluxname)
1919        IF (.NOT.Flux%fluxallocated) THEN
1920          CALL Agrif_AllocateFlux(Flux,fluxtab)
1921        ENDIF       
1922        Call Agrif_Save_Fluxtab_child(Flux,fluxtab)
1923        parcours_child=> parcours_child%next
1924      End Do
1925     
1926      Agrif_Curgrid=>oldcurgrid
1927     
1928      End Subroutine Agrif_Save_Flux
1929
1930      Subroutine Agrif_Cancel_Flux(fluxname)
1931      character*(*) :: fluxname
1932     
1933      Type(Agrif_Flux), pointer :: Flux
1934     
1935      Flux => Agrif_Search_Flux(fluxname)
1936
1937      IF (Flux%FluxAllocated) Call Agrif_Cancel_Fluxarray(Flux)
1938     
1939      End Subroutine Agrif_Cancel_Flux
1940 
1941      Subroutine Agrif_Flux_Correction(fluxname, procname)
1942      character*(*) :: fluxname
1943      external :: procname
1944     
1945      Type(Agrif_Flux), pointer :: Flux
1946     
1947      Flux => Agrif_Search_Flux(fluxname)
1948     
1949      Call Agrif_FluxCorrect(Flux, procname)
1950
1951     
1952      End Subroutine Agrif_Flux_Correction
1953
1954      Subroutine Agrif_Declare_Variable(posvar,firstpoint,
1955     &    raf,lb,ub,varid)
1956      character*(80) :: variablename
1957      Type(Agrif_List_Variables), Pointer :: newvariable,newvariablep
1958      INTEGER, DIMENSION(:) :: posvar
1959      INTEGER, DIMENSION(:) :: lb,ub
1960      INTEGER, DIMENSION(:) :: firstpoint
1961      CHARACTER(*) ,DIMENSION(:) :: raf       
1962      TYPE(Agrif_Pvariable), Pointer :: parent_var,root_var
1963      INTEGER :: dimensio
1964      INTEGER :: varid
1965           
1966      if (agrif_root()) return
1967
1968      dimensio = SIZE(posvar)
1969C
1970C   
1971      Allocate(newvariable)
1972      Allocate(newvariable%pvar)
1973      Allocate(newvariable%pvar%var)
1974      Allocate(newvariable%pvar%var%posvar(dimensio))
1975      Allocate(newvariable%pvar%var%interptab(dimensio))
1976      newvariable%pvar%var%variablename = variablename
1977      newvariable%pvar%var%interptab = raf
1978      newvariable%pvar%var%nbdim = dimensio
1979      newvariable%pvar%var%posvar = posvar
1980      newvariable%pvar%var%point(1:dimensio) = firstpoint
1981      newvariable%pvar%var%lb(1:dimensio) = lb(1:dimensio)
1982      newvariable%pvar%var%ub(1:dimensio) = ub(1:dimensio)
1983     
1984      newvariable % nextvariable => Agrif_Curgrid%variables
1985     
1986      Agrif_Curgrid%variables => newvariable
1987      Agrif_Curgrid%Nbvariables = Agrif_Curgrid%Nbvariables + 1
1988     
1989      varid = -Agrif_Curgrid%Nbvariables
1990     
1991       if (agrif_curgrid%parent%nbvariables < agrif_curgrid%nbvariables)
1992     &       then
1993      Allocate(newvariablep)
1994      Allocate(newvariablep%pvar)
1995      Allocate(newvariablep%pvar%var)     
1996      Allocate(newvariablep%pvar%var%posvar(dimensio))
1997      Allocate(newvariablep%pvar%var%interptab(dimensio))
1998      newvariablep%pvar%var%variablename = variablename
1999      newvariablep%pvar%var%interptab = raf
2000      newvariablep%pvar%var%nbdim = dimensio
2001      newvariablep%pvar%var%posvar = posvar
2002      newvariablep%pvar%var%point(1:dimensio) = firstpoint
2003     
2004      newvariablep % nextvariable => Agrif_Curgrid%parent%variables
2005     
2006      Agrif_Curgrid%parent%variables => newvariablep       
2007     
2008      Agrif_Curgrid%parent%Nbvariables = 
2009     &    Agrif_Curgrid%parent%Nbvariables + 1
2010      parent_var=>newvariablep%pvar
2011      else
2012      parent_var=>Agrif_Search_Variable
2013     &              (Agrif_Curgrid%parent,Agrif_Curgrid%nbvariables)
2014       endif
2015       
2016       newvariable%pvar%parent_var=>parent_var
2017     
2018      root_var=>Agrif_Search_Variable
2019     &              (Agrif_Mygrid,Agrif_Curgrid%nbvariables)
2020     
2021      newvariable%pvar%var%root_var=>root_var%var
2022     
2023           
2024      End Subroutine Agrif_Declare_Variable
2025
2026      FUNCTION Agrif_Search_Variable(grid,varid)
2027      integer :: varid
2028      Type(Agrif_Pvariable), Pointer :: Agrif_Search_variable
2029      Type(Agrif_grid), Pointer :: grid
2030     
2031      Type(Agrif_List_Variables), pointer :: parcours
2032      Logical :: foundvariable
2033      integer nb
2034     
2035      foundvariable = .FALSE.
2036      parcours => grid%variables
2037     
2038      do nb=1,varid-1
2039         parcours => parcours%nextvariable
2040      End Do
2041     
2042      Agrif_Search_variable => parcours%pvar
2043     
2044     
2045      End Function Agrif_Search_variable
2046                             
2047      Subroutine Agrif_Declare_Profile_flux(profilename,posvar,
2048     &    firstpoint,raf)
2049      character*(*) :: profilename
2050      Type(Agrif_Profile), Pointer :: newprofile
2051      INTEGER, DIMENSION(:) :: posvar
2052      INTEGER, DIMENSION(:) :: firstpoint
2053      CHARACTER(*) ,DIMENSION(:) :: raf     
2054      INTEGER :: dimensio
2055           
2056      dimensio = SIZE(posvar)
2057C
2058C   
2059      Allocate(newprofile)
2060      Allocate(newprofile%posvar(dimensio))
2061      Allocate(newprofile%interptab(dimensio))
2062      newprofile%profilename = profilename
2063      newprofile%interptab = raf
2064      newprofile%nbdim = dimensio
2065      newprofile%posvar = posvar
2066      newprofile%point(1:dimensio) = firstpoint
2067     
2068      newprofile % nextprofile => Agrif_myprofiles
2069     
2070      Agrif_myprofiles => newprofile
2071     
2072      End Subroutine Agrif_Declare_Profile_flux
2073             
2074C
2075      End module Agrif_bcfunction
Note: See TracBrowser for help on using the repository browser.