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 trunk/AGRIF/AGRIF_FILES – NEMO

source: trunk/AGRIF/AGRIF_FILES/modbcfunction.F @ 396

Last change on this file since 396 was 396, checked in by opalod, 18 years ago

Initial revision
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 47.7 KB
Line 
1!
2! $Id$
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
36C             
37      IMPLICIT NONE
38C
39      interface Agrif_Bc_variable
40          module procedure Agrif_Bc_variable0d,
41     &                     Agrif_Bc_variable1d,
42     &                     Agrif_Bc_variable2d,
43     &                     Agrif_Bc_variable3d,
44     &                     Agrif_Bc_variable4d,
45     &                     Agrif_Bc_variable5d
46      end interface       
47C
48      interface Agrif_Set_Parent
49          module procedure Agrif_Set_Parent_int,
50     &                     Agrif_Set_Parent_real
51      end interface       
52C
53      interface Agrif_Interp_variable
54          module procedure Agrif_Interp_var0d,
55     &                     Agrif_Interp_var1d,
56     &                     Agrif_Interp_var2d,
57     &                     Agrif_Interp_var3d,
58     &                     Agrif_Interp_var4d,
59     &                     Agrif_Interp_var5d
60      end interface       
61C
62      interface Agrif_Init_variable
63          module procedure Agrif_Init_variable0d,
64     &                     Agrif_Init_variable1d,
65     &                     Agrif_Init_variable2d,
66     &                     Agrif_Init_variable3d
67      end interface       
68C
69      interface Agrif_update_variable
70          module procedure Agrif_update_var0d,
71     &                     Agrif_update_var1d,
72     &                     Agrif_update_var2d,
73     &                     Agrif_update_var3d,
74     &                     Agrif_update_var4d,
75     &                     Agrif_update_var5d
76      end interface       
77C
78      Contains
79C
80C     **************************************************************************
81CCC   Subroutine Agrif_Set_type
82C     **************************************************************************
83C 
84      Subroutine Agrif_Set_type(tabvarsindic,posvar,point)
85C
86CCC   Description:
87CCC   To set the TYPE of the variable.
88C
89C     Modules used:
90C     
91
92C
93C     Declarations:
94C     
95C
96C
97C     Arguments     
98C
99      INTEGER, DIMENSION(:) :: posvar
100      INTEGER, DIMENSION(:) :: point
101C
102      INTEGER :: tabvarsindic ! indice of the variable in tabvars
103      INTEGER :: dimensio ! DIMENSION of the variable
104      INTEGER :: i
105C
106C
107C     Begin 
108C
109      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim
110C
111      Allocate( 
112     & Agrif_Mygrid % tabvars(tabvarsindic)%var % posvar(dimensio))
113
114      do i = 1 , dimensio
115         Agrif_Mygrid % tabvars(tabvarsindic) %var % posvar(i)
116     &                       = posvar(i)
117         Agrif_Mygrid % tabvars(tabvarsindic) %var % point(i) 
118     &                       = point(i)
119      enddo
120C
121C
122      End Subroutine Agrif_Set_type
123C
124C
125C     **************************************************************************
126CCC   Subroutine Agrif_Set_parent_int
127C     **************************************************************************
128C 
129      Subroutine Agrif_Set_parent_int(tabvarsindic,value)
130C
131CCC   Description:
132CCC   To set the TYPE of the variable.
133C
134C     Modules used:
135C     
136
137C
138C     Declarations:
139C     
140C
141C
142C     Arguments     
143C
144      INTEGER :: tabvarsindic ! indice of the variable in tabvars
145      INTEGER :: Value
146C
147C     Begin 
148C
149      Agrif_Curgrid % parent % tabvars(tabvarsindic) % 
150     &         var % iarray0 = value
151C
152C
153      End Subroutine Agrif_Set_parent_int
154C
155C
156C     **************************************************************************
157CCC   Subroutine Agrif_Set_parent_real
158C     **************************************************************************
159C 
160      Subroutine Agrif_Set_parent_real(tabvarsindic,value)
161C
162CCC   Description:
163CCC   To set the TYPE of the variable.
164C
165C     Modules used:
166C     
167
168C
169C     Declarations:
170C     
171C
172C
173C     Arguments     
174C
175      INTEGER :: tabvarsindic ! indice of the variable in tabvars
176      REAL :: Value
177C
178C     Begin 
179C
180      Agrif_Curgrid % parent % tabvars(tabvarsindic) % 
181     &          var % array0 = value
182C
183C
184      End Subroutine Agrif_Set_parent_real
185C
186C
187C
188C     **************************************************************************
189CCC   Subroutine Agrif_Set_raf
190C     **************************************************************************
191C 
192      Subroutine Agrif_Set_raf(tabvarsindic,tabraf)
193C
194CCC   Description:
195CCC   Attention tabraf est de taille trois si on ne raffine pas suivant z la
196CCC             troisieme entree du tableau tabraf est 'N'
197C
198C     Modules used:
199C     
200
201C
202C     Declarations:
203C     
204C     Arguments     
205C
206      CHARACTER(*) ,DIMENSION(:) :: tabraf
207C
208      INTEGER :: tabvarsindic ! indice of the variable in tabvars
209      INTEGER :: dimensio ! DIMENSION of the variable
210      INTEGER :: i
211C
212C
213C     Begin 
214C
215      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim
216C         
217      Allocate(
218     & Agrif_Mygrid % tabvars(tabvarsindic)%var% interptab(dimensio))
219
220      do i = 1 , dimensio
221         Agrif_Mygrid % tabvars(tabvarsindic) %var % interptab(i) 
222     &                 = TRIM(tabraf(i))
223      enddo
224C
225      End Subroutine Agrif_Set_raf
226C
227C
228C
229C     **************************************************************************
230CCC   Subroutine Agrif_Set_bc
231C     **************************************************************************
232C 
233      Subroutine Agrif_Set_bc(tabvarsindic,point,
234     &          Interpolationshouldbemade)
235C
236CCC   Description:
237CCC
238C
239C     Modules used:
240C     
241
242C
243C     Declarations:
244C     
245C     Arguments     
246C
247      INTEGER, DIMENSION(2) :: point
248      LOGICAL, OPTIONAL :: Interpolationshouldbemade
249C
250      INTEGER :: tabvarsindic ! indice of the variable in tabvars
251C
252C
253C     Begin 
254C
255C     
256      if (Agrif_Curgrid % fixedrank .NE. 0) then   
257      allocate(Agrif_Curgrid%tabvars(tabvarsindic)%var % interpIndex)
258      Agrif_Curgrid%tabvars(tabvarsindic)%var % interpIndex = -1
259      if ( PRESENT(Interpolationshouldbemade) ) then
260         Agrif_Curgrid%tabvars(tabvarsindic)%var %
261     &     Interpolationshouldbemade = Interpolationshouldbemade
262      endif
263      Allocate(
264     & Agrif_Curgrid%tabvars(tabvarsindic)%var % oldvalues2D(1,2))
265      Agrif_Curgrid%tabvars(tabvarsindic)%var % oldvalues2D = 0. 
266      endif
267C
268      Agrif_Curgrid%tabvars(tabvarsindic)%var % bcinf = point(1)
269      Agrif_Curgrid%tabvars(tabvarsindic)%var % bcsup = point(2)
270C
271      End Subroutine Agrif_Set_bc
272C
273C
274C     **************************************************************************
275CCC   Subroutine Agrif_Set_interp
276C     **************************************************************************
277C 
278      Subroutine Agrif_Set_interp(tabvarsindic,interp,interp1,interp2,
279     &                interp3)
280C
281CCC   Description:
282C
283C     Declarations:
284C     
285C     Arguments     
286C
287      INTEGER, OPTIONAL      :: interp,interp1,interp2,interp3
288C
289      INTEGER :: tabvarsindic ! indice of the variable in tabvars
290C
291C     Begin 
292C
293      Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp = 
294     &    Agrif_Constant
295      IF (present(interp)) THEN
296      Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp = 
297     &           interp
298      ENDIF
299      IF (present(interp1)) THEN
300      Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp(1) = 
301     &           interp1
302      ENDIF
303      IF (present(interp2)) THEN
304      Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp(2) = 
305     &           interp2
306      ENDIF
307      IF (present(interp3)) THEN
308      Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp(3) = 
309     &           interp3
310      ENDIF
311C
312      End Subroutine Agrif_Set_interp
313C
314C     **************************************************************************
315CCC   Subroutine Agrif_Set_bcinterp
316C     **************************************************************************
317C 
318      Subroutine Agrif_Set_bcinterp(tabvarsindic,interp,interp1,
319     &      interp2,interp3)
320C
321CCC   Description:
322
323C
324C     Modules used:
325C     
326
327C
328C     Declarations:
329C     
330C     Arguments     
331C
332      INTEGER, OPTIONAL      :: interp,interp1,interp2,interp3
333C
334      INTEGER :: tabvarsindic ! indice of the variable in tabvars
335C
336C
337C     Begin 
338C
339      Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp = 
340     &           Agrif_Constant
341      IF (present(interp)) THEN
342      Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp = 
343     &           interp
344      ENDIF
345      IF (present(interp1)) THEN
346      Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(1) = 
347     &           interp1
348      ENDIF
349      IF (present(interp2)) THEN
350      Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(2) = 
351     &           interp2
352      ENDIF
353      IF (present(interp3)) THEN
354      Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(3) = 
355     &           interp3
356      ENDIF
357C
358      End Subroutine Agrif_Set_bcinterp
359C
360C
361C     **************************************************************************
362CCC   Subroutine Agrif_Set_Update
363C     **************************************************************************
364C 
365      Subroutine Agrif_Set_Update(tabvarsindic,point)
366C
367CCC   Description:
368CCC
369C
370C     Modules used:
371C     
372
373C
374C     Declarations:
375C     
376C     Arguments     
377C
378      INTEGER, DIMENSION(2) :: point
379C
380      INTEGER :: tabvarsindic ! indice of the variable in tabvars
381C
382C
383C     Begin 
384C
385      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = point(1)
386      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = point(2)
387C
388      End Subroutine Agrif_Set_Update
389C
390C
391C
392C     **************************************************************************
393CCC   Subroutine Agrif_Set_UpdateType
394C     **************************************************************************
395C 
396      Subroutine Agrif_Set_UpdateType(tabvarsindic,
397     &                                  update,update1,update2,
398     &                                  update3,update4,update5)
399C
400CCC   Description:
401
402C
403C     Modules used:
404C     
405
406C
407C     Declarations:
408C     
409C     Arguments     
410C
411      INTEGER, OPTIONAL           :: update, update1,
412     &       update2, update3,update4,update5
413C
414      INTEGER :: tabvarsindic ! indice of the variable in tabvars
415C
416C
417C     Begin 
418C
419      Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate = 
420     &                   Agrif_Update_Copy
421     
422      IF (present(update)) THEN
423        Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate = 
424     &           update
425      ENDIF
426      IF (present(update1)) THEN
427        Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(1) = 
428     &           update1
429      ENDIF 
430      IF (present(update2)) THEN
431        Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(2) = 
432     &           update2
433      ENDIF 
434      IF (present(update3)) THEN
435        Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(3) = 
436     &           update3
437      ENDIF
438      IF (present(update4)) THEN
439        Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(4) = 
440     &           update4
441      ENDIF       
442      IF (present(update5)) THEN
443        Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(5) = 
444     &           update5
445      ENDIF                 
446C
447      End Subroutine Agrif_Set_UpdateType           
448C
449C
450C     **************************************************************************
451CCC   Subroutine Agrif_Set_restore
452C     **************************************************************************
453C 
454      Subroutine Agrif_Set_restore(tabvarsindic)
455C
456CCC   Description:
457CCC   
458C
459C     Modules used:
460C     
461
462C
463C     Declarations:
464C     
465C     Arguments     
466C
467      INTEGER :: tabvarsindic ! indice of the variable in tabvars
468C
469C     Begin 
470C
471C
472      Agrif_Mygrid%tabvars(tabvarsindic)%var % restaure = .TRUE.
473C
474      End Subroutine Agrif_Set_restore
475C
476C
477C     **************************************************************************
478CCC   Subroutine Agrif_Init_variable0d
479C     **************************************************************************
480      Subroutine Agrif_Init_variable0d(tabvarsindic0,tabvarsindic)
481
482      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
483      INTEGER :: tabvarsindic ! indice of the variable in tabvars
484C
485      if (Agrif_Root()) Return
486C     
487      CALL Agrif_Interp_variable(tabvarsindic0,tabvarsindic)
488      CALL Agrif_Bc_variable(tabvarsindic0,tabvarsindic,1.)
489
490      End Subroutine Agrif_Init_variable0d
491C
492C
493C     **************************************************************************
494CCC   Subroutine Agrif_Init_variable1d
495C     **************************************************************************
496      Subroutine Agrif_Init_variable1d(q,tabvarsindic)
497
498      REAL, DIMENSION(:) :: q
499      INTEGER :: tabvarsindic ! indice of the variable in tabvars
500C
501      if (Agrif_Root()) Return
502C
503      CALL Agrif_Interp_variable(q,tabvarsindic)
504      CALL Agrif_Bc_variable(q,tabvarsindic,1.)
505
506      End Subroutine Agrif_Init_variable1d
507C
508C     **************************************************************************
509CCC   Subroutine Agrif_Init_variable2d
510C     **************************************************************************
511      Subroutine Agrif_Init_variable2d(q,tabvarsindic)
512
513      REAL,  DIMENSION(:,:) :: q
514      INTEGER :: tabvarsindic ! indice of the variable in tabvars
515C
516      if (Agrif_Root()) Return
517C
518      CALL Agrif_Interp_variable(q,tabvarsindic)
519      CALL Agrif_Bc_variable(q,tabvarsindic,1.)
520
521      End Subroutine Agrif_Init_variable2d
522C
523C
524C     **************************************************************************
525CCC   Subroutine Agrif_Init_variable3d
526C     **************************************************************************
527      Subroutine Agrif_Init_variable3d(q,tabvarsindic)
528
529      REAL,  DIMENSION(:,:,:) :: q
530      INTEGER :: tabvarsindic ! indice of the variable in tabvars
531C
532      if (Agrif_Root()) Return
533C
534      CALL Agrif_Interp_variable(q,tabvarsindic)
535      CALL Agrif_Bc_variable(q,tabvarsindic,1.)
536C
537      End Subroutine Agrif_Init_variable3d
538C
539C
540C     **************************************************************************
541CCC   Subroutine Agrif_Bc_variable0d
542C     **************************************************************************
543      Subroutine Agrif_Bc_variable0d(tabvarsindic0,tabvarsindic,
544     &                               calledweight,procname)
545
546      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
547      INTEGER :: tabvarsindic ! indice of the variable in tabvars
548C       
549      External :: procname
550      Optional ::  procname
551      REAL, OPTIONAL :: calledweight
552      REAL    :: weight
553      LOGICAL :: pweight
554C
555      INTEGER :: dimensio     
556
557      if (Agrif_Root()) Return
558C
559      dimensio =  Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim   
560C
561      if ( PRESENT(calledweight) ) then
562        weight=calledweight     
563        pweight = .TRUE.
564      else
565        weight = 0.
566        pweight = .FALSE.
567      endif
568C     
569C
570
571     
572      if ( dimensio .EQ. 1 ) Call Agrif_Interp_Bc_1D(
573     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
574     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
575     & Agrif_Curgrid % tabvars(tabvarsindic),
576     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array1,
577     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
578     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
579     & weight,
580     & pweight)
581C
582      if ( dimensio .EQ. 2 ) then
583      IF (present(procname)) THEN
584      Call Agrif_Interp_Bc_2D(
585     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
586     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
587     & Agrif_Curgrid % tabvars(tabvarsindic),
588     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array2,
589     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
590     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
591     & weight,pweight,procname)
592      ELSE
593      Call Agrif_Interp_Bc_2D(
594     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
595     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
596     & Agrif_Curgrid % tabvars(tabvarsindic),
597     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array2,
598     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
599     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
600     & weight,pweight)
601      ENDIF
602      endif
603C
604      if ( dimensio .EQ. 3 ) then
605      IF (present(procname)) THEN
606      Call Agrif_Interp_Bc_3D(
607     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
608     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
609     & Agrif_Curgrid % tabvars(tabvarsindic),
610     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array3,
611     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
612     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
613     & weight,pweight,procname)     
614      ELSE
615      Call Agrif_Interp_Bc_3D(
616     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
617     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
618     & Agrif_Curgrid % tabvars(tabvarsindic),
619     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array3,
620     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
621     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
622     & weight,pweight)
623      ENDIF
624      endif
625C
626      if ( dimensio .EQ. 4 ) then
627      IF (present(procname)) THEN
628      Call Agrif_Interp_Bc_4D(
629     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
630     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
631     & Agrif_Curgrid % tabvars(tabvarsindic),
632     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array4,     
633     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
634     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
635     & weight,pweight,procname)     
636      ELSE
637      Call Agrif_Interp_Bc_4D(
638     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
639     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
640     & Agrif_Curgrid % tabvars(tabvarsindic),
641     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array4,     
642     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
643     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
644     & weight,pweight)
645      ENDIF
646      endif
647C
648      if ( dimensio .EQ. 5 ) then
649      IF (present(procname)) THEN
650      Call Agrif_Interp_Bc_5D(
651     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
652     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
653     & Agrif_Curgrid % tabvars(tabvarsindic),
654     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array5,
655     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
656     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
657     & weight,pweight,procname)     
658      ELSE
659      Call Agrif_Interp_Bc_5D(
660     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
661     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
662     & Agrif_Curgrid % tabvars(tabvarsindic),
663     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array5,
664     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
665     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
666     & weight,pweight)
667      ENDIF
668      endif
669C
670      if ( dimensio .EQ. 6 ) Call Agrif_Interp_Bc_6D(
671     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
672     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
673     & Agrif_Curgrid % tabvars(tabvarsindic),
674     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array6,
675     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
676     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
677     & weight,
678     & pweight)
679C
680C
681      End Subroutine Agrif_Bc_variable0d
682C
683C
684C
685C     **************************************************************************
686CCC   Subroutine Agrif_Bc_variable1d
687C     **************************************************************************
688      Subroutine Agrif_Bc_variable1d(q,tabvarsindic,calledweight)
689
690      REAL   , DIMENSION(:)          :: q
691      INTEGER :: tabvarsindic ! indice of the variable in tabvars
692C       
693      REAL, OPTIONAL :: calledweight
694      REAL    :: weight
695      LOGICAL :: pweight
696C
697      if ( PRESENT(calledweight) ) then
698        weight=calledweight     
699        pweight = .TRUE.
700      else
701        weight = 0.
702        pweight = .FALSE.
703      endif
704C     
705C
706      if (Agrif_Root()) Return
707     
708      Call Agrif_Interp_Bc_1D(
709     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
710     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
711     & Agrif_Curgrid % tabvars(tabvarsindic),
712     & q,
713     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
714     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
715     & weight,
716     & pweight)
717      End Subroutine Agrif_Bc_variable1d
718C
719C
720CC
721C
722C     **************************************************************************
723CCC   Subroutine Agrif_Bc_variable2d
724C     **************************************************************************
725      Subroutine Agrif_Bc_variable2d(q,tabvarsindic,calledweight,
726     &                                 procname)
727
728      REAL   , DIMENSION(:,:)          :: q
729      External :: procname
730      Optional ::  procname
731      INTEGER :: tabvarsindic ! indice of the variable in tabvars
732C       
733      REAL, OPTIONAL :: calledweight
734      REAL    :: weight
735      LOGICAL :: pweight
736C
737      if ( PRESENT(calledweight) ) then
738        weight=calledweight
739        pweight = .TRUE.
740      else
741        weight = 0.
742        pweight = .FALSE.
743      endif
744C     
745C
746
747      if (Agrif_Root()) Return
748      IF (present(procname)) THEN
749      Call Agrif_Interp_Bc_2D(
750     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
751     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
752     & Agrif_Curgrid % tabvars(tabvarsindic),q,
753     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
754     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
755     & weight,pweight,procname)     
756      ELSE
757       Call Agrif_Interp_Bc_2D(
758     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
759     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
760     & Agrif_Curgrid % tabvars(tabvarsindic),q,
761     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
762     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
763     & weight,pweight)
764      ENDIF
765
766      End Subroutine Agrif_Bc_variable2d
767C
768C     **************************************************************************
769CCC   Subroutine Agrif_Bc_variable3d
770C     **************************************************************************
771      Subroutine Agrif_Bc_variable3d(q,tabvarsindic,calledweight,
772     &                               procname)
773
774      REAL   , Dimension(:,:,:)          :: q
775      External :: procname
776      Optional ::  procname
777      INTEGER :: tabvarsindic ! indice of the variable in tabvars
778C       
779      REAL, OPTIONAL :: calledweight
780      REAL    :: weight
781      LOGICAL :: pweight
782C
783      if ( PRESENT(calledweight) ) then
784        weight=calledweight     
785        pweight = .TRUE.
786      else
787        weight = 0.
788        pweight = .FALSE.
789      endif
790C     
791C     
792      If (Agrif_Root()) Return
793      IF (present(procname)) THEN
794      Call Agrif_Interp_Bc_3D(
795     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
796     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
797     & Agrif_Curgrid % tabvars(tabvarsindic),q,
798     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
799     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
800     & weight,pweight,procname)     
801      ELSE
802      Call Agrif_Interp_Bc_3D(
803     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
804     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
805     & Agrif_Curgrid % tabvars(tabvarsindic),q,
806     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
807     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
808     & weight,pweight)
809      ENDIF
810      End Subroutine Agrif_Bc_variable3d
811C
812C     **************************************************************************
813CCC   Subroutine Agrif_Bc_variable4d
814C     **************************************************************************
815      Subroutine Agrif_Bc_variable4d(q,tabvarsindic,calledweight,
816     &                               procname)
817
818      REAL   , Dimension(:,:,:,:)          :: q
819      External :: procname
820      Optional ::  procname
821      INTEGER :: tabvarsindic ! indice of the variable in tabvars
822C       
823      REAL, OPTIONAL :: calledweight
824      REAL    :: weight
825      LOGICAL :: pweight
826C
827      if ( PRESENT(calledweight) ) then
828        weight=calledweight     
829        pweight = .TRUE.
830      else
831        weight = 0.
832        pweight = .FALSE.
833      endif
834C     
835C     
836      If (Agrif_Root()) Return
837      IF (present(procname)) THEN
838      Call Agrif_Interp_Bc_4D(
839     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
840     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
841     & Agrif_Curgrid % tabvars(tabvarsindic),q,
842     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
843     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
844     & weight,pweight,procname)     
845      ELSE
846      Call Agrif_Interp_Bc_4D(
847     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
848     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
849     & Agrif_Curgrid % tabvars(tabvarsindic),q,
850     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
851     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
852     & weight,pweight)
853      ENDIF
854      End Subroutine Agrif_Bc_variable4d
855C
856C     **************************************************************************
857CCC   Subroutine Agrif_Bc_variable5d
858C     **************************************************************************
859      Subroutine Agrif_Bc_variable5d(q,tabvarsindic,calledweight,
860     &                              procname)
861
862      REAL   , Dimension(:,:,:,:,:)          :: q
863      External :: procname
864      Optional ::  procname
865      INTEGER :: tabvarsindic ! indice of the variable in tabvars
866C       
867      REAL, OPTIONAL :: calledweight
868      REAL    :: weight
869      LOGICAL :: pweight
870C
871      if ( PRESENT(calledweight) ) then
872        weight=calledweight     
873        pweight = .TRUE.
874      else
875        weight = 0.
876        pweight = .FALSE.
877      endif
878C     
879C     
880      If (Agrif_Root()) Return
881      IF (present(procname)) THEN
882      Call Agrif_Interp_Bc_5D(
883     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
884     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
885     & Agrif_Curgrid % tabvars(tabvarsindic),q,
886     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
887     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
888     & weight,pweight,procname)     
889      ELSE
890      Call Agrif_Interp_Bc_5D(
891     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
892     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
893     & Agrif_Curgrid % tabvars(tabvarsindic),q,
894     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
895     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
896     & weight,pweight)
897      ENDIF
898      End Subroutine Agrif_Bc_variable5d
899C
900C     **************************************************************************
901CCC   Subroutine Agrif_Interp_var0D
902C     **************************************************************************
903C 
904      Subroutine Agrif_Interp_var0d(tabvarsindic0,tabvarsindic)
905
906      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
907      INTEGER :: tabvarsindic  ! indice of the variable in tabvars
908      INTEGER :: dimensio  ! indice of the variable in tabvars
909C     
910      if (Agrif_Root()) Return
911C     
912      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim 
913C
914      if ( dimensio .EQ. 1 )
915     & Call Agrif_Interp_1D(
916     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
917     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
918     & Agrif_Curgrid % tabvars(tabvarsindic),
919     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
920     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
921     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
922C
923      if ( dimensio .EQ. 2 )
924     & Call Agrif_Interp_2D(
925     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
926     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
927     & Agrif_Curgrid % tabvars(tabvarsindic),
928     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
929     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
930     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
931C
932      if ( dimensio .EQ. 3 )
933     & Call Agrif_Interp_3D(
934     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
935     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
936     & Agrif_Curgrid % tabvars(tabvarsindic),
937     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
938     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
939     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
940C
941      if ( dimensio .EQ. 4 )
942     & Call Agrif_Interp_4D(
943     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
944     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
945     & Agrif_Curgrid % tabvars(tabvarsindic),
946     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
947     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
948     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
949C
950      if ( dimensio .EQ. 5 )
951     & Call Agrif_Interp_5D(
952     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
953     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
954     & Agrif_Curgrid % tabvars(tabvarsindic),
955     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
956     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
957     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
958C
959      if ( dimensio .EQ. 6 )
960     & Call Agrif_Interp_6D(
961     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
962     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
963     & Agrif_Curgrid % tabvars(tabvarsindic),
964     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array6 ,     
965     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
966     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
967C
968      Return
969      End Subroutine Agrif_Interp_var0d
970C
971C     **************************************************************************
972CCC   Subroutine Agrif_Interp_var1d
973C     **************************************************************************
974C 
975      Subroutine Agrif_Interp_var1d(q,tabvarsindic)
976
977      REAL, DIMENSION(:) :: q
978      INTEGER :: tabvarsindic ! indice of the variable in tabvars
979C
980      if (Agrif_Root()) Return
981C     
982      Call Agrif_Interp_1D(
983     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
984     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
985     & Agrif_Curgrid % tabvars(tabvarsindic),q,
986     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
987     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
988
989      Return
990      End Subroutine Agrif_Interp_var1d
991C
992C     **************************************************************************
993CCC   Subroutine Agrif_Interp_var2d
994C     **************************************************************************
995C 
996      Subroutine Agrif_Interp_var2d(q,tabvarsindic)
997
998      REAL,  DIMENSION(:,:) :: q
999      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1000C
1001       if (Agrif_Root()) Return
1002C
1003       Call Agrif_Interp_2D(
1004     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1005     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1006     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1007     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1008     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
1009
1010      Return
1011      End Subroutine Agrif_Interp_var2d
1012C
1013C     **************************************************************************
1014CCC   Subroutine Agrif_Interp_var3d
1015C     **************************************************************************
1016C 
1017      Subroutine Agrif_Interp_var3d(q,tabvarsindic)
1018
1019      REAL,  DIMENSION(:,:,:) :: q
1020      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1021C
1022      if (Agrif_Root()) Return
1023C
1024      Call Agrif_Interp_3D(
1025     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1026     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1027     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1028     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1029     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
1030
1031      Return
1032      End Subroutine Agrif_Interp_var3d
1033C
1034C     **************************************************************************
1035CCC   Subroutine Agrif_Interp_var4d
1036C     **************************************************************************
1037C 
1038      Subroutine Agrif_Interp_var4d(q,tabvarsindic)
1039
1040      REAL,  DIMENSION(:,:,:,:) :: q
1041      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1042C
1043      if (Agrif_Root()) Return
1044C
1045      Call Agrif_Interp_4D(
1046     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1047     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1048     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1049     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1050     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
1051
1052      Return
1053      End Subroutine Agrif_Interp_var4d     
1054C
1055C     **************************************************************************
1056CCC   Subroutine Agrif_Interp_var5d
1057C     **************************************************************************
1058C 
1059      Subroutine Agrif_Interp_var5d(q,tabvarsindic)
1060
1061      REAL,  DIMENSION(:,:,:,:,:) :: q
1062      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1063C
1064      if (Agrif_Root()) Return
1065C
1066      Call Agrif_Interp_5D(
1067     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1068     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1069     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1070     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1071     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
1072
1073      Return
1074      End Subroutine Agrif_Interp_var5d       
1075C
1076C     **************************************************************************
1077CCC   Subroutine Agrif_update_var0d
1078C     **************************************************************************
1079C 
1080      Subroutine Agrif_update_var0d(tabvarsindic0,tabvarsindic,
1081     &                              locupdate,procname)
1082
1083      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1084      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
1085      External :: procname
1086      Optional ::  procname     
1087      INTEGER :: dimensio
1088      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
1089C
1090      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim 
1091C     
1092      if (Agrif_Root()) Return
1093C     
1094      IF (present(locupdate)) THEN
1095      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = locupdate(1)
1096      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = locupdate(2)
1097      ELSE
1098      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = -99
1099      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = -99
1100      ENDIF
1101 
1102      if ( dimensio .EQ. 1 ) then
1103      IF (present(procname)) THEN
1104      Call Agrif_Update_1D(
1105     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1106     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1107     & Agrif_Curgrid % tabvars(tabvarsindic),
1108     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
1109     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1110     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1111     & procname)
1112      ELSE
1113      Call Agrif_Update_1D(
1114     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1115     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1116     & Agrif_Curgrid % tabvars(tabvarsindic),
1117     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
1118     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1119     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1120      ENDIF
1121      endif
1122      if ( dimensio .EQ. 2 ) then
1123      IF (present(procname)) THEN
1124      Call Agrif_Update_2D(
1125     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1126     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1127     & Agrif_Curgrid % tabvars(tabvarsindic),
1128     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
1129     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1130     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1131     & procname)
1132      ELSE
1133      Call Agrif_Update_2D(
1134     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1135     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1136     & Agrif_Curgrid % tabvars(tabvarsindic),
1137     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
1138     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1139     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1140      ENDIF
1141      endif
1142      if ( dimensio .EQ. 3 ) then
1143      IF (present(procname)) THEN
1144      Call Agrif_Update_3D(
1145     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1146     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1147     & Agrif_Curgrid % tabvars(tabvarsindic),
1148     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
1149     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1150     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1151     & procname)
1152      ELSE
1153      Call Agrif_Update_3D(
1154     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1155     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1156     & Agrif_Curgrid % tabvars(tabvarsindic),
1157     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
1158     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1159     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1160      ENDIF
1161      endif
1162      if ( dimensio .EQ. 4 ) then
1163      IF (present(procname)) THEN
1164      Call Agrif_Update_4D(
1165     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1166     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1167     & Agrif_Curgrid % tabvars(tabvarsindic),
1168     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
1169     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1170     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1171     & procname)
1172      ELSE
1173      Call Agrif_Update_4D(
1174     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1175     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1176     & Agrif_Curgrid % tabvars(tabvarsindic),
1177     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
1178     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1179     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1180      ENDIF
1181      endif
1182      if ( dimensio .EQ. 5 ) then
1183      IF (present(procname)) THEN
1184      Call Agrif_Update_5D(
1185     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1186     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1187     & Agrif_Curgrid % tabvars(tabvarsindic),
1188     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
1189     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1190     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1191     & procname)
1192      ELSE
1193      Call Agrif_Update_5D(
1194     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1195     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1196     & Agrif_Curgrid % tabvars(tabvarsindic),
1197     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
1198     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1199     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1200      ENDIF
1201      endif
1202
1203      Return
1204      End Subroutine Agrif_update_var0d
1205C
1206C
1207C     **************************************************************************
1208CCC   Subroutine Agrif_update_var1d
1209C     **************************************************************************
1210C 
1211      Subroutine Agrif_update_var1d(q,tabvarsindic,locupdate,procname)
1212
1213      REAL,  DIMENSION(:) :: q
1214      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1215      External :: procname
1216      Optional ::  procname     
1217      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
1218C     
1219      if (Agrif_Root()) Return
1220C     
1221      IF (present(locupdate)) THEN
1222      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = locupdate(1)
1223      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = locupdate(2)
1224      ELSE
1225      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = -99
1226      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = -99
1227      ENDIF
1228 
1229      IF (present(procname)) THEN
1230      Call Agrif_Update_1D(
1231     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1232     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1233     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1234     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1235     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1236     & procname)
1237      ELSE
1238      Call Agrif_Update_1D(
1239     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1240     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1241     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1242     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1243     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1244      ENDIF
1245
1246      Return
1247      End Subroutine Agrif_update_var1d
1248C
1249C
1250C     **************************************************************************
1251CCC   Subroutine Agrif_update_var2d
1252C     **************************************************************************
1253C 
1254      Subroutine Agrif_update_var2d(q,tabvarsindic,locupdate,procname)
1255
1256      REAL,  DIMENSION(:,:) :: q
1257      External :: procname
1258      Optional ::  procname
1259      INTEGER, DIMENSION(2), OPTIONAL :: locupdate 
1260      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1261C     
1262      IF (Agrif_Root()) RETURN
1263C 
1264      IF (present(locupdate)) THEN
1265      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = locupdate(1)
1266      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = locupdate(2)
1267      ELSE
1268      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = -99
1269      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = -99
1270      ENDIF
1271 
1272      IF (present(procname)) THEN
1273      Call Agrif_Update_2D(
1274     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1275     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1276     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1277     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1278     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1279     & procname)
1280      ELSE
1281      Call Agrif_Update_2D(
1282     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1283     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1284     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1285     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1286     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1287      ENDIF
1288
1289      Return
1290      End Subroutine Agrif_update_var2d
1291C 
1292C
1293C     **************************************************************************
1294CCC   Subroutine Agrif_update_var3d
1295C     **************************************************************************
1296C 
1297      Subroutine Agrif_update_var3d(q,tabvarsindic,locupdate,procname)
1298
1299      REAL,  DIMENSION(:,:,:) :: q
1300      External :: procname
1301      Optional ::  procname
1302      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
1303      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1304C     
1305      IF (Agrif_Root()) RETURN
1306C     
1307
1308      IF (present(locupdate)) THEN
1309      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = locupdate(1)
1310      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = locupdate(2)
1311      ELSE
1312      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = -99
1313      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = -99
1314      ENDIF
1315
1316      IF (present(procname)) THEN
1317      Call Agrif_Update_3D(
1318     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1319     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1320     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1321     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1322     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1323     & procname)
1324      ELSE
1325      Call Agrif_Update_3D(
1326     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1327     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1328     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1329     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1330     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1331      ENDIF
1332
1333      Return
1334      End Subroutine Agrif_update_var3d
1335C 
1336C
1337C     **************************************************************************
1338CCC   Subroutine Agrif_update_var4d
1339C     **************************************************************************
1340C 
1341      Subroutine Agrif_update_var4d(q,tabvarsindic,locupdate,procname)
1342
1343      REAL,  DIMENSION(:,:,:,:) :: q
1344      External :: procname
1345      Optional ::  procname
1346      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
1347      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1348C     
1349      IF (Agrif_Root()) RETURN
1350C     
1351      IF (present(locupdate)) THEN
1352      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = locupdate(1)
1353      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = locupdate(2)
1354      ELSE
1355      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = -99
1356      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = -99
1357      ENDIF
1358
1359      IF (present(procname)) THEN
1360      Call Agrif_Update_4D(
1361     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1362     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1363     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1364     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1365     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1366     & procname)
1367      ELSE
1368      Call Agrif_Update_4D(
1369     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1370     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1371     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1372     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1373     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1374      ENDIF
1375
1376      Return
1377      End Subroutine Agrif_update_var4d 
1378C 
1379C
1380C     **************************************************************************
1381CCC   Subroutine Agrif_update_var5d
1382C     **************************************************************************
1383C 
1384      Subroutine Agrif_update_var5d(q,tabvarsindic,locupdate,procname)
1385
1386      REAL,  DIMENSION(:,:,:,:,:) :: q
1387      External :: procname
1388      Optional ::  procname
1389      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
1390      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1391C
1392      IF (Agrif_Root()) RETURN
1393C     
1394      IF (present(locupdate)) THEN
1395      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = locupdate(1)
1396      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = locupdate(2)
1397      ELSE
1398      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = -99
1399      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = -99
1400      ENDIF
1401
1402      IF (present(procname)) THEN
1403      Call Agrif_Update_5D(
1404     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1405     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1406     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1407     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1408     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1409     & procname)
1410      ELSE
1411      Call Agrif_Update_5D(
1412     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1413     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1414     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1415     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1416     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1417      ENDIF
1418
1419      Return
1420      End Subroutine Agrif_update_var5d         
1421C
1422      End module Agrif_bcfunction
Note: See TracBrowser for help on using the repository browser.