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

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

Initial revision

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 17.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_CurgridFunctions     
26C     
27      Module Agrif_CurgridFunctions   
28C 
29CCC   Description:
30CCC   Module to define some procedures concerning the current grid
31C
32C     Modules used: 
33C
34      Use Agrif_Init
35C
36      IMPLICIT NONE
37C
38C
39      Contains
40C     Define procedures contained in this module
41C
42C     **************************************************************************
43CCC   Function Agrif_Rhot
44C     **************************************************************************
45C
46      Function Agrif_Rhot()
47C 
48CCC   Description:
49CCC   Function returning the time refinement factor of the current grid.
50C
51C     Declarations:
52C 
53     
54C
55      REAL :: Agrif_Rhot  ! Result
56C
57C     Local scalar     
58      INTEGER :: res         ! Intermediate result
59      INTEGER :: iii
60C
61C
62      res=1
63C
64      do iii = 1 , Agrif_Probdim
65         res = max(res, AGRIF_Curgrid % timeref(iii))
66      enddo
67C
68      Agrif_Rhot = float(res)
69C
70C
71      End function Agrif_rhot
72C
73C
74C
75C
76C     **************************************************************************
77CCC   Function Agrif_IRhot
78C     **************************************************************************
79C
80      Function Agrif_IRhot()
81C 
82CCC   Description:
83CCC   Function returning the time refinement factor of the current grid.
84C
85C     Declarations:
86C 
87     
88C
89      INTEGER :: Agrif_IRhot  ! Result
90C
91C     Local scalar     
92      INTEGER :: res         ! Intermediate result
93      INTEGER :: iii
94C
95C
96      res=1
97C
98      do iii = 1 , Agrif_Probdim
99         res = max(res, AGRIF_Curgrid % timeref(iii))
100      enddo
101C
102      Agrif_IRhot = res
103C
104C
105      End function Agrif_IRhot
106C
107C
108C
109C     **************************************************************************
110CCC   Function Agrif_Parent_Rhot
111C     **************************************************************************
112C
113      Function Agrif_Parent_Rhot()
114C 
115CCC   Description:
116CCC   Function returning the time refinement factor of the parent grid of the 
117CCC   current grid.
118C
119C     Declarations:
120C 
121     
122C
123      REAL :: Agrif_Parent_Rhot  ! Result
124C
125C     Local scalar     
126      INTEGER :: res         ! Intermediate result
127      INTEGER :: iii
128C
129C
130      res=1
131C
132      do iii = 1 , Agrif_Probdim
133         res = max(res, AGRIF_Curgrid % parent % timeref(iii))
134      enddo
135C
136      Agrif_Parent_Rhot = float(res)
137C
138C
139      End function Agrif_Parent_Rhot     
140C
141C
142C     **************************************************************************
143CCC   Function Agrif_Parent_IRhot
144C     **************************************************************************
145C
146      Function Agrif_Parent_IRhot()
147C 
148CCC   Description:
149CCC   Function returning the time refinement factor of the parent grid of the 
150CCC   current grid.
151C
152C     Declarations:
153C 
154     
155C
156      INTEGER :: Agrif_Parent_IRhot  ! Result
157C
158C     Local scalar     
159      INTEGER :: res         ! Intermediate result
160      INTEGER :: iii
161C
162C
163      res=1
164C
165      do iii = 1 , Agrif_Probdim
166         res = max(res, AGRIF_Curgrid % parent % timeref(iii))
167      enddo
168C
169      Agrif_Parent_IRhot = res
170C
171C
172      End function Agrif_Parent_IRhot     
173C
174C
175C     **************************************************************************
176CCC   Function Agrif_Nbstepint
177C     **************************************************************************
178C
179      Function Agrif_Nbstepint()
180C 
181CCC   Description:
182CCC   Function for the calculation of the coefficients used for the time
183CCC   interpolation (module Agrif_Boundary).
184C
185C     Declarations:
186C 
187     
188C           
189      INTEGER :: Agrif_nbstepint  ! result
190C
191C
192      Agrif_nbstepint = mod(AGRIF_CURGRID % ngridstep,
193     &                      int(AGRIF_rhot()))
194C
195C
196      End function Agrif_Nbstepint
197C
198C
199C
200CC    **************************************************************************
201CCC   Function Agrif_Parent_Nbstepint
202C     **************************************************************************
203C
204      Function Agrif_Parent_Nbstepint()
205C 
206CCC   Description:
207CCC   Function for the calculation of the coefficients used for the time
208CCC   interpolation (module Agrif_Boundary).
209C
210C     Declarations:
211C 
212     
213C           
214      INTEGER :: Agrif_Parent_Nbstepint  ! result
215C
216C
217      Agrif_Parent_Nbstepint = mod(AGRIF_CURGRID % parent % ngridstep, 
218     &                             int(AGRIF_Parent_Rhot()))
219C
220C
221      End function Agrif_Parent_Nbstepint
222C
223C     **************************************************************************
224CCC   Subroutine Agrif_InterpNearBorderX
225C     **************************************************************************
226C
227      Subroutine Agrif_InterpNearBorderX()
228C 
229CCC   Description:
230CCC   Subroutine allowing to interpole (in the x direction) on a near border of 
231CCC   the current grid if this one has a common border with the root coarse 
232CCC   grid.   
233C
234C     Declarations:
235C 
236     
237C
238C
239      AGRIF_CURGRID % NearRootBorder(1) = .FALSE.             
240C
241C
242      End Subroutine Agrif_InterpNearBorderX 
243C
244C
245C
246C     **************************************************************************
247CCC   Subroutine Agrif_InterpDistantBorderX
248C     **************************************************************************
249C
250      Subroutine Agrif_InterpDistantBorderX()
251C 
252CCC   Description:
253CCC   Subroutine allowing to interpole (in the x direction) on a distant border 
254CCC   of the current grid if this one has a common border with the root coarse 
255CCC   grid.
256C
257C     Declarations:
258C 
259
260C
261C
262      AGRIF_CURGRID % DistantRootBorder(1) = .FALSE.             
263C
264C
265      End Subroutine Agrif_InterpDistantBorderX                 
266C
267C
268C
269C     **************************************************************************
270CCC   Subroutine Agrif_InterpNearBorderY
271C     **************************************************************************
272C
273      Subroutine Agrif_InterpNearBorderY()
274C 
275CCC   Description:
276CCC   Subroutine allowing to interpole (in the y direction) on a near border of 
277CCC   the current grid if this one has a common border with the root coarse 
278CCC   grid.
279C
280C     Declarations:
281C 
282     
283C
284C
285      AGRIF_CURGRID % NearRootBorder(2) = .FALSE.             
286C
287C
288      End Subroutine Agrif_InterpNearBorderY
289C
290C
291C
292C     **************************************************************************
293CCC   Subroutine Agrif_InterpDistantBorderY
294C     **************************************************************************
295C
296      Subroutine Agrif_InterpDistantBorderY()
297C 
298CCC   Description:
299CCC   Subroutine allowing to interpole (in the y direction) on a distant border 
300CCC   of the current grid if this one has a common border with the root coarse 
301CCC   grid.
302C
303C     Declarations:
304C 
305     
306C
307C
308      AGRIF_CURGRID % DistantRootBorder(2) = .FALSE.             
309C
310C
311      End Subroutine Agrif_InterpDistantBorderY     
312C
313C
314C
315C     **************************************************************************
316CCC   Subroutine Agrif_InterpNearBorderZ
317C     **************************************************************************
318C
319      Subroutine Agrif_InterpNearBorderZ()
320C 
321CCC   Description:
322CCC   Subroutine allowing to interpole (in the z direction) on a near border of 
323CCC   the current grid if this one has a common border with the root coarse 
324CCC   grid.
325C
326C     Declarations:
327C 
328     
329C
330C
331      AGRIF_CURGRID % NearRootBorder(3) = .FALSE.             
332C
333C
334      End Subroutine Agrif_InterpNearBorderZ
335C
336C
337C
338C     **************************************************************************
339CCC   Subroutine Agrif_InterpDistantBorderZ
340C     **************************************************************************
341C
342      Subroutine Agrif_InterpDistantBorderZ()
343C 
344CCC   Description:
345CCC   Subroutine allowing to interpole (in the z direction) on a distant border 
346CCC   of the current grid if this one has a common border with the root coarse 
347CCC   grid.
348C
349C     Declarations:
350C 
351     
352C
353C
354      AGRIF_CURGRID % DistantRootBorder(3) = .FALSE.             
355C
356C
357      End Subroutine Agrif_InterpDistantBorderZ
358C 
359C     **************************************************************************
360CCC   Function Agrif_Parent_Nb_Step
361C     ************************************************************************** 
362C 
363      Function AGRIF_Parent_Nb_Step() 
364C 
365CCC   Description:
366CCC   Function returning the number of time steps of the parent grid of the
367CCC   current grid.
368C
369C     Declarations:
370C   
371     
372C
373      INTEGER :: AGRIF_Parent_Nb_Step ! Result
374C
375C
376      if (Agrif_Root()) then 
377C     
378          Agrif_Parent_Nb_Step = -1 
379C       
380        else
381C       
382          Agrif_Parent_Nb_Step = Agrif_Curgrid % parent % ngridstep
383C     
384      endif
385C
386C     
387      End function Agrif_Parent_Nb_Step   
388C 
389C
390C 
391C     **************************************************************************
392CCC   Function Agrif_Root
393C     **************************************************************************
394C
395      Function Agrif_Root()
396C     
397CCC   Description:
398CCC   Function indicating if the current grid is or not the root grid.
399C
400C     Declarations:
401C
402     
403C
404      LOGICAL :: Agrif_Root   ! Result
405C   
406C
407      if (AGRIF_CURGRID % fixedrank .EQ. 0) then
408C         
409          Agrif_Root = .TRUE.
410C   
411        else
412C   
413          Agrif_Root = .FALSE.
414C     
415      endif
416C
417C   
418      End function Agrif_Root
419C
420C
421C
422C     **************************************************************************
423CCC   Function Agrif_Parent_Root
424C     **************************************************************************
425C
426      Function Agrif_Parent_Root()
427C     
428CCC   Description:
429CCC   Function indicating if the parent grid of the current grid is or not the 
430CCC   root grid.
431C
432C     Declarations:
433C
434     
435C
436      LOGICAL :: Agrif_Parent_Root   ! Result
437C   
438C
439      if (AGRIF_CURGRID % parent % fixedrank .EQ. 0) then
440C         
441          Agrif_Parent_Root = .TRUE.
442C   
443        else
444C   
445          Agrif_Parent_Root = .FALSE.
446C     
447      endif
448C
449C   
450      End function Agrif_Parent_Root     
451C 
452C
453C 
454C     **************************************************************************
455CCC   Function Agrif_Fixed
456C     **************************************************************************
457C 
458      Function Agrif_Fixed()
459C 
460CCC   Description:
461CCC   Function returning the number of the current grid.
462C
463C     Declarations:
464C   
465     
466C
467      INTEGER Agrif_Fixed   ! Result
468C 
469C
470      if (Agrif_Curgrid % fixed) then
471C     
472          Agrif_Fixed = Agrif_Curgrid % fixedrank 
473C
474        else
475C     
476         Agrif_Fixed = -1
477C       
478      endif
479C
480C     
481      End function Agrif_Fixed 
482C
483C
484C
485C     **************************************************************************
486CCC   Function Agrif_Parent_Fixed
487C     **************************************************************************
488 
489      Function Agrif_Parent_Fixed()
490C 
491CCC   Description:
492CCC   Function returning the number of the parent grid of the current grid.
493C
494C     Declarations:
495C   
496     
497C
498      INTEGER Agrif_Parent_Fixed   ! Result
499C 
500C
501      if (Agrif_Curgrid % parent % fixed) then
502C     
503          Agrif_Parent_Fixed = AGRIF_CURGRID % parent % fixedrank 
504C
505        else
506C     
507         Agrif_Parent_Fixed = 0
508C       
509      endif
510C
511C     
512      End function Agrif_Parent_Fixed
513C
514C
515C
516C     **************************************************************************
517CCC   Function Agrif_Is_Fixed
518C     **************************************************************************
519 
520      Function Agrif_Is_Fixed()
521C 
522CCC   Description:
523CCC   Function returning true if the current grid is fixed.
524C
525C     Declarations:
526C   
527     
528C
529      LOGICAL Agrif_Is_Fixed   ! Result
530C 
531C
532      if (Agrif_Curgrid % fixed) then
533C     
534          Agrif_Is_Fixed = .true.
535C
536        else
537C     
538          Agrif_Is_Fixed = .false.
539C       
540      endif
541C
542C     
543      End function Agrif_Is_Fixed
544C
545C
546C
547C     **************************************************************************
548CCC   Function Agrif_Parent_Is_Fixed
549C     **************************************************************************
550 
551      Function Agrif_Parent_Is_Fixed()
552C 
553CCC   Description:
554CCC   Function returning true if the parent grid of the current grid is fixed.
555C
556C     Declarations:
557C   
558     
559C
560      LOGICAL Agrif_Parent_Is_Fixed   ! Result
561C 
562C
563      if (Agrif_Curgrid % parent % fixed) then
564C     
565          Agrif_Parent_Is_Fixed = .true.
566C
567        else
568C     
569          Agrif_Parent_Is_Fixed = .false.
570C       
571      endif
572C
573C     
574      End function Agrif_Parent_Is_Fixed           
575C
576C 
577C
578C     **************************************************************************
579CCC   Function AGRIF_CFixed
580C     **************************************************************************
581 
582            Function AGRIF_CFixed()
583C 
584CCC   Description:
585CCC   Function returning the number of the current grid.
586C
587C     Declarations:
588C   
589     
590C
591      CHARACTER(3) AGRIF_CFixed   ! Result
592C
593C     Local variables     
594      CHARACTER(3) cfixed
595      INTEGER fixed
596C 
597C
598      fixed = Agrif_Fixed()
599C     
600      if(fixed.NE.-1) then
601C
602           if (fixed .LE. 9) then
603C
604               write(cfixed,'(i1)')fixed
605C 
606           else
607C   
608               write(cfixed,'(i2)')fixed
609C     
610           endif
611C
612           AGrif_Cfixed=cfixed
613C     
614      else
615C
616      print*,'Call to AGRIF_CFixed() on a moving grid'
617      stop
618C
619      endif     
620
621      End function AGRIF_CFixed
622C
623C
624C
625C     **************************************************************************
626CCC   Function AGRIF_Parent_CFixed
627C     **************************************************************************
628 
629      Function AGRIF_Parent_CFixed()
630C 
631CCC   Description:
632CCC   Function returning the number of the parent grid of the current grid.
633C
634C     Declarations:
635C   
636     
637C
638      CHARACTER(3) AGRIF_Parent_CFixed   ! Result
639C
640C     Local variables     
641      CHARACTER(3) cfixed
642      INTEGER fixed
643C 
644C
645      fixed = Agrif_Parent_Fixed()
646C     
647      if(fixed.NE.-1) then
648C
649          if (fixed .LE. 9) then
650C
651              write(cfixed,'(i1)')fixed
652C     
653          else
654C       
655              write(cfixed,'(i2)')fixed
656C     
657          endif
658C
659          AGrif_Parent_Cfixed=cfixed
660C
661      else
662C
663      print*,'Illegal call to AGRIF_Parent_CFixed()'
664      stop     
665C
666      endif
667
668      End function AGRIF_Parent_CFixed     
669C
670C
671C
672C     **************************************************************************
673CCC   Subroutine Agrif_ChildGrid_to_ParentGrid
674C     **************************************************************************
675C
676      Subroutine Agrif_ChildGrid_to_ParentGrid()
677C 
678CCC   Description:
679CCC   Subroutine allowing to make the pointer AGRIF_CURGRID point on the parent
680CCC   grid of the current grid.
681C
682C     Declarations:
683C 
684     
685C
686C
687      AGRIF_saveCURGRID => AGRIF_CURGRID
688C
689      Call AGRIF_INSTANCE(AGRIF_CURGRID%parent)           
690C
691C
692      End Subroutine Agrif_ChildGrid_to_ParentGrid
693C
694C
695C
696C     **************************************************************************
697CCC   Subroutine Agrif_ParentGrid_to_ChildGrid
698C     **************************************************************************
699C
700      Subroutine Agrif_ParentGrid_to_ChildGrid()
701C 
702CCC   Description:
703CCC   Subroutine allowing to make the pointer AGRIF_CURGRID point on the child 
704CCC   grid after having called the Agrif_ChildGrid_to_ParentGrid subroutine.
705C
706C     Declarations:
707C 
708     
709C
710C
711      Call AGRIF_INSTANCE(AGRIF_saveCURGRID)           
712C
713C
714      End Subroutine Agrif_ParentGrid_to_ChildGrid
715C
716C
717C
718C     **************************************************************************
719CCC   Function Agrif_Get_Unit
720C     **************************************************************************
721C
722      Function Agrif_Get_Unit()
723
724CCC   Description : return a unit not connected to any file
725C
726C     Declarations
727C
728     
729C
730      INTEGER Agrif_Get_Unit
731C
732C     Local scalars
733      INTEGER n
734      LOGICAL op
735C
736      INTEGER :: nunit
737      INTEGER :: iii,out,iiimax
738      Logical :: BEXIST
739      INTEGER,DIMENSION(1:10) :: ForbiddenUnit
740C
741C
742C     Load forbidden Unit if the file Agrif_forbidenUnit exist
743C     
744
745      INQUIRE(FILE='Agrif_forbiddenUnit.txt',EXIST=BEXIST)
746      If (.not. BEXIST) Then
747c          File Agrif_forbiddenUnit.txt not found
748      Else
749           nunit = 777
750           open(nunit,file='Agrif_forbiddenUnit.txt',form='formatted',
751     &          status="old")
752              iii = 1
753              do while ( .TRUE. )
754                 read(nunit,*,END = 99) ForbiddenUnit(iii)
755                 iii = iii + 1
756              enddo
757   99         CONTINUE
758              iiimax = iii
759           close(nunit)
760      endif     
761C 
762      do n = 7,1000
763C 
764        Inquire(Unit=n,Opened=op)
765C
766        out = 0
767        if ( BEXIST .AND. .NOT.op) then
768           do iii = 1 , iiimax
769              if ( n .EQ. ForbiddenUnit(iii) ) out = 1
770           enddo
771        endif
772C
773        if (.NOT.op .AND. out .EQ. 0) exit
774C     
775      enddo
776C
777      Agrif_Get_Unit=n
778C
779C
780      End Function Agrif_Get_Unit
781C
782      End Module Agrif_CurgridFunctions 
Note: See TracBrowser for help on using the repository browser.