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

Last change on this file since 662 was 662, checked in by opalod, 17 years ago

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