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

Last change on this file since 779 was 779, checked in by rblod, 16 years ago

Agrif improvment for vectorization, see ticket #41
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 52.4 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
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
258C
259C
260C     Begin 
261C
262C     
263      if (Agrif_Curgrid % fixedrank .NE. 0) then 
264       IF (.Not.Associated(Agrif_Curgrid%tabvars(tabvarsindic)%var
265     &                % interpIndex)) THEN
266        Allocate(Agrif_Curgrid%tabvars(tabvarsindic)%var % interpIndex)
267          Agrif_Curgrid%tabvars(tabvarsindic)%var % interpIndex = -1
268
269        Allocate(
270     &    Agrif_Curgrid%tabvars(tabvarsindic)%var % oldvalues2D(2,1))
271          Agrif_Curgrid%tabvars(tabvarsindic)%var % oldvalues2D = 0. 
272       ENDIF     
273       if ( PRESENT(Interpolationshouldbemade) ) then
274         Agrif_Curgrid%tabvars(tabvarsindic)%var %
275     &     Interpolationshouldbemade = Interpolationshouldbemade
276       endif
277
278      endif
279C
280      Agrif_Curgrid%tabvars(tabvarsindic)%var % bcinf = point(1)
281      Agrif_Curgrid%tabvars(tabvarsindic)%var % bcsup = point(2)
282C
283      End Subroutine Agrif_Set_bc
284C
285C
286C     **************************************************************************
287CCC   Subroutine Agrif_Set_interp
288C     **************************************************************************
289C 
290      Subroutine Agrif_Set_interp(tabvarsindic,interp,interp1,interp2,
291     &                interp3)
292C
293CCC   Description:
294C
295C     Declarations:
296C     
297C     Arguments     
298C
299      INTEGER, OPTIONAL      :: interp,interp1,interp2,interp3
300C
301      INTEGER :: tabvarsindic ! indice of the variable in tabvars
302C
303C     Begin 
304C
305      Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp = 
306     &    Agrif_Constant
307      IF (present(interp)) THEN
308      Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp = 
309     &           interp
310      ENDIF
311      IF (present(interp1)) THEN
312      Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp(1) = 
313     &           interp1
314      ENDIF
315      IF (present(interp2)) THEN
316      Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp(2) = 
317     &           interp2
318      ENDIF
319      IF (present(interp3)) THEN
320      Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp(3) = 
321     &           interp3
322      ENDIF
323C
324      End Subroutine Agrif_Set_interp
325C
326C     **************************************************************************
327CCC   Subroutine Agrif_Set_bcinterp
328C     **************************************************************************
329C 
330      Subroutine Agrif_Set_bcinterp(tabvarsindic,interp,interp1,
331     &      interp2,interp3,interp11,interp12,interp21,interp22)
332C
333CCC   Description:
334
335C
336C     Modules used:
337C     
338
339C
340C     Declarations:
341C     
342C     Arguments     
343C
344      INTEGER, OPTIONAL      :: interp,interp1,interp2,interp3
345      INTEGER, OPTIONAL      :: interp11,interp12,interp21,interp22
346C
347      INTEGER :: tabvarsindic ! indice of the variable in tabvars
348C
349C
350C     Begin 
351C
352      Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp = 
353     &           Agrif_Constant   
354      IF (present(interp)) THEN
355      Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp = 
356     &           interp
357      ENDIF       
358      IF (present(interp1)) THEN
359      Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(1:2,1) = 
360     &           interp1
361      ENDIF       
362      IF (present(interp11)) THEN
363      Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(1,1) = 
364     &           interp11
365      ENDIF
366      IF (present(interp12)) THEN
367      Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(1,2) = 
368     &           interp12
369      ENDIF         
370      IF (present(interp2)) THEN
371      Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(1:2,2) = 
372     &           interp2
373      ENDIF
374      IF (present(interp21)) THEN
375      Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(2,1) = 
376     &           interp21
377      ENDIF     
378      IF (present(interp22)) THEN
379      Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(2,2) = 
380     &           interp22
381      ENDIF           
382      IF (present(interp3)) THEN
383      Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(1:2,3) =
384     &           interp3
385      ENDIF
386C
387      End Subroutine Agrif_Set_bcinterp
388C
389C
390C     **************************************************************************
391CCC   Subroutine Agrif_Set_Update
392C     **************************************************************************
393C 
394      Subroutine Agrif_Set_Update(tabvarsindic,point)
395C
396CCC   Description:
397CCC
398C
399C     Modules used:
400C     
401
402C
403C     Declarations:
404C     
405C     Arguments     
406C
407      INTEGER, DIMENSION(2) :: point
408C
409      INTEGER :: tabvarsindic ! indice of the variable in tabvars
410C
411C
412C     Begin 
413C
414      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = point(1)
415      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = point(2)
416C
417      End Subroutine Agrif_Set_Update
418C
419C
420C
421C     **************************************************************************
422CCC   Subroutine Agrif_Set_UpdateType
423C     **************************************************************************
424C 
425      Subroutine Agrif_Set_UpdateType(tabvarsindic,
426     &                                  update,update1,update2,
427     &                                  update3,update4,update5)
428C
429CCC   Description:
430
431C
432C     Modules used:
433C     
434
435C
436C     Declarations:
437C     
438C     Arguments     
439C
440      INTEGER, OPTIONAL           :: update, update1,
441     &       update2, update3,update4,update5
442C
443      INTEGER :: tabvarsindic ! indice of the variable in tabvars
444C
445C
446C     Begin 
447C
448      Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate = 
449     &                   Agrif_Update_Copy
450     
451      IF (present(update)) THEN
452        Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate = 
453     &           update
454      ENDIF
455      IF (present(update1)) THEN
456        Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(1) = 
457     &           update1
458      ENDIF 
459      IF (present(update2)) THEN
460        Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(2) = 
461     &           update2
462      ENDIF 
463      IF (present(update3)) THEN
464        Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(3) = 
465     &           update3
466      ENDIF
467      IF (present(update4)) THEN
468        Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(4) = 
469     &           update4
470      ENDIF       
471      IF (present(update5)) THEN
472        Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(5) = 
473     &           update5
474      ENDIF                 
475C
476      End Subroutine Agrif_Set_UpdateType           
477C
478C
479C     **************************************************************************
480CCC   Subroutine Agrif_Set_restore
481C     **************************************************************************
482C 
483      Subroutine Agrif_Set_restore(tabvarsindic)
484C
485CCC   Description:
486CCC   
487C
488C     Modules used:
489C     
490
491C
492C     Declarations:
493C     
494C     Arguments     
495C
496      INTEGER :: tabvarsindic ! indice of the variable in tabvars
497C
498C     Begin 
499C
500C
501      Agrif_Mygrid%tabvars(tabvarsindic)%var % restaure = .TRUE.
502C
503      End Subroutine Agrif_Set_restore
504C
505C
506C     **************************************************************************
507CCC   Subroutine Agrif_Init_variable0d
508C     **************************************************************************
509      Subroutine Agrif_Init_variable0d(tabvarsindic0,tabvarsindic)
510
511      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
512      INTEGER :: tabvarsindic ! indice of the variable in tabvars
513C
514      if (Agrif_Root()) Return
515C     
516      CALL Agrif_Interp_variable(tabvarsindic0,tabvarsindic)
517      CALL Agrif_Bc_variable(tabvarsindic0,tabvarsindic,1.)
518
519      End Subroutine Agrif_Init_variable0d
520C
521C
522C     **************************************************************************
523CCC   Subroutine Agrif_Init_variable1d
524C     **************************************************************************
525      Subroutine Agrif_Init_variable1d(q,tabvarsindic)
526
527      REAL, DIMENSION(:) :: q
528      INTEGER :: tabvarsindic ! indice of the variable in tabvars
529C
530      if (Agrif_Root()) Return
531C
532      CALL Agrif_Interp_variable(q,tabvarsindic)
533      CALL Agrif_Bc_variable(q,tabvarsindic,1.)
534
535      End Subroutine Agrif_Init_variable1d
536C
537C     **************************************************************************
538CCC   Subroutine Agrif_Init_variable2d
539C     **************************************************************************
540      Subroutine Agrif_Init_variable2d(q,tabvarsindic)
541
542      REAL,  DIMENSION(:,:) :: q
543      INTEGER :: tabvarsindic ! indice of the variable in tabvars
544C
545      if (Agrif_Root()) Return
546C
547      CALL Agrif_Interp_variable(q,tabvarsindic)
548      CALL Agrif_Bc_variable(q,tabvarsindic,1.)
549
550      End Subroutine Agrif_Init_variable2d
551C
552C
553C     **************************************************************************
554CCC   Subroutine Agrif_Init_variable3d
555C     **************************************************************************
556      Subroutine Agrif_Init_variable3d(q,tabvarsindic)
557
558      REAL,  DIMENSION(:,:,:) :: q
559      INTEGER :: tabvarsindic ! indice of the variable in tabvars
560C
561      if (Agrif_Root()) Return
562C
563      CALL Agrif_Interp_variable(q,tabvarsindic)
564      CALL Agrif_Bc_variable(q,tabvarsindic,1.)
565C
566      End Subroutine Agrif_Init_variable3d
567C
568C
569C     **************************************************************************
570CCC   Subroutine Agrif_Bc_variable0d
571C     **************************************************************************
572      Subroutine Agrif_Bc_variable0d(tabvarsindic0,tabvarsindic,
573     &                               calledweight,procname)
574
575      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
576      INTEGER :: tabvarsindic ! indice of the variable in tabvars
577C       
578      External :: procname
579      Optional ::  procname
580      REAL, OPTIONAL :: calledweight
581      REAL    :: weight
582      LOGICAL :: pweight
583C
584      INTEGER :: dimensio     
585
586      if (Agrif_Root()) Return
587C
588      dimensio =  Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim   
589C
590      if ( PRESENT(calledweight) ) then
591        weight=calledweight     
592        pweight = .TRUE.
593      else
594        weight = 0.
595        pweight = .FALSE.
596      endif
597C     
598C
599
600     
601      if ( dimensio .EQ. 1 ) Call Agrif_Interp_Bc_1D(
602     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
603     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
604     & Agrif_Curgrid % tabvars(tabvarsindic),
605     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array1,
606     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
607     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
608     & weight,
609     & pweight)
610C
611      if ( dimensio .EQ. 2 ) then
612      IF (present(procname)) THEN
613      Call Agrif_Interp_Bc_2D(
614     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
615     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
616     & Agrif_Curgrid % tabvars(tabvarsindic),
617     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array2,
618     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
619     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
620     & weight,pweight,procname)
621      ELSE
622         
623      Call Agrif_Interp_Bc_2D(
624     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
625     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
626     & Agrif_Curgrid % tabvars(tabvarsindic),
627     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array2,
628     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
629     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
630     & weight,pweight)
631      ENDIF
632      endif
633C
634      if ( dimensio .EQ. 3 ) then
635      IF (present(procname)) THEN
636
637      Call Agrif_Interp_Bc_3D(
638     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
639     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
640     & Agrif_Curgrid % tabvars(tabvarsindic),
641     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array3,
642     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
643     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
644     & weight,pweight,procname)     
645      ELSE
646      Call Agrif_Interp_Bc_3D(
647     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
648     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
649     & Agrif_Curgrid % tabvars(tabvarsindic),
650     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array3,
651     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
652     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
653     & weight,pweight)
654      ENDIF
655      endif
656C
657      if ( dimensio .EQ. 4 ) then
658      IF (present(procname)) THEN
659      Call Agrif_Interp_Bc_4D(
660     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
661     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
662     & Agrif_Curgrid % tabvars(tabvarsindic),
663     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array4,     
664     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
665     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
666     & weight,pweight,procname)     
667      ELSE
668      Call Agrif_Interp_Bc_4D(
669     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
670     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
671     & Agrif_Curgrid % tabvars(tabvarsindic),
672     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array4,     
673     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
674     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
675     & weight,pweight)
676      ENDIF
677      endif
678C
679      if ( dimensio .EQ. 5 ) then
680      IF (present(procname)) THEN
681      Call Agrif_Interp_Bc_5D(
682     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
683     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
684     & Agrif_Curgrid % tabvars(tabvarsindic),
685     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array5,
686     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
687     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
688     & weight,pweight,procname)     
689      ELSE
690      Call Agrif_Interp_Bc_5D(
691     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
692     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
693     & Agrif_Curgrid % tabvars(tabvarsindic),
694     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array5,
695     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
696     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
697     & weight,pweight)
698      ENDIF
699      endif
700C
701      if ( dimensio .EQ. 6 ) Call Agrif_Interp_Bc_6D(
702     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
703     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
704     & Agrif_Curgrid % tabvars(tabvarsindic),
705     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array6,
706     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
707     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
708     & weight,
709     & pweight)
710C
711C
712      End Subroutine Agrif_Bc_variable0d
713C
714C
715C
716C     **************************************************************************
717CCC   Subroutine Agrif_Bc_variable1d
718C     **************************************************************************
719      Subroutine Agrif_Bc_variable1d(q,tabvarsindic,calledweight)
720
721      REAL   , DIMENSION(:)          :: q
722      INTEGER :: tabvarsindic ! indice of the variable in tabvars
723C       
724      REAL, OPTIONAL :: calledweight
725      REAL    :: weight
726      LOGICAL :: pweight
727C
728      if ( PRESENT(calledweight) ) then
729        weight=calledweight     
730        pweight = .TRUE.
731      else
732        weight = 0.
733        pweight = .FALSE.
734      endif
735C     
736C
737      if (Agrif_Root()) Return
738     
739      Call Agrif_Interp_Bc_1D(
740     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
741     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
742     & Agrif_Curgrid % tabvars(tabvarsindic),
743     & q,
744     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
745     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
746     & weight,
747     & pweight)
748      End Subroutine Agrif_Bc_variable1d
749C
750C
751CC
752C
753C     **************************************************************************
754CCC   Subroutine Agrif_Bc_variable2d
755C     **************************************************************************
756      Subroutine Agrif_Bc_variable2d(q,tabvarsindic,calledweight,
757     &                                 procname)
758
759      REAL   , DIMENSION(:,:)          :: q
760      External :: procname
761      Optional ::  procname
762      INTEGER :: tabvarsindic ! indice of the variable in tabvars
763C       
764      REAL, OPTIONAL :: calledweight
765      REAL    :: weight
766      LOGICAL :: pweight
767C
768      if ( PRESENT(calledweight) ) then
769        weight=calledweight
770        pweight = .TRUE.
771      else
772        weight = 0.
773        pweight = .FALSE.
774      endif
775C     
776C
777
778      if (Agrif_Root()) Return
779      IF (present(procname)) THEN
780      Call Agrif_Interp_Bc_2D(
781     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
782     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
783     & Agrif_Curgrid % tabvars(tabvarsindic),q,
784     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
785     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
786     & weight,pweight,procname)     
787      ELSE
788       Call Agrif_Interp_Bc_2D(
789     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
790     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
791     & Agrif_Curgrid % tabvars(tabvarsindic),q,
792     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
793     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
794     & weight,pweight)
795      ENDIF
796
797      End Subroutine Agrif_Bc_variable2d
798C
799C     **************************************************************************
800CCC   Subroutine Agrif_Bc_variable3d
801C     **************************************************************************
802      Subroutine Agrif_Bc_variable3d(q,tabvarsindic,calledweight,
803     &                               procname)
804
805      REAL   , Dimension(:,:,:)          :: q
806      External :: procname
807      Optional ::  procname
808      INTEGER :: tabvarsindic ! indice of the variable in tabvars
809C       
810      REAL, OPTIONAL :: calledweight
811      REAL    :: weight
812      LOGICAL :: pweight
813C
814      if ( PRESENT(calledweight) ) then
815        weight=calledweight     
816        pweight = .TRUE.
817      else
818        weight = 0.
819        pweight = .FALSE.
820      endif
821C     
822C     
823      If (Agrif_Root()) Return
824      IF (present(procname)) THEN
825      Call Agrif_Interp_Bc_3D(
826     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
827     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
828     & Agrif_Curgrid % tabvars(tabvarsindic),q,
829     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
830     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
831     & weight,pweight,procname)     
832      ELSE
833      Call Agrif_Interp_Bc_3D(
834     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
835     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
836     & Agrif_Curgrid % tabvars(tabvarsindic),q,
837     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
838     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
839     & weight,pweight)
840      ENDIF
841      End Subroutine Agrif_Bc_variable3d
842C
843C     **************************************************************************
844CCC   Subroutine Agrif_Bc_variable4d
845C     **************************************************************************
846      Subroutine Agrif_Bc_variable4d(q,tabvarsindic,calledweight,
847     &                               procname)
848
849      REAL   , Dimension(:,:,:,:)          :: q
850      External :: procname
851      Optional ::  procname
852      INTEGER :: tabvarsindic ! indice of the variable in tabvars
853C       
854      REAL, OPTIONAL :: calledweight
855      REAL    :: weight
856      LOGICAL :: pweight
857C
858      if ( PRESENT(calledweight) ) then
859        weight=calledweight     
860        pweight = .TRUE.
861      else
862        weight = 0.
863        pweight = .FALSE.
864      endif
865C     
866C     
867      If (Agrif_Root()) Return
868      IF (present(procname)) THEN
869      Call Agrif_Interp_Bc_4D(
870     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
871     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
872     & Agrif_Curgrid % tabvars(tabvarsindic),q,
873     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
874     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
875     & weight,pweight,procname)     
876      ELSE
877      Call Agrif_Interp_Bc_4D(
878     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
879     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
880     & Agrif_Curgrid % tabvars(tabvarsindic),q,
881     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
882     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
883     & weight,pweight)
884      ENDIF
885      End Subroutine Agrif_Bc_variable4d
886C
887C     **************************************************************************
888CCC   Subroutine Agrif_Bc_variable5d
889C     **************************************************************************
890      Subroutine Agrif_Bc_variable5d(q,tabvarsindic,calledweight,
891     &                              procname)
892
893      REAL   , Dimension(:,:,:,:,:)          :: q
894      External :: procname
895      Optional ::  procname
896      INTEGER :: tabvarsindic ! indice of the variable in tabvars
897C       
898      REAL, OPTIONAL :: calledweight
899      REAL    :: weight
900      LOGICAL :: pweight
901C
902      if ( PRESENT(calledweight) ) then
903        weight=calledweight     
904        pweight = .TRUE.
905      else
906        weight = 0.
907        pweight = .FALSE.
908      endif
909C     
910C     
911      If (Agrif_Root()) Return
912      IF (present(procname)) THEN
913      Call Agrif_Interp_Bc_5D(
914     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
915     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
916     & Agrif_Curgrid % tabvars(tabvarsindic),q,
917     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
918     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
919     & weight,pweight,procname)     
920      ELSE
921      Call Agrif_Interp_Bc_5D(
922     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
923     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
924     & Agrif_Curgrid % tabvars(tabvarsindic),q,
925     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
926     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
927     & weight,pweight)
928      ENDIF
929      End Subroutine Agrif_Bc_variable5d
930C
931C     **************************************************************************
932CCC   Subroutine Agrif_Interp_var0D
933C     **************************************************************************
934C 
935      Subroutine Agrif_Interp_var0d(tabvarsindic0,tabvarsindic)
936
937      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
938      INTEGER :: tabvarsindic  ! indice of the variable in tabvars
939      INTEGER :: dimensio  ! indice of the variable in tabvars
940C     
941      if (Agrif_Root()) Return
942C     
943      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim 
944C
945      if ( dimensio .EQ. 1 )
946     & Call Agrif_Interp_1D(
947     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
948     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
949     & Agrif_Curgrid % tabvars(tabvarsindic),
950     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
951     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
952     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
953C
954      if ( dimensio .EQ. 2 )
955     & Call Agrif_Interp_2D(
956     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
957     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
958     & Agrif_Curgrid % tabvars(tabvarsindic),
959     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
960     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
961     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
962C
963      if ( dimensio .EQ. 3 )
964     & Call Agrif_Interp_3D(
965     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
966     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
967     & Agrif_Curgrid % tabvars(tabvarsindic),
968     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
969     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
970     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
971C
972      if ( dimensio .EQ. 4 )
973     & Call Agrif_Interp_4D(
974     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
975     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
976     & Agrif_Curgrid % tabvars(tabvarsindic),
977     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
978     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
979     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
980C
981      if ( dimensio .EQ. 5 )
982     & Call Agrif_Interp_5D(
983     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
984     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
985     & Agrif_Curgrid % tabvars(tabvarsindic),
986     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
987     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
988     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
989C
990      if ( dimensio .EQ. 6 )
991     & Call Agrif_Interp_6D(
992     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
993     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
994     & Agrif_Curgrid % tabvars(tabvarsindic),
995     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array6 ,     
996     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
997     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
998C
999      Return
1000      End Subroutine Agrif_Interp_var0d
1001C
1002C     **************************************************************************
1003CCC   Subroutine Agrif_Interp_var1d
1004C     **************************************************************************
1005C 
1006      Subroutine Agrif_Interp_var1d(q,tabvarsindic)
1007
1008      REAL, DIMENSION(:) :: q
1009      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1010C
1011      if (Agrif_Root()) Return
1012C     
1013      Call Agrif_Interp_1D(
1014     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1015     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1016     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1017     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1018     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
1019
1020      Return
1021      End Subroutine Agrif_Interp_var1d
1022C
1023C     **************************************************************************
1024CCC   Subroutine Agrif_Interp_var2d
1025C     **************************************************************************
1026C 
1027      Subroutine Agrif_Interp_var2d(q,tabvarsindic)
1028
1029      REAL,  DIMENSION(:,:) :: q
1030      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1031C
1032       if (Agrif_Root()) Return
1033C
1034       Call Agrif_Interp_2D(
1035     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1036     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1037     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1038     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1039     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
1040
1041      Return
1042      End Subroutine Agrif_Interp_var2d
1043C
1044C     **************************************************************************
1045CCC   Subroutine Agrif_Interp_var3d
1046C     **************************************************************************
1047C 
1048      Subroutine Agrif_Interp_var3d(q,tabvarsindic)
1049
1050      REAL,  DIMENSION(:,:,:) :: q
1051      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1052C
1053      if (Agrif_Root()) Return
1054C
1055      Call Agrif_Interp_3D(
1056     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1057     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1058     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1059     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1060     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
1061
1062      Return
1063      End Subroutine Agrif_Interp_var3d
1064C
1065C     **************************************************************************
1066CCC   Subroutine Agrif_Interp_var4d
1067C     **************************************************************************
1068C 
1069      Subroutine Agrif_Interp_var4d(q,tabvarsindic)
1070
1071      REAL,  DIMENSION(:,:,:,:) :: q
1072      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1073C
1074      if (Agrif_Root()) Return
1075C
1076      Call Agrif_Interp_4D(
1077     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1078     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1079     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1080     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1081     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
1082
1083      Return
1084      End Subroutine Agrif_Interp_var4d     
1085C
1086C     **************************************************************************
1087CCC   Subroutine Agrif_Interp_var5d
1088C     **************************************************************************
1089C 
1090      Subroutine Agrif_Interp_var5d(q,tabvarsindic)
1091
1092      REAL,  DIMENSION(:,:,:,:,:) :: q
1093      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1094C
1095      if (Agrif_Root()) Return
1096C
1097      Call Agrif_Interp_5D(
1098     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp,
1099     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1100     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1101     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure,
1102     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim)
1103
1104      Return
1105      End Subroutine Agrif_Interp_var5d       
1106C
1107C     **************************************************************************
1108CCC   Subroutine Agrif_update_var0d
1109C     **************************************************************************
1110C 
1111      Subroutine Agrif_update_var0d(tabvarsindic0,tabvarsindic,
1112     &                              locupdate,procname)
1113
1114      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1115      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
1116      External :: procname
1117      Optional ::  procname     
1118      INTEGER :: dimensio
1119      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
1120C
1121      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim 
1122C     
1123      if (Agrif_Root()) Return
1124C     
1125      IF (present(locupdate)) THEN
1126      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = locupdate(1)
1127      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = locupdate(2)
1128      ELSE
1129      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = -99
1130      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = -99
1131      ENDIF
1132 
1133      if ( dimensio .EQ. 1 ) then
1134      IF (present(procname)) THEN
1135      Call Agrif_Update_1D(
1136     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1137     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1138     & Agrif_Curgrid % tabvars(tabvarsindic),
1139     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
1140     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1141     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1142     & procname)
1143      ELSE
1144      Call Agrif_Update_1D(
1145     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1146     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1147     & Agrif_Curgrid % tabvars(tabvarsindic),
1148     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
1149     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1150     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1151      ENDIF
1152      endif
1153      if ( dimensio .EQ. 2 ) then
1154      IF (present(procname)) THEN
1155      Call Agrif_Update_2D(
1156     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1157     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1158     & Agrif_Curgrid % tabvars(tabvarsindic),
1159     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
1160     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1161     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1162     & procname)
1163      ELSE
1164      Call Agrif_Update_2D(
1165     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1166     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1167     & Agrif_Curgrid % tabvars(tabvarsindic),
1168     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
1169     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1170     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1171      ENDIF
1172      endif
1173      if ( dimensio .EQ. 3 ) then
1174      IF (present(procname)) THEN
1175      Call Agrif_Update_3D(
1176     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1177     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1178     & Agrif_Curgrid % tabvars(tabvarsindic),
1179     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
1180     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1181     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1182     & procname)
1183      ELSE
1184      Call Agrif_Update_3D(
1185     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1186     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1187     & Agrif_Curgrid % tabvars(tabvarsindic),
1188     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
1189     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1190     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1191      ENDIF
1192      endif
1193      if ( dimensio .EQ. 4 ) then
1194      IF (present(procname)) THEN
1195      Call Agrif_Update_4D(
1196     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1197     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1198     & Agrif_Curgrid % tabvars(tabvarsindic),
1199     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
1200     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1201     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1202     & procname)
1203      ELSE
1204      Call Agrif_Update_4D(
1205     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1206     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1207     & Agrif_Curgrid % tabvars(tabvarsindic),
1208     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
1209     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1210     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1211      ENDIF
1212      endif
1213      if ( dimensio .EQ. 5 ) then
1214      IF (present(procname)) THEN
1215      Call Agrif_Update_5D(
1216     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1217     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1218     & Agrif_Curgrid % tabvars(tabvarsindic),
1219     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
1220     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1221     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1222     & procname)
1223      ELSE
1224      Call Agrif_Update_5D(
1225     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1226     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1227     & Agrif_Curgrid % tabvars(tabvarsindic),
1228     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
1229     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1230     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1231      ENDIF
1232      endif
1233
1234      Return
1235      End Subroutine Agrif_update_var0d
1236C
1237C
1238C     **************************************************************************
1239CCC   Subroutine Agrif_update_var1d
1240C     **************************************************************************
1241C 
1242      Subroutine Agrif_update_var1d(q,tabvarsindic,locupdate,procname)
1243
1244      REAL,  DIMENSION(:) :: q
1245      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1246      External :: procname
1247      Optional ::  procname     
1248      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
1249C     
1250      if (Agrif_Root()) Return
1251C     
1252      IF (present(locupdate)) THEN
1253      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = locupdate(1)
1254      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = locupdate(2)
1255      ELSE
1256      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = -99
1257      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = -99
1258      ENDIF
1259 
1260      IF (present(procname)) THEN
1261      Call Agrif_Update_1D(
1262     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1263     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1264     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1265     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1266     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1267     & procname)
1268      ELSE
1269      Call Agrif_Update_1D(
1270     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1271     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1272     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1273     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1274     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1275      ENDIF
1276
1277      Return
1278      End Subroutine Agrif_update_var1d
1279C
1280C
1281C     **************************************************************************
1282CCC   Subroutine Agrif_update_var2d
1283C     **************************************************************************
1284C 
1285      Subroutine Agrif_update_var2d(q,tabvarsindic,locupdate,procname)
1286
1287      REAL,  DIMENSION(:,:) :: q
1288      External :: procname
1289      Optional ::  procname
1290      INTEGER, DIMENSION(2), OPTIONAL :: locupdate 
1291      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1292C     
1293      IF (Agrif_Root()) RETURN
1294C 
1295      IF (present(locupdate)) THEN
1296      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = locupdate(1)
1297      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = locupdate(2)
1298      ELSE
1299      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = -99
1300      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = -99
1301      ENDIF
1302 
1303      IF (present(procname)) THEN
1304      Call Agrif_Update_2D(
1305     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1306     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1307     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1308     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1309     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1310     & procname)
1311      ELSE
1312      Call Agrif_Update_2D(
1313     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1314     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1315     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1316     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1317     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1318      ENDIF
1319
1320      Return
1321      End Subroutine Agrif_update_var2d
1322C 
1323C
1324C     **************************************************************************
1325CCC   Subroutine Agrif_update_var3d
1326C     **************************************************************************
1327C 
1328      Subroutine Agrif_update_var3d(q,tabvarsindic,locupdate,procname)
1329
1330      REAL,  DIMENSION(:,:,:) :: q
1331      External :: procname
1332      Optional ::  procname
1333      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
1334      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1335C     
1336      IF (Agrif_Root()) RETURN
1337C     
1338
1339      IF (present(locupdate)) THEN
1340      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = locupdate(1)
1341      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = locupdate(2)
1342      ELSE
1343      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = -99
1344      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = -99
1345      ENDIF
1346
1347      IF (present(procname)) THEN
1348      Call Agrif_Update_3D(
1349     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1350     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1351     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1352     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1353     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1354     & procname)
1355      ELSE
1356      Call Agrif_Update_3D(
1357     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1358     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1359     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1360     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1361     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1362      ENDIF
1363
1364      Return
1365      End Subroutine Agrif_update_var3d
1366C 
1367C
1368C     **************************************************************************
1369CCC   Subroutine Agrif_update_var4d
1370C     **************************************************************************
1371C 
1372      Subroutine Agrif_update_var4d(q,tabvarsindic,locupdate,procname)
1373
1374      REAL,  DIMENSION(:,:,:,:) :: q
1375      External :: procname
1376      Optional ::  procname
1377      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
1378      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1379C     
1380      IF (Agrif_Root()) RETURN
1381C     
1382      IF (present(locupdate)) THEN
1383      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = locupdate(1)
1384      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = locupdate(2)
1385      ELSE
1386      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = -99
1387      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = -99
1388      ENDIF
1389
1390      IF (present(procname)) THEN
1391      Call Agrif_Update_4D(
1392     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1393     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1394     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1395     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1396     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1397     & procname)
1398      ELSE
1399      Call Agrif_Update_4D(
1400     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1401     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1402     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1403     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1404     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1405      ENDIF
1406
1407      Return
1408      End Subroutine Agrif_update_var4d 
1409C 
1410C
1411C     **************************************************************************
1412CCC   Subroutine Agrif_update_var5d
1413C     **************************************************************************
1414C 
1415      Subroutine Agrif_update_var5d(q,tabvarsindic,locupdate,procname)
1416
1417      REAL,  DIMENSION(:,:,:,:,:) :: q
1418      External :: procname
1419      Optional ::  procname
1420      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
1421      INTEGER :: tabvarsindic ! indice of the variable in tabvars
1422C
1423      IF (Agrif_Root()) RETURN
1424C     
1425      IF (present(locupdate)) THEN
1426      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = locupdate(1)
1427      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = locupdate(2)
1428      ELSE
1429      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = -99
1430      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = -99
1431      ENDIF
1432
1433      IF (present(procname)) THEN
1434      Call Agrif_Update_5D(
1435     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1436     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1437     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1438     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1439     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
1440     & procname)
1441      ELSE
1442      Call Agrif_Update_5D(
1443     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
1444     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
1445     & Agrif_Curgrid % tabvars(tabvarsindic),q,
1446     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
1447     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)     
1448      ENDIF
1449
1450      Return
1451      End Subroutine Agrif_update_var5d 
1452         
1453      Subroutine Agrif_Declare_Flux(fluxname,profilename) 
1454      character*(*) :: fluxname, profilename
1455      Type(Agrif_Flux), pointer :: newflux
1456      Type(Agrif_Profile), pointer  :: parcours
1457      logical :: foundprofile
1458      integer :: i,j,n
1459           
1460      foundprofile = .FALSE.
1461      parcours => Agrif_Myprofiles
1462     
1463      Do While (Associated(parcours))
1464         IF (parcours % profilename == profilename) THEN
1465           foundprofile = .TRUE.
1466           EXIT
1467         ENDIF
1468         parcours => parcours%nextprofile
1469      End Do     
1470     
1471      IF (.NOT.foundprofile) THEN
1472      write(*,*) 'The profile '''
1473     &           //TRIM(profilename)//''' has not been declared' 
1474      stop   
1475      ENDIF
1476     
1477      Allocate(Newflux)
1478     
1479      Newflux % fluxname = fluxname
1480     
1481      Newflux % profile => parcours
1482     
1483      Newflux % nextflux => Agrif_Curgrid % fluxes
1484     
1485      Agrif_Curgrid % fluxes => Newflux
1486     
1487      End Subroutine Agrif_Declare_Flux 
1488       
1489      Subroutine Agrif_Save_Flux(fluxname, fluxtab)
1490      character*(*) :: fluxname
1491      REAL, DIMENSION(:,:) :: fluxtab
1492     
1493     
1494      Type(Agrif_Flux), pointer :: Flux
1495     
1496      Type(Agrif_pgrid), pointer :: parcours_child
1497     
1498      Type(Agrif_grid), Pointer :: currentgrid,oldcurgrid
1499     
1500      IF (.Not.Agrif_Root()) THEN
1501      Flux => Agrif_Search_Flux(fluxname)
1502
1503      IF (.NOT.Flux%fluxallocated) THEN
1504        CALL Agrif_AllocateFlux(Flux,fluxtab)
1505      ENDIF
1506     
1507      Call Agrif_Save_Fluxtab(Flux,fluxtab)
1508     
1509      ENDIF
1510     
1511      oldcurgrid=> Agrif_Curgrid
1512     
1513      parcours_child => Agrif_Curgrid%child_grids
1514     
1515      Do While (Associated(parcours_child))
1516        currentgrid => parcours_child%gr
1517        Agrif_Curgrid => parcours_child%gr
1518        Flux => Agrif_Search_Flux(fluxname)
1519        IF (.NOT.Flux%fluxallocated) THEN
1520          CALL Agrif_AllocateFlux(Flux,fluxtab)
1521        ENDIF       
1522        Call Agrif_Save_Fluxtab_child(Flux,fluxtab)
1523        parcours_child=> parcours_child%next
1524      End Do
1525     
1526      Agrif_Curgrid=>oldcurgrid
1527     
1528      End Subroutine Agrif_Save_Flux
1529
1530      Subroutine Agrif_Cancel_Flux(fluxname)
1531      character*(*) :: fluxname
1532     
1533      Type(Agrif_Flux), pointer :: Flux
1534     
1535      Flux => Agrif_Search_Flux(fluxname)
1536
1537      IF (Flux%FluxAllocated) Call Agrif_Cancel_Fluxarray(Flux)
1538     
1539      End Subroutine Agrif_Cancel_Flux
1540 
1541      Subroutine Agrif_Flux_Correction(fluxname, procname)
1542      character*(*) :: fluxname
1543      external :: procname
1544     
1545      Type(Agrif_Flux), pointer :: Flux
1546     
1547      Flux => Agrif_Search_Flux(fluxname)
1548     
1549      Call Agrif_FluxCorrect(Flux, procname)
1550
1551     
1552      End Subroutine Agrif_Flux_Correction
1553                 
1554      Subroutine Agrif_Declare_Profile(profilename,posvar,firstpoint,
1555     &    raf)
1556      character*(*) :: profilename
1557      Type(Agrif_Profile), Pointer :: newprofile
1558      INTEGER, DIMENSION(:) :: posvar
1559      INTEGER, DIMENSION(:) :: firstpoint
1560      CHARACTER(*) ,DIMENSION(:) :: raf     
1561      INTEGER :: dimensio
1562           
1563      dimensio = SIZE(posvar)
1564C
1565C   
1566      Allocate(newprofile)
1567      Allocate(newprofile%posvar(dimensio))
1568      Allocate(newprofile%interptab(dimensio))
1569      newprofile%profilename = profilename
1570      newprofile%interptab = raf
1571      newprofile%nbdim = dimensio
1572      newprofile%posvar = posvar
1573      newprofile%point(1:dimensio) = firstpoint
1574     
1575      newprofile % nextprofile => Agrif_myprofiles
1576     
1577      Agrif_myprofiles => newprofile
1578     
1579      End Subroutine Agrif_Declare_Profile
1580             
1581C
1582      End module Agrif_bcfunction
Note: See TracBrowser for help on using the repository browser.