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.
modcurgridfunctions.F90 in vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES – NEMO

source: vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES/modcurgridfunctions.F90 @ 13027

Last change on this file since 13027 was 13027, checked in by rblod, 4 years ago

New AGRIF library, see ticket #2129

  • Property svn:keywords set to Id
File size: 45.7 KB
RevLine 
[4777]1!
2! $Id$
3!
4!     AGRIF (Adaptive Grid Refinement In Fortran)
5!
6!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
7!                        Christophe Vouland (Christophe.Vouland@imag.fr)
8!
9!     This program is free software; you can redistribute it and/or modify
10!     it under the terms of the GNU General Public License as published by
11!     the Free Software Foundation; either version 2 of the License, or
12!     (at your option) any later version.
13!
14!     This program is distributed in the hope that it will be useful,
15!     but WITHOUT ANY WARRANTY; without even the implied warranty of
16!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17!     GNU General Public License for more details.
18!
19!     You should have received a copy of the GNU General Public License
20!     along with this program; if not, write to the Free Software
21!     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
22!
23!> Module to define some procedures concerning the current grid
24!
25module Agrif_CurgridFunctions
26!
27    use Agrif_Init
28!
29    implicit none
30!
[13027]31
32    interface Agrif_Parent
33        module procedure Agrif_Parent_Real_4,   &
34                         Agrif_Parent_Real_8,   &
35                         Agrif_Parent_Array2_Real_8,   &
36                         Agrif_Parent_Integer, &
37                         Agrif_Parent_Character, &
38                         Agrif_Parent_Logical
39    end interface
40    interface Agrif_Child
41        module procedure Agrif_Child_Logical
42    end interface
43   
[4777]44contains
45!
46!===================================================================================================
47!  function Agrif_rel_dt
48!
49!> Returns the time step of the current grid, relatively to the root grid (for which dt=1.).
50!---------------------------------------------------------------------------------------------------
51function Agrif_rel_dt ( ) result( rel_dt )
52!---------------------------------------------------------------------------------------------------
53    integer :: i
54    real    :: rel_dt
55!
56    rel_dt = 1.
57!
58    do i = 1,Agrif_Probdim
59        rel_dt = min(rel_dt, Agrif_Curgrid % Agrif_dt(i))
60    enddo
61!---------------------------------------------------------------------------------------------------
62end function Agrif_rel_dt
63!===================================================================================================
64!
65!===================================================================================================
66!  function Agrif_rel_idt
67!
68!> Returns the time refinement factor of the current grid, relatively to the root grid (for which idt=1).
69!---------------------------------------------------------------------------------------------------
70function Agrif_rel_idt ( ) result( rel_idt )
71!---------------------------------------------------------------------------------------------------
72    integer :: rel_idt
73!
74    rel_idt = nint(1./Agrif_rel_dt())
75!---------------------------------------------------------------------------------------------------
76end function Agrif_rel_idt
77!===================================================================================================
78!
79!===================================================================================================
80!  function Agrif_IRhot
81!
82!> Returns the time refinement factor of the current grid.
83!---------------------------------------------------------------------------------------------------
84function Agrif_IRhot ( ) result( irhot )
85!---------------------------------------------------------------------------------------------------
86    integer :: i, irhot
87!
88    irhot = 1
89!
90    do i = 1,Agrif_Probdim
91        irhot = max(irhot, Agrif_Curgrid % timeref(i))
92    enddo
93!---------------------------------------------------------------------------------------------------
94end function Agrif_IRhot
95!===================================================================================================
96!
97!===================================================================================================
98!  function Agrif_Rhot
99!
100!> Returns the time refinement factor of the current grid.
101!---------------------------------------------------------------------------------------------------
102function Agrif_Rhot ( ) result( rhot )
103!---------------------------------------------------------------------------------------------------
104    real    :: rhot
105!
106    rhot = float(Agrif_IRhot())
107!---------------------------------------------------------------------------------------------------
108end function Agrif_Rhot
109!===================================================================================================
110!
111!===================================================================================================
112!  function Agrif_Parent_IRhot
113!
114!> Returns the time refinement factor of the parent of the current grid.
115!---------------------------------------------------------------------------------------------------
116function Agrif_Parent_IRhot ( ) result( irhot )
117!---------------------------------------------------------------------------------------------------
118    integer :: i, irhot
119!
120    irhot = 1
121!
122    do i = 1,Agrif_Probdim
123        irhot = max(irhot, Agrif_Curgrid % parent % timeref(i))
124    enddo
125!---------------------------------------------------------------------------------------------------
126end function Agrif_Parent_IRhot
127!===================================================================================================
128!
129!===================================================================================================
130!  function Agrif_Parent_Rhot
131!
132!> Returns the time refinement factor of the parent of the current grid.
133!---------------------------------------------------------------------------------------------------
134function Agrif_Parent_Rhot ( ) result( rhot )
135!---------------------------------------------------------------------------------------------------
136    real :: rhot
137!
138    rhot = float(Agrif_Parent_IRhot())
139!---------------------------------------------------------------------------------------------------
140end function Agrif_Parent_Rhot
141!===================================================================================================
142!
143!===================================================================================================
144!  function Agrif_Nbstepint
145!
146!> function for the calculation of the coefficients used for the time interpolation
147!! (module #Agrif_Boundary).
148!---------------------------------------------------------------------------------------------------
149function Agrif_Nbstepint ( )
150!---------------------------------------------------------------------------------------------------
151    integer :: Agrif_nbstepint ! result
152!
153    Agrif_nbstepint = mod(Agrif_Curgrid % ngridstep, Agrif_iRhot())
154!---------------------------------------------------------------------------------------------------
155end function Agrif_Nbstepint
156!===================================================================================================
157!
158!===================================================================================================
159!  function Agrif_Parent_Nbstepint
160!
161!> function for the calculation of the coefficients used for the time interpolation
162!! (module #Agrif_Boundary).
163!---------------------------------------------------------------------------------------------------
164function Agrif_Parent_Nbstepint ( )
165!---------------------------------------------------------------------------------------------------
166    integer :: Agrif_Parent_Nbstepint ! result
167!
168    Agrif_Parent_Nbstepint = mod(Agrif_Curgrid % parent % ngridstep, int(Agrif_Parent_Rhot()))
169!---------------------------------------------------------------------------------------------------
170end function Agrif_Parent_Nbstepint
171!===================================================================================================
172!
173!===================================================================================================
174!  subroutine Agrif_InterpNearBorderX
175!
176!> Allows to interpolate (in the x direction) on a near border of the current grid if this one
177!! has a common border with the root coarse grid.
178!---------------------------------------------------------------------------------------------------
179subroutine Agrif_InterpNearBorderX ( )
180!---------------------------------------------------------------------------------------------------
181    Agrif_Curgrid % NearRootBorder(1) = .FALSE.
182!---------------------------------------------------------------------------------------------------
183end subroutine Agrif_InterpNearBorderX
184!===================================================================================================
185!
186!===================================================================================================
187!  subroutine Agrif_InterpDistantBorderX
188!
189!> Allows to interpolate (in the x direction) on a distant border of the current grid if this one
190!! has a common border with the root coarse grid.
191!---------------------------------------------------------------------------------------------------
192subroutine Agrif_InterpDistantBorderX ( )
193!---------------------------------------------------------------------------------------------------
194    Agrif_Curgrid % DistantRootBorder(1) = .FALSE.
195!---------------------------------------------------------------------------------------------------
196end subroutine Agrif_InterpDistantBorderX
197!===================================================================================================
198!
199!===================================================================================================
200!  subroutine Agrif_InterpNearBorderY
201!
202!> Allows to interpolate (in the y direction) on a near border of the current grid if this one
203!! has a common border with the root coarse grid.
204!---------------------------------------------------------------------------------------------------
205subroutine Agrif_InterpNearBorderY ( )
206!---------------------------------------------------------------------------------------------------
207    Agrif_Curgrid % NearRootBorder(2) = .FALSE.
208!---------------------------------------------------------------------------------------------------
209end subroutine Agrif_InterpNearBorderY
210!===================================================================================================
211!
212!===================================================================================================
213!  subroutine Agrif_InterpDistantBorderY
214!
215!> Allows to interpolate (in the y direction) on a distant border of the current grid if this one
216!! has a common border with the root coarse grid.
217!---------------------------------------------------------------------------------------------------
218subroutine Agrif_InterpDistantBorderY ( )
219!---------------------------------------------------------------------------------------------------
220    Agrif_Curgrid % DistantRootBorder(2) = .FALSE.
221!---------------------------------------------------------------------------------------------------
222end subroutine Agrif_InterpDistantBorderY
223!===================================================================================================
224!
225!===================================================================================================
226!  subroutine Agrif_InterpNearBorderZ
227!
228!> Allows to interpolate (in the z direction) on a near border of the current grid if this one
229!! has a common border with the root coarse grid.
230!---------------------------------------------------------------------------------------------------
231subroutine Agrif_InterpNearBorderZ ( )
232!---------------------------------------------------------------------------------------------------
233    Agrif_Curgrid % NearRootBorder(3) = .FALSE.
234!---------------------------------------------------------------------------------------------------
235end subroutine Agrif_InterpNearBorderZ
236!===================================================================================================
237!
238!===================================================================================================
239!  subroutine Agrif_InterpDistantBorderZ
240!
241!> Allows to interpolate (in the z direction) on a distant border of the current grid if this one
242!! has a common border with the root coarse grid.
243!---------------------------------------------------------------------------------------------------
244subroutine Agrif_InterpDistantBorderZ()
245!---------------------------------------------------------------------------------------------------
246    Agrif_Curgrid % DistantRootBorder(3) = .FALSE.
247!---------------------------------------------------------------------------------------------------
248end subroutine Agrif_InterpDistantBorderZ
249!===================================================================================================
250!
251!===================================================================================================
252!  function Agrif_Parent_Nb_Step
253!
254!> Returns the number of time steps of the parent of the current grid.
255!---------------------------------------------------------------------------------------------------
256function Agrif_Parent_Nb_Step ( )
257!---------------------------------------------------------------------------------------------------
258    integer :: Agrif_Parent_Nb_Step ! Result
259!
260    if (Agrif_Root()) then
261        Agrif_Parent_Nb_Step = -1
262    else
263        Agrif_Parent_Nb_Step = Agrif_Curgrid % parent % ngridstep
264    endif
265!---------------------------------------------------------------------------------------------------
266end function Agrif_Parent_Nb_Step
267!===================================================================================================
268!
269!===================================================================================================
270!  function Agrif_Root
271!
272!> Indicates if the current grid is or not the root grid.
273!---------------------------------------------------------------------------------------------------
274function Agrif_Root ( )
275!---------------------------------------------------------------------------------------------------
276    logical :: Agrif_Root ! Result
277!
278    Agrif_Root = (Agrif_Curgrid % fixedrank == 0)
279!---------------------------------------------------------------------------------------------------
280end function Agrif_Root
281!===================================================================================================
282!
283!===================================================================================================
284!  function Agrif_GrandMother
285!
286!> Indicates if the current grid is or not the root grid.
287!---------------------------------------------------------------------------------------------------
288function Agrif_GrandMother ( )
289!---------------------------------------------------------------------------------------------------
290    logical :: Agrif_GrandMother ! Result
291!
292    Agrif_GrandMother = Agrif_Curgrid % grand_mother_grid
293!---------------------------------------------------------------------------------------------------
294end function Agrif_GrandMother
295!===================================================================================================
296!
297!===================================================================================================
298!  function Agrif_Parent_Root
299!
300!> Indicates if the parent of the current grid is or not the root grid.
301!---------------------------------------------------------------------------------------------------
302function Agrif_Parent_Root ( )
303!---------------------------------------------------------------------------------------------------
304    logical :: Agrif_Parent_Root ! Result
305!
306    Agrif_Parent_Root = (Agrif_Curgrid % parent % fixedrank == 0)
307!---------------------------------------------------------------------------------------------------
308end function Agrif_Parent_Root
309!===================================================================================================
310!
311!===================================================================================================
312!  function Agrif_Fixed
313!
314!> Returns the number of the current grid.
315!---------------------------------------------------------------------------------------------------
316function Agrif_Fixed ( )
317!---------------------------------------------------------------------------------------------------
318    integer :: Agrif_Fixed   ! Result
319!
320    if (Agrif_Curgrid % fixed) then
321        Agrif_Fixed = Agrif_Curgrid % fixedrank
322    else
323        Agrif_Fixed = -1
324    endif
325!---------------------------------------------------------------------------------------------------
326end function Agrif_Fixed
327!===================================================================================================
328!
329!===================================================================================================
330!  function Agrif_Parent_Fixed
331!
332!> Returns the number of the parent of the current grid.
333!---------------------------------------------------------------------------------------------------
334function Agrif_Parent_Fixed ( )
335!---------------------------------------------------------------------------------------------------
336    integer :: Agrif_Parent_Fixed   ! Result
337!
338    if (Agrif_Curgrid % parent % fixed) then
339        Agrif_Parent_Fixed = Agrif_Curgrid % parent % fixedrank
340    else
341        Agrif_Parent_Fixed = 0
342    endif
343!---------------------------------------------------------------------------------------------------
344end function Agrif_Parent_Fixed
345!===================================================================================================
346!
347!===================================================================================================
348!  function Agrif_Is_Fixed
349!
350!> Returns .TRUE. if the current grid is fixed.
351!---------------------------------------------------------------------------------------------------
352function Agrif_Is_Fixed ( )
353!---------------------------------------------------------------------------------------------------
354    logical :: Agrif_Is_Fixed   ! Result
355!
356    Agrif_Is_Fixed = Agrif_Curgrid % fixed
357!---------------------------------------------------------------------------------------------------
358end function Agrif_Is_Fixed
359!===================================================================================================
360!
361!===================================================================================================
362!  function Agrif_Parent_Is_Fixed
363!
364!> Returns .TRUE. if the parent of the current grid is fixed.
365!---------------------------------------------------------------------------------------------------
366function Agrif_Parent_Is_Fixed ( )
367!---------------------------------------------------------------------------------------------------
368    logical :: Agrif_Parent_Is_Fixed   ! Result
369!
370    Agrif_Parent_Is_Fixed = Agrif_Curgrid % parent % fixed
371!---------------------------------------------------------------------------------------------------
372end function Agrif_Parent_Is_Fixed
373!===================================================================================================
374!
375!===================================================================================================
376!  function Agrif_CFixed
377!
378!> Returns the number of the current grid.
379!---------------------------------------------------------------------------------------------------
380function Agrif_CFixed ( )
381!---------------------------------------------------------------------------------------------------
382    character(3) :: Agrif_CFixed   ! Result
383!
384    character(3) :: cfixed
385    integer      :: fixed
386!
387    fixed = Agrif_Fixed()
388!
389    if (fixed /= -1) then
390!
391        if (fixed <= 9) then
392            write(cfixed,'(i1)') fixed
393        else
394            write(cfixed,'(i2)') fixed
395        endif
396!
397        Agrif_CFixed = cfixed
398       
399        if (associated(agrif_curgrid,agrif_coarsegrid)) then
400          Agrif_CFixed = 'gm'
401        endif
402!
403    else
404        print*,'Call to Agrif_CFixed() on a moving grid'
405        stop
406    endif
407!---------------------------------------------------------------------------------------------------
408end function Agrif_CFixed
409!===================================================================================================
410!
411!===================================================================================================
412!  function Agrid_Parent_CFixed
413!
414!> Returns the number of the parent of the current grid.
415!---------------------------------------------------------------------------------------------------
416function Agrid_Parent_CFixed ( )
417!---------------------------------------------------------------------------------------------------
418    character(3) :: Agrid_Parent_CFixed   ! Result
419!
420    character(3) :: cfixed
421    integer      :: fixed
422!
423    fixed = Agrif_Parent_Fixed()
424!
425    if(fixed /= -1) then
426!
427        if (fixed <= 9) then
428            write(cfixed,'(i1)')fixed
429        else
430            write(cfixed,'(i2)')fixed
431        endif
432!
433        Agrid_Parent_CFixed=cfixed
434!
435    else
436        print*,'Illegal call to Agrid_Parent_CFixed()'
437        stop
438    endif
439!---------------------------------------------------------------------------------------------------
440end function Agrid_Parent_CFixed
441!===================================================================================================
442!
443!===================================================================================================
444!  subroutine Agrif_ChildGrid_to_ParentGrid
445!
446!> Make the pointer #Agrif_Curgrid point on the parent grid of the current grid.
447!---------------------------------------------------------------------------------------------------
448subroutine Agrif_ChildGrid_to_ParentGrid ( )
449!---------------------------------------------------------------------------------------------------
450    Agrif_Curgrid % parent % save_grid => Agrif_Curgrid
451    call Agrif_Instance(Agrif_Curgrid%parent)
452!---------------------------------------------------------------------------------------------------
453end subroutine Agrif_ChildGrid_to_ParentGrid
454!===================================================================================================
455!
456!===================================================================================================
457!  subroutine Agrif_ParentGrid_to_ChildGrid
458!
459!> Make the pointer #Agrif_Curgrid point on the child grid after having called the
460!! #Agrif_ChildGrid_to_ParentGrid subroutine.
461!---------------------------------------------------------------------------------------------------
462subroutine Agrif_ParentGrid_to_ChildGrid ( )
463!---------------------------------------------------------------------------------------------------
464    call Agrif_Instance(Agrif_Curgrid%save_grid)
465!---------------------------------------------------------------------------------------------------
466end subroutine Agrif_ParentGrid_to_ChildGrid
467!===================================================================================================
468!
469!===================================================================================================
470!  function Agrif_Get_Unit
471!
472!> Returns a unit not connected to any file.
473!---------------------------------------------------------------------------------------------------
474function Agrif_Get_Unit ( )
475!---------------------------------------------------------------------------------------------------
476    integer :: Agrif_Get_Unit  ! Result
477!
478    integer :: n
479    logical :: op
480!
481    integer :: nunit
482    integer :: iii, out, iiimax
483    logical :: bexist
484    integer,dimension(1:1000) :: forbiddenunit
485!
486!   Load forbidden Unit if the file Agrif_forbidenUnit exist
487!
488    INQUIRE(file='Agrif_forbiddenUnit.txt', exist=bexist)
489!
490    if (.not. bexist) then
491!       File Agrif_forbiddenUnit.txt not found
492    else
493        nunit = 777
494        OPEN(nunit,file='Agrif_forbiddenUnit.txt', form='formatted', status="old")
495        iii = 1
496        do while ( .TRUE. )
497            READ(nunit,*, end=99) forbiddenunit(iii)
498            iii = iii + 1
499        enddo
500   99   continue
501        iiimax = iii
502        close(nunit)
503    endif
504!
505    do n = 7,1000
506!
507        INQUIRE(Unit=n,Opened=op)
508!
509        out = 0
510        if ( bexist .AND. (.NOT.op) ) then
511            do iii = 1,iiimax
512                if ( n == forbiddenunit(iii) ) out = 1
513            enddo
514        endif
515!
516        if ( (.NOT.op) .AND. (out == 0) ) exit
517!
518    enddo
519!
520    Agrif_Get_Unit = n
521!---------------------------------------------------------------------------------------------------
522end function Agrif_Get_Unit
523!===================================================================================================
524!
525!===================================================================================================
526!  subroutine Agrif_Set_Extra_Boundary_Cells
527!---------------------------------------------------------------------------------------------------
528subroutine Agrif_Set_Extra_Boundary_Cells ( nb_extra_cells )
529!---------------------------------------------------------------------------------------------------
530    integer, intent(in) :: nb_extra_cells
531!
532    Agrif_Extra_Boundary_Cells = nb_extra_cells
533!---------------------------------------------------------------------------------------------------
534end subroutine Agrif_Set_Extra_Boundary_Cells
535!===================================================================================================
536!
537!===================================================================================================
538!  subroutine Agrif_Set_Efficiency
539!---------------------------------------------------------------------------------------------------
540subroutine Agrif_Set_Efficiency ( eff )
541!---------------------------------------------------------------------------------------------------
542    real, intent(in) :: eff
543!
544    if ( (eff < 0.) .OR. (eff > 1) ) then
545        write(*,*) 'Error Efficiency should be between 0 and 1'
546        stop
547    else
548        Agrif_Efficiency = eff
549    endif
550!---------------------------------------------------------------------------------------------------
551end subroutine Agrif_Set_Efficiency
552!===================================================================================================
553!
554!===================================================================================================
555!  subroutine Agrif_Set_Regridding
556!---------------------------------------------------------------------------------------------------
557subroutine Agrif_Set_Regridding ( regfreq )
558!---------------------------------------------------------------------------------------------------
559    integer, intent(in) :: regfreq
560!
561    if (regfreq < 0) then
562        write(*,*) 'Regridding frequency should be positive'
563        stop
564    else
565        Agrif_Regridding = regfreq
566    endif
567!---------------------------------------------------------------------------------------------------
568end subroutine Agrif_Set_Regridding
569!===================================================================================================
570!
571!===================================================================================================
572!  subroutine Agrif_Set_coeffref_x
573!---------------------------------------------------------------------------------------------------
574subroutine Agrif_Set_coeffref_x ( coeffref )
575!---------------------------------------------------------------------------------------------------
576    integer, intent(in) :: coeffref
577
578      if (coeffref < 0) then
579         write(*,*) 'Coefficient of raffinement should be positive'
580         stop
581      else
582         Agrif_coeffref(1) = coeffref
583      endif
584!---------------------------------------------------------------------------------------------------
585end subroutine Agrif_Set_coeffref_x
586!===================================================================================================
587!
588!===================================================================================================
589!  subroutine Agrif_Set_coeffref_y
590!---------------------------------------------------------------------------------------------------
591subroutine Agrif_Set_coeffref_y ( coeffref )
592!---------------------------------------------------------------------------------------------------
593    integer, intent(in) :: coeffref
594
595    if (coeffref < 0) then
596        write(*,*) 'Coefficient of raffinement should be positive'
597        stop
598    else
599        Agrif_coeffref(2) = coeffref
600    endif
601!---------------------------------------------------------------------------------------------------
602end subroutine Agrif_Set_coeffref_y
603!===================================================================================================
604!
605!===================================================================================================
606!  subroutine Agrif_Set_coeffref_z
607!---------------------------------------------------------------------------------------------------
608subroutine Agrif_Set_coeffref_z ( coeffref )
609!---------------------------------------------------------------------------------------------------
610    integer, intent(in) :: coeffref
611!
612    if (coeffref < 0) then
613        write(*,*) 'Coefficient of raffinement should be positive'
614        stop
615    else
616        Agrif_coeffref(3) = coeffref
617    endif
618!---------------------------------------------------------------------------------------------------
619end subroutine Agrif_Set_coeffref_z
620!===================================================================================================
621!
622!===================================================================================================
623!  subroutine Agrif_Set_coeffreft_x
624!---------------------------------------------------------------------------------------------------
625subroutine Agrif_Set_coeffreft_x ( coeffref )
626!---------------------------------------------------------------------------------------------------
627    integer, intent(in) :: coeffref
628
629    if (coeffref < 0) then
630        write(*,*) 'Coefficient of time raffinement should be positive'
631        stop
632    else
633        Agrif_coeffreft(1) = coeffref
634    endif
635!---------------------------------------------------------------------------------------------------
636end subroutine Agrif_Set_coeffreft_x
637!===================================================================================================
638!
639!===================================================================================================
640!  subroutine Agrif_Set_coeffreft_y
641!---------------------------------------------------------------------------------------------------
642subroutine Agrif_Set_coeffreft_y ( coeffref )
643!---------------------------------------------------------------------------------------------------
644    integer, intent(in) :: coeffref
645!
646    if (coeffref < 0) then
647        write(*,*) 'Coefficient of time raffinement should be positive'
648        stop
649    else
650        Agrif_coeffreft(2) = coeffref
651    endif
652!---------------------------------------------------------------------------------------------------
653end subroutine Agrif_Set_coeffreft_y
654!===================================================================================================
655!
656!===================================================================================================
657!  subroutine Agrif_Set_coeffreft_z
658!---------------------------------------------------------------------------------------------------
659subroutine Agrif_Set_coeffreft_z ( coeffref )
660!---------------------------------------------------------------------------------------------------
661    integer, intent(in) :: coeffref
662
663    if (coeffref < 0) then
664        write(*,*)'Coefficient of time raffinement should be positive'
665        stop
666    else
667        Agrif_coeffreft(3) = coeffref
668    endif
669!---------------------------------------------------------------------------------------------------
670end subroutine Agrif_Set_coeffreft_z
671!===================================================================================================
[13027]672!  subroutine Agrif_Set_coeffreft
673!---------------------------------------------------------------------------------------------------
674subroutine Agrif_Set_coeffreft ( coeffref )
675!---------------------------------------------------------------------------------------------------
676    integer, intent(in) :: coeffref
677    integer :: i
678
679    if (coeffref < 0) then
680        write(*,*)'Coefficient of time raffinement should be positive'
681        stop
682    else
683        do i=1,Agrif_Probdim
684          Agrif_coeffreft(i) = coeffref
685          Agrif_Curgrid % timeref(i) = coeffref
686        enddo
687    endif
688!---------------------------------------------------------------------------------------------------
689end subroutine Agrif_Set_coeffreft
690!===================================================================================================
[4777]691!
692!===================================================================================================
693!  subroutine Agrif_Set_Minwidth
694!---------------------------------------------------------------------------------------------------
695subroutine Agrif_Set_Minwidth ( coefminwidth )
696!---------------------------------------------------------------------------------------------------
697    integer, intent(in) :: coefminwidth
698!
699    if (coefminwidth < 0) then
700        write(*,*)'Coefficient of Minwidth should be positive'
701        stop
702    else
703        Agrif_Minwidth = coefminwidth
704    endif
705!---------------------------------------------------------------------------------------------------
706end subroutine Agrif_Set_Minwidth
707!===================================================================================================
708!
709!===================================================================================================
710!  subroutine Agrif_Set_Rafmax
711!---------------------------------------------------------------------------------------------------
712subroutine Agrif_Set_Rafmax ( coefrafmax )
713!---------------------------------------------------------------------------------------------------
714    integer, intent(in) :: coefrafmax
715!
716    integer :: i
717    real    :: res
718!
719    if (coefrafmax < 0) then
720        write(*,*)'Coefficient of  should be positive'
721        stop
722    else
723        res = 1.
724        do i = 1,coefrafmax-1
725            res = res * FLOAT(Agrif_coeffref(1))
726        enddo
727        if ( res == 0 ) res = 1
728        Agrif_Mind(1) = 1. / res
729!
730        res = 1.
731        do i = 1,coefrafmax-1
732            res = res * FLOAT(Agrif_coeffref(2))
733        enddo
734        if ( res == 0 ) res = 1
735        Agrif_Mind(2) = 1. / res
736!
737        res = 1.
738        do i = 1,coefrafmax-1
739            res = res * FLOAT(Agrif_coeffref(3))
740        enddo
741        if ( res == 0 ) res = 1
742        Agrif_Mind(3) = 1. / res
743!
744      endif
745!---------------------------------------------------------------------------------------------------
746end subroutine Agrif_Set_Rafmax
747!===================================================================================================
748!
749!===================================================================================================
750!  subroutine Agrif_Set_MaskMaxSearch
751!---------------------------------------------------------------------------------------------------
752subroutine Agrif_Set_MaskMaxSearch ( mymaxsearch )
753!---------------------------------------------------------------------------------------------------
754    integer, intent(in) :: mymaxsearch
755!
756    MaxSearch = mymaxsearch
757!---------------------------------------------------------------------------------------------------
758end subroutine Agrif_Set_MaskMaxSearch
759!===================================================================================================
760!
761!===================================================================================================
762!  function Agrif_Level
763!---------------------------------------------------------------------------------------------------
764function Agrif_Level ( )
765!---------------------------------------------------------------------------------------------------
766    integer :: Agrif_Level  ! Result
767!
768    Agrif_Level = Agrif_Curgrid % level
769!---------------------------------------------------------------------------------------------------
770end function Agrif_Level
771!===================================================================================================
[13027]772!===================================================================================================
773!  subroutine Agrif_set_periodicity
774!---------------------------------------------------------------------------------------------------
775
776subroutine Agrif_set_periodicity(i,decal)
777!---------------------------------------------------------------------------------------------------
778    integer :: i, decal
779   
780    Agrif_curgrid%periodicity(i)=.TRUE.
781    Agrif_curgrid%periodicity_decal(i)=decal
782   
783!---------------------------------------------------------------------------------------------------
784end subroutine Agrif_set_periodicity
[4777]785!
786!===================================================================================================
787!  function Agrif_MaxLevel
788!---------------------------------------------------------------------------------------------------
789function Agrif_MaxLevel ( )
790!---------------------------------------------------------------------------------------------------
791    integer :: Agrif_MaxLevel  ! Result
792!
793    Agrif_MaxLevel = Agrif_MaxLevelLoc
794!---------------------------------------------------------------------------------------------------
795end function Agrif_MaxLevel
796!===================================================================================================
797!
798!===================================================================================================
799!  function Agrif_GridAllocation_is_done
800!---------------------------------------------------------------------------------------------------
801function Agrif_GridAllocation_is_done ( ) result(isdone)
802!---------------------------------------------------------------------------------------------------
803    logical :: isdone
804!
805    isdone = Agrif_Curgrid % allocation_is_done
806!---------------------------------------------------------------------------------------------------
807end function Agrif_GridAllocation_is_done
808!===================================================================================================
809!
[13027]810
811function Agrif_Parent_Real_4(real_variable) result(real_variable_parent)
812real(KIND=4) :: real_variable
813real(KIND=4) :: real_variable_parent
814
815integer :: i
816logical :: i_found
817
818i_found = .FALSE.
819
820do i=1,Agrif_NbVariables(2)
821  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%array0)) then
822     real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%array0
823     i_found = .TRUE.
824     EXIT
825  endif
826enddo
827
828IF (.NOT.i_found) THEN
829do i=1,Agrif_NbVariables(2)
830  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%sarray0)) then
831     real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%sarray0
832     i_found = .TRUE.
833     EXIT
834  endif
835enddo
836ENDIF
837
838if (.NOT.i_found) STOP 'Agrif_Parent_Real_4 : Variable not found'
839
840end function Agrif_Parent_Real_4
841
842function Agrif_Parent_Real_8(real_variable) result(real_variable_parent)
843real(KIND=8) :: real_variable
844real(KIND=8) :: real_variable_parent
845
846integer :: i
847logical :: i_found
848
849i_found = .FALSE.
850
851do i=1,Agrif_NbVariables(2)
852  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%array0)) then
853     real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%array0
854     i_found = .TRUE.
855     EXIT
856  endif
857enddo
858
859IF (.NOT.i_found) THEN
860do i=1,Agrif_NbVariables(2)
861  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%darray0)) then
862     real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%darray0
863     i_found = .TRUE.
864     EXIT
865  endif
866enddo
867ENDIF
868
869if (.NOT.i_found) STOP 'Agrif_Parent_Real_8 : Variable not found'
870
871end function Agrif_Parent_Real_8
872
873function Agrif_Parent_Array2_Real_8(real_variable,ji,jj) result(real_variable_parent)
874real(KIND=8), DIMENSION(:,:) :: real_variable
875real(KIND=8) :: real_variable_parent
876integer :: ji,jj
877
878integer :: i
879logical :: i_found
880
881i_found = .FALSE.
882
883do i=1,Agrif_NbVariables(0)
884  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars(i)%array2)) then
885     real_variable_parent = agrif_curgrid%tabvars(i)%parent_var%array2(ji,jj)
886     i_found = .TRUE.
887     EXIT
888  endif
889enddo
890
891if (.NOT.i_found) STOP 'Agrif_Parent_Array2_Real_8 : Variable not found'
892
893end function Agrif_Parent_Array2_Real_8
894
895
896function Agrif_Parent_Integer(integer_variable) result(integer_variable_parent)
897integer :: integer_variable
898integer :: integer_variable_parent
899
900integer :: i
901logical :: i_found
902
903i_found = .FALSE.
904
905do i=1,Agrif_NbVariables(4)
906  if (LOC(integer_variable) == LOC(agrif_curgrid%tabvars_i(i)%iarray0)) then
907     integer_variable_parent = agrif_curgrid%tabvars_i(i)%parent_var%iarray0
908     i_found = .TRUE.
909     EXIT
910  endif
911enddo
912
913if (.NOT.i_found) STOP 'Agrif_Parent : Variable not found'
914
915end function Agrif_Parent_Integer
916
917function Agrif_Parent_Character(character_variable) result(character_variable_parent)
918character(*) :: character_variable
919character(len(character_variable)) :: character_variable_parent
920
921integer :: i
922logical :: i_found
923
924i_found = .FALSE.
925
926do i=1,Agrif_NbVariables(1)
927  if (LOC(character_variable) == LOC(agrif_curgrid%tabvars_c(i)%carray0)) then
928     character_variable_parent = agrif_curgrid%tabvars_c(i)%parent_var%carray0
929     i_found = .TRUE.
930     EXIT
931  endif
932enddo
933
934if (.NOT.i_found) STOP 'Agrif_Parent : Variable not found'
935
936end function Agrif_Parent_Character
937
938function Agrif_Parent_Logical(logical_variable) result(logical_variable_parent)
939logical :: logical_variable
940logical :: logical_variable_parent
941
942integer :: i
943logical :: i_found
944
945i_found = .FALSE.
946
947do i=1,Agrif_NbVariables(3)
948  if (LOC(logical_variable) == LOC(agrif_curgrid%tabvars_l(i)%larray0)) then
949     logical_variable_parent = agrif_curgrid%tabvars_l(i)%parent_var%larray0
950     i_found = .TRUE.
951     EXIT
952  endif
953enddo
954
955if (.NOT.i_found) STOP 'Agrif_Parent : Variable not found'
956
957end function Agrif_Parent_Logical
958
959function Agrif_Child_Logical(logical_variable) result(logical_variable_child)
960logical :: logical_variable
961logical :: logical_variable_child
962
963integer :: i
964logical :: i_found
965
966i_found = .FALSE.
967
968do i=1,Agrif_NbVariables(3)
969  if (LOC(logical_variable) == LOC(agrif_curgrid%tabvars_l(i)%larray0)) then
970     logical_variable_child = Agrif_CurChildgrid%tabvars_l(i)%larray0
971     i_found = .TRUE.
972     EXIT
973  endif
974enddo
975
976if (.NOT.i_found) STOP 'Agrif_Child : Variable not found'
977
978end function Agrif_Child_Logical
979
980function Agrif_Irhox() result(i_val)
981integer :: i_val
982i_val = agrif_curgrid%spaceref(1)
983end function Agrif_Irhox
984
985function Agrif_Irhoy() result(i_val)
986integer :: i_val
987i_val = agrif_curgrid%spaceref(2)
988end function Agrif_Irhoy
989
990function Agrif_Irhoz() result(i_val)
991integer :: i_val
992i_val = agrif_curgrid%spaceref(3)
993end function Agrif_Irhoz
994
995function Agrif_NearCommonBorderX() result(l_val)
996logical :: l_val
997l_val = agrif_curgrid%nearRootBorder(1)
998end function Agrif_NearCommonBorderX
999
1000subroutine Agrif_Set_NearCommonBorderX(l_val)
1001logical,intent(in) :: l_val
1002agrif_curgrid%nearRootBorder(1)=l_val
1003end subroutine Agrif_Set_NearCommonBorderX
1004
1005function Agrif_NearCommonBorderY() result(l_val)
1006logical :: l_val
1007l_val = agrif_curgrid%nearRootBorder(2)
1008end function Agrif_NearCommonBorderY
1009
1010subroutine Agrif_Set_NearCommonBorderY(l_val)
1011logical,intent(in) :: l_val
1012agrif_curgrid%nearRootBorder(2)=l_val
1013end subroutine Agrif_Set_NearCommonBorderY
1014
1015function Agrif_NearCommonBorderZ() result(l_val)
1016logical :: l_val
1017l_val = agrif_curgrid%nearRootBorder(3)
1018end function Agrif_NearCommonBorderZ
1019
1020subroutine Agrif_Set_NearCommonBorderZ(l_val)
1021logical,intent(in) :: l_val
1022agrif_curgrid%nearRootBorder(3)=l_val
1023end subroutine Agrif_Set_NearCommonBorderZ
1024
1025function Agrif_DistantCommonBorderX() result(l_val)
1026logical :: l_val
1027l_val = agrif_curgrid%DistantRootBorder(1)
1028end function Agrif_DistantCommonBorderX
1029
1030subroutine Agrif_Set_DistantCommonBorderX(l_val)
1031logical,intent(in) :: l_val
1032agrif_curgrid%DistantRootBorder(1)=l_val
1033end subroutine Agrif_Set_DistantCommonBorderX
1034
1035function Agrif_DistantCommonBorderY() result(l_val)
1036logical :: l_val
1037l_val = agrif_curgrid%DistantRootBorder(2)
1038end function Agrif_DistantCommonBorderY
1039
1040subroutine Agrif_Set_DistantCommonBorderY(l_val)
1041logical,intent(in) :: l_val
1042agrif_curgrid%DistantRootBorder(2)=l_val
1043end subroutine Agrif_Set_DistantCommonBorderY
1044
1045function Agrif_DistantCommonBorderZ() result(l_val)
1046logical :: l_val
1047l_val = agrif_curgrid%DistantRootBorder(3)
1048end function Agrif_DistantCommonBorderZ
1049
1050subroutine Agrif_Set_DistantCommonBorderZ(l_val)
1051logical,intent(in) :: l_val
1052agrif_curgrid%DistantRootBorder(3)=l_val
1053end subroutine Agrif_Set_DistantCommonBorderZ
1054
1055function Agrif_Ix() result(i_val)
1056integer :: i_val
1057i_val = agrif_curgrid%ix(1)
1058end function Agrif_Ix
1059
1060function Agrif_Iy() result(i_val)
1061integer :: i_val
1062i_val = agrif_curgrid%ix(2)
1063end function Agrif_Iy
1064
1065function Agrif_Iz() result(i_val)
1066integer :: i_val
1067i_val = agrif_curgrid%ix(3)
1068end function Agrif_Iz
1069
1070function Agrif_Get_grid_id() result(i_val)
1071integer :: i_val
1072i_val = agrif_curgrid % grid_id
1073end function Agrif_Get_grid_id
1074
1075function Agrif_Get_parent_id() result(i_val)
1076integer :: i_val
1077i_val = agrif_curgrid % parent % grid_id
1078end function Agrif_Get_parent_id
1079
1080function Agrif_rhox() result(r_val)
1081real :: r_val
1082r_val = real(agrif_curgrid%spaceref(1))
1083end function Agrif_rhox
1084
1085function Agrif_rhoy() result(r_val)
1086real :: r_val
1087r_val = real(agrif_curgrid%spaceref(2))
1088end function Agrif_rhoy
1089
1090function Agrif_rhoz() result(r_val)
1091real :: r_val
1092r_val = real(agrif_curgrid%spaceref(3))
1093end function Agrif_rhoz
1094
1095function Agrif_Nb_Step() result(i_val)
1096integer :: i_val
1097i_val = agrif_curgrid%ngridstep
1098end function Agrif_Nb_Step
1099
1100function Agrif_Nb_Fine_Grids() result(i_val)
1101integer :: i_val
1102i_val = Agrif_nbfixedgrids
1103end function Agrif_Nb_Fine_Grids
1104
1105! Set the name of the External mapping subroutine (if needed)
1106subroutine Agrif_Set_ExternalMapping(external_mapping)
1107Procedure(mapping) :: external_mapping
1108
1109agrif_external_mapping => external_mapping
1110
1111end subroutine Agrif_Set_ExternalMapping
1112
1113! Set the name of the user linear interp function (if needed)
1114subroutine Agrif_Set_external_linear_interp(external_linear_interp)
1115Procedure(linear_interp) :: external_linear_interp
1116
1117agrif_external_linear_interp => external_linear_interp
1118
1119end subroutine Agrif_Set_external_linear_interp
1120
1121subroutine Agrif_UnSet_external_linear_interp()
1122
1123nullify(agrif_external_linear_interp)
1124
1125end subroutine Agrif_UnSet_external_linear_interp
1126
[4777]1127end module Agrif_CurgridFunctions
Note: See TracBrowser for help on using the repository browser.