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 branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES – NEMO

source: branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F @ 5024

Last change on this file since 5024 was 2715, checked in by rblod, 13 years ago

First attempt to put dynamic allocation on the trunk

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