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

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F90 @ 7993

Last change on this file since 7993 was 7993, checked in by frrh, 7 years ago

Merge in missing revisions 6428:2477 inclusive and 6482 from nemo_v3_6_STABLE
branch. In ptic, this includes the fix for restartability of runoff fields in coupled
models. Evolution of coupled models will therefor be affected.

These changes donot affect evolution of the current stand-alone NEMO-CICE GO6
standard configuration.

Work and testing documented in Met Office GMED ticket 320.

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