Scrambler  1
global_declarations.f90
Go to the documentation of this file.
00001 !#########################################################################
00002 !               
00003 !    Copyright (C) 2003-2012 Department of Physics and Astronomy,
00004 !                            University of Rochester,
00005 !                            Rochester, NY
00006 !
00007 !    global_declarations.f90 is part of AstroBEAR.
00008 !
00009 !    AstroBEAR is free software: you can redistribute it and/or modify    
00010 !    it under the terms of the GNU General Public License as published by 
00011 !    the Free Software Foundation, either version 3 of the License, or    
00012 !    (at your option) any later version.
00013 !
00014 !    AstroBEAR is distributed in the hope that it will be useful, 
00015 !    but WITHOUT ANY WARRANTY; without even the implied warranty of
00016 !    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00017 !    GNU General Public License for more details.
00018 !
00019 !    You should have received a copy of the GNU General Public License
00020 !    along with AstroBEAR.  If not, see <http://www.gnu.org/licenses/>.
00021 !
00022 !#########################################################################
00025 
00028 
00031 
00032 Module GlobalDeclarations
00033    IMPLICIT NONE
00034    SAVE
00035 
00036    PUBLIC
00037 
00038    INCLUDE 'mpif.h'
00039 
00042 
00043    INTEGER, PARAMETER :: qPrec = SELECTED_REAL_KIND(14,32)
00044    INTEGER, PARAMETER :: xPrec = SELECTED_REAL_KIND(14,32)
00045    INTEGER, PARAMETER :: ROOT_LEVEL=0
00046    INTEGER, PARAMETER :: EXTRAPOLATED_BOUND = 1
00047    INTEGER, PARAMETER :: PERIODIC_BOUND = 2
00048    INTEGER, PARAMETER :: REFLECT_WALL = 3
00049    INTEGER, PARAMETER :: REFLECT_BPARALLEL = 4
00050    INTEGER, PARAMETER :: REFLECT_CYLINDRICAL = 5
00051    INTEGER, PARAMETER :: INTERNAL_BOUND = 999
00052    INTEGER, PARAMETER :: MaxDepth = 16
00053    INTEGER, PARAMETER :: MAX_SUBGRIDS = 2048
00054    INTEGER, PARAMETER :: MAX_DIMS = 3
00055    INTEGER, PARAMETER :: NEIGHBORCHILD = -999
00056    REAL(KIND=qPREC), PARAMETER :: UNDEFINED=-1e30, half=.5d0, one=1d0, two=2d0
00057    REAL(KIND=qPrec), PARAMETER :: ZERO = 0d0
00058    INTEGER, PARAMETER :: IEVERYWHERE = 0, IBOUNDARIES = 1
00059    INTEGER, PARAMETER, DIMENSION(3,2) :: IBOUNDARY=RESHAPE((/2,3,4,5,6,7/),(/3,2/))
00060    INTEGER, PARAMETER :: NON_THREADED = -1, PSEUDO_THREADED = 0, THREADED = 1
00061 
00063 
00066 
00068    TYPE LevelDef
00069       REAL(KIND=qPREC) :: dx
00070       INTEGER :: CoarsenRatio=2
00071       REAL(KIND=qPREC) :: qTolerance=1e-3
00072       REAL(KIND=qPrec) :: DesiredFillRatios
00073       INTEGER, DIMENSION(3) :: gmbc !nmbc(i) is used for determining neighbors at the end of step i [nmbc(1) must be >= ombc(2)] since neighbors become overlaps
00074       INTEGER, DIMENSION(2) :: egmbc 
00075       INTEGER, DIMENSION(2) :: ombc 
00076       INTEGER, DIMENSION(2) :: ambc 
00077       INTEGER :: nmbc 
00078       INTEGER :: pmbc !The number of ghost cells required for Info%q (used to store phi)
00079       REAL(KIND=qPREC) :: dt
00080       REAL(KIND=qPREC) :: tnow
00081       INTEGER :: step
00082       INTEGER :: steps
00083       INTEGER, DIMENSION(3) :: mX=1
00084       INTEGER(8) :: Grid
00085       INTEGER :: MPI_COMM=MPI_COMM_WORLD
00086       INTEGER :: id
00087       INTEGER :: CurrentLevelStep=0
00088    END TYPE LevelDef
00089    TYPE(LevelDef), DIMENSION(:), ALLOCATABLE :: levels
00090 
00091 
00094 
00096    TYPE DomainDef
00097       INTEGER, DIMENSION(3,2) :: mGlobal
00098       INTEGER, DIMENSION(3,2) :: mthbc
00099    END TYPE DomainDef
00100    TYPE(DomainDef), DIMENSION(:), ALLOCATABLE :: Domains
00101 
00102 
00105    INTEGER :: NrVars
00106    INTEGER :: GVars   !Two different distances for ghost zoning...
00107    INTEGER :: EGVars  !Two regions must be grouped in q... (1:GVars) & (GVars+1:GVars+EGVars)
00108    INTEGER :: TDVars  !Number of time derivative variables
00109    INTEGER :: nFlux
00110    INTEGER :: nProlongate
00111    INTEGER :: nRestrict
00112    INTEGER :: nEMF
00113    INTEGER :: nAux
00114    INTEGER :: nEllipticTransfers
00115    INTEGER, DIMENSION(:), ALLOCATABLE :: TimeDerivFields
00116    INTEGER, DIMENSION(:), ALLOCATABLE :: GCopyFields
00117    INTEGER, DIMENSION(:), ALLOCATABLE :: EGCopyFields
00118    INTEGER, DIMENSION(:), ALLOCATABLE :: ProlongateFields
00119    INTEGER, DIMENSION(:), ALLOCATABLE :: RestrictFields
00120    INTEGER, DIMENSION(:), ALLOCATABLE :: FluxFields
00121    INTEGER, DIMENSION(:), ALLOCATABLE :: invFluxFields
00122    INTEGER, DIMENSION(:), ALLOCATABLE :: auxFields
00123    INTEGER, DIMENSION(:), ALLOCATABLE :: InterpMethod
00124    INTEGER, DIMENSION(:), ALLOCATABLE :: EllipticTransferFields
00125    INTEGER, DIMENSION(3) :: EmfLoc                               !EmfLoc(i) stores indice in info%emf for component i of emf
00126    INTEGER, DIMENSION(3) :: EmfDir                               !EmfDir(i) stores component of emf stored in Info%emf(i)
00127    LOGICAL ::  MaintainAuxArrays
00128 
00129 
00132    INTEGER :: MPI_ID=0, MPI_NP
00133    INTEGER :: iThreaded=-1
00134    REAL(KIND=qPREC), DIMENSION(2) :: LevelBalance=(/0d0,0d0/)
00135    LOGICAL :: lSkipProfile=.true.
00136    LOGICAL :: lKnapSack=.false.
00137    LOGICAL :: lTimingLog=.false.
00138    LOGICAL :: lParticles=.false.
00139    LOGICAL :: lElliptic=.false.
00140    LOGICAL :: lExplicit=.false.
00141    INTEGER :: MinimumGridPoints=4
00142    LOGICAL :: lStressTest=.false.
00143    REAL, DIMENSION(:), ALLOCATABLE :: WorkLoad
00144    REAL :: MySpeedFactor=1
00145    REAL(8) :: StartTime
00146    LOGICAL, DIMENSION(3) :: lEllipticPeriodic=.false.
00147    LOGICAL, DIMENSION(3) :: lHydroPeriodic=.false.
00148    LOGICAL :: lStoreMassFlux=.false.                              !Switch whether or not mass fluxes are stored
00149    LOGICAL :: lNeedMeanDensity=.false.
00150    INTEGER, DIMENSION(3) :: nperiodic_overlaps=1   ! Number of times to periodically stack data for filling ghost zones in periodic directions.  
00151 
00152 
00155    LOGICAL, DIMENSION(-2:MaxDepth) :: lRegridLevel
00156    INTEGER :: ndim=2
00157    INTEGER :: MaxLevel=0
00158    INTEGER :: LastStaticLevel=-1
00159    LOGICAL :: lUseOriginalNewSubGrids=.false.
00160    INTEGER :: FinestLevel
00161    INTEGER :: RestartLevel
00162    INTEGER :: BaseLevel=-2
00163    INTEGER :: nDomains=1
00164    REAL(KIND=qPREC), DIMENSION(3,2) :: GxBounds ! Global bounds
00165    INTEGER, DIMENSION(3) :: GmX=(/32,32,1/)     ! Global resolution
00166    INTEGER, DIMENSION(3,2) :: GmGlobal     ! Global resolution
00167    INTEGER, DIMENSION(3,2) :: Gmthbc = 1
00168    LOGICAL, DIMENSION(3) :: lAnyPeriodic=.false.
00169    INTEGER :: hyperbolic_mbc  ! Number of ghost cells used by hyperbolic solver   !lost each hyperbolic step
00170    INTEGER :: elliptic_mbc    ! Number of ghost cells required by elliptic solver !not lost
00171    INTEGER :: source_mbc      ! Number of ghost cells required by source steps    !not lost
00172    INTEGER :: particle_mbc    ! Number of ghost cells required by particleupdates !not lost
00173    INTEGER :: afterstep_mbc   ! Number of ghost cells required by explicit solver !lost each explicit step
00174 
00175 
00178    REAL(KIND=qPrec) :: initial_maxspeed
00179    REAL(KIND=qPrec), DIMENSION(3) :: cfl_vars = (/1.0,.3,.5/)
00180    INTEGER :: current_frame
00181    INTEGER :: start_frame = 0
00182    INTEGER :: final_frame
00183    INTEGER :: restart_frame
00184    REAL(KIND=qPREC) :: current_time, start_time=0d0, final_time, restart_time
00185    LOGICAL :: RestartStep=.false.
00186    LOGICAL :: lRequestRestart=.false.
00187 
00188 
00189    REAL(KIND=qPREC) :: InitTime
00190 
00191 
00194    LOGICAL :: lRestart=.false.
00195    LOGICAL :: lRegrid=.false.
00196    LOGICAL :: lPostProcess=.false.
00197    LOGICAL :: lReOutput=.false.
00198    INTEGER :: iDataFileType=0
00199    LOGICAL :: lPrintDebugFrame=.false.
00200 
00201 
00204    NAMELIST /GlobalData/ MaxLevel, LastStaticLevel, lUseOriginalNewSubGrids, MinimumGridPoints, &
00205         lRestart, lPostProcess, lRegrid, restart_frame, start_time, final_time, final_frame, GmX, &
00206         GxBounds, Gmthbc, initial_maxspeed, cfl_vars, iThreaded, LevelBalance, lKnapSack, lTimingLog, lStressTest, MaintainAuxArrays, nDim, lSkipProfile
00207 
00208    INTEGER, PARAMETER :: GLOBAL_DATA_HANDLE = 76
00209    CHARACTER(LEN=11), PARAMETER :: GLOBAL_DATA_FILE = "global.data"
00210    INTEGER, PARAMETER :: PHYSICS_DATA_HANDLE = 73
00211    CHARACTER(LEN=12), PARAMETER :: PHYSICS_DATA_FILE = "physics.data"
00212    INTEGER, PARAMETER :: MODULES_DATA_HANDLE = 74
00213    CHARACTER(LEN=12), PARAMETER :: MODULES_DATA_FILE = "modules.data"
00214    INTEGER, PARAMETER :: COMMUNICATION_DATA_HANDLE = 77
00215    CHARACTER(LEN=18), PARAMETER :: COMMUNICATION_DATA_FILE = "communication.data"
00216    INTEGER, PARAMETER :: PROFILE_DATA_HANDLE = 78
00217    CHARACTER(LEN=12), PARAMETER :: PROFILE_DATA_FILE = "profile.data"
00218    INTEGER, PARAMETER :: SCALES_DATA_HANDLE = 79
00219    CHARACTER(LEN=11), PARAMETER :: SCALES_DATA_FILE = "scales.data"
00220    INTEGER, PARAMETER :: PROBLEM_DATA_HANDLE = 80 !Generic data handle for individual use modules
00221    INTEGER, PARAMETER :: TIMER_LOG_HANDLE = 81
00222    INTEGER, PARAMETER :: COMM_LOG_HANDLE = 82
00223    INTEGER, PARAMETER :: PROCESS_DATA_HANDLE = 83
00224    CHARACTER(LEN=12), PARAMETER :: PROCESS_DATA_FILE = "process.data"
00225    INTEGER, PARAMETER :: TOTALS_DATA_HANDLE = 84
00226    CHARACTER(LEN=16), PARAMETER :: TOTALS_DATA_FILE = "out/totals.dat"
00227    INTEGER, PARAMETER :: HISTOGRAM_DATA_HANDLE = 85
00228    INTEGER, PARAMETER :: BOV_DATA_HANDLE = 86
00229    INTEGER, PARAMETER :: PPM_DATA_HANDLE = 87
00230    INTEGER, PARAMETER :: BONDI_DATA_HANDLE = 88
00231    INTEGER, PARAMETER :: SPECTRA_DATA_HANDLE = 89
00232    INTEGER, PARAMETER :: LAYOUT_DATA_HANDLE = 90
00233    INTEGER, PARAMETER :: CAMERA_DATA_HANDLE = 91
00234 
00235 
00236    INTEGER :: InfoAllocator=1, MessageAllocator=2, SweepAllocator=3
00237    REAL(KIND=qPREC) :: allocator(3)=0, maxallocation(3)=0
00238    REAL(KIND=qPREC) :: NumCellsByLevel(0:MaxDepth)
00239 
00240    INTEGER, PARAMETER :: PACK_INTEGER_SIZE = 4
00241    INTEGER, PARAMETER :: PACK_FLOAT_SIZE = 4
00242    INTEGER, PARAMETER :: PACK_DOUBLE_SIZE = 8
00243    INTEGER, PARAMETER :: PACK_BOX_SIZE = 24     ! 6 * PACK_INTEGER_SIZE
00244    INTEGER, PARAMETER, DIMENSION(3,2) :: TERMINATIONBOX = RESHAPE((/-1,-1,-1,-1,-1,-1/), (/3, 2/))
00245    INTEGER, PARAMETER :: TERMINATION_BOX_BYTES = 24     ! size of six integers
00246 
00247 CONTAINS
00248 
00251    PURE ELEMENTAL FUNCTION ISNAN(x)
00252       LOGICAL :: ISNAN
00253       REAL(KIND=qPrec), INTENT(IN) :: x
00254       ISNAN=.FALSE.
00255       IF(x .ne. x) ISNAN=.TRUE.
00256    END FUNCTION ISNAN
00257 
00260    PURE ELEMENTAL FUNCTION ISINFNAN(x)
00261       LOGICAL :: ISINFNAN
00262       REAL(KIND=qprec), INTENT(IN) :: x
00263       ISINFNAN=.FALSE.
00264       IF(ISNAN(x) .OR. ABS(x)>HUGE(x)) ISINFNAN=.TRUE.
00265    END FUNCTION ISINFNAN
00266 
00269    INTEGER FUNCTION BoolToInt(flag)
00270 
00271       LOGICAL :: flag
00272 
00273       IF (flag) THEN
00274          BoolToInt = -1
00275       ELSE
00276          BoolToInt = 0
00277       END IF
00278 
00279    END FUNCTION BoolToInt
00280 
00281 
00282    SUBROUTINE OutputIntArray(a)
00283       INTEGER, DIMENSION(:,:) :: a
00284       INTEGER :: i,logb,b
00285       CHARACTER(LEN=22) :: X
00286       CHARACTER(LEN=16) :: Y
00287       b=maxval(abs(a))
00288       DO i=0, 9
00289          IF (size(a, 1) < 10**i) EXIT
00290       END DO
00291       DO logb=0,9
00292          IF (b < 10**logb) EXIT
00293       END DO
00294       WRITE(Y,'(A5,I1,A10)') '(A1,I',i,',A1,I1,A1)'
00295       write(X,Y) '(',size(a, 1),'I',logb+2,')'
00296       write(*,'(A,I3,A1,I3,A)') '------------Integer array ', size(a,1), 'x',size(a,2),'------------------'
00297       write(*,X) a !transpose(a)
00298    END SUBROUTINE OutputIntArray
00299 
00300    SUBROUTINE OutputRealArray(a)
00301       REAL, DIMENSION(:,:) :: a
00302       INTEGER :: i,logb,b
00303       CHARACTER(LEN=17) :: X
00304       CHARACTER(LEN=9) :: Y
00305       b=maxval(abs(a))
00306       DO i=0, 9
00307          IF (size(a, 1) < 10**i) EXIT
00308       END DO
00309       DO logb=0,9
00310          IF (b < 10**logb) EXIT
00311       END DO
00312       WRITE(Y,'(A5,I1,A3)') '(A1,I',i,',A6)'
00313       write(X,Y) '(',size(a, 1),'E15.3)'
00314       write(*,'(A,I3,A1,I3,A)') '------------Real array ', size(a,1), 'x',size(a,2),'------------------'
00315       write(*,X) a !transpose(a)
00316    END SUBROUTINE OutputRealArray
00317 
00318 
00319    SUBROUTINE OutputDoubleArray(a)
00320       REAL(8), DIMENSION(:,:) :: a
00321       INTEGER :: i,logb,b
00322       CHARACTER(LEN=17) :: X
00323       CHARACTER(LEN=10) :: Y
00324       b=maxval(abs(a))
00325       DO i=0, 9
00326          IF (size(a, 1) < 10**i) EXIT
00327       END DO
00328       DO logb=0,9
00329          IF (b < 10**logb) EXIT
00330       END DO
00331       WRITE(Y,'(A5,I1,A4)') '(A1,I',i,',A7)'
00332       write(X,Y) '(',size(a, 1),'E25.16)'
00333       write(*,'(A,I3,A1,I3,A)') '------------Double array ', size(a,1), 'x',size(a,2),'------------------'
00334       write(*,X) a !transpose(a)
00335    END SUBROUTINE OutputDoubleArray
00336 
00337 
00338    SUBROUTINE CheckAllocation(i, size, caller, err)
00339       INTEGER, OPTIONAL :: err
00340       INTEGER :: i, size, j
00341       CHARACTER(LEN=*), OPTIONAL :: caller
00342       IF (present(err)) THEN
00343          IF (err /= 0) THEN
00344             IF (present(caller)) THEN
00345                write(*,*) 'check allocation failed with err ', err, 'size = ', size, caller
00346             ELSE
00347                write(*,*) 'check allocation failed with err ', err, 'size = ', size
00348             END IF
00349             STOP
00350          END IF
00351       END IF
00352       allocator(i)=allocator(i)+REAL(size,KIND=qPREC)
00353       maxallocation(i)=max(maxallocation(i), allocator(i))
00354    END SUBROUTINE CheckAllocation
00355 
00356    SUBROUTINE CheckDeAllocation(i, size, err, caller)
00357       INTEGER, OPTIONAL :: err
00358       CHARACTER(LEN=*), OPTIONAL :: caller
00359       INTEGER :: i, size
00360       IF (present(err)) THEN
00361          IF (err /= 0) THEN
00362             IF (present(caller)) THEN
00363                write(*,*) 'check allocation failed with err ', err, 'size = ', size, caller
00364             ELSE
00365                write(*,*) 'check allocation failed with err ', err, 'size = ', size
00366             END IF
00367             STOP
00368          END IF
00369       END IF
00370       allocator(i)=allocator(i)-REAL(size,KIND=qPREC)
00371    END SUBROUTINE CheckDeAllocation
00372 
00373 
00374    FUNCTION printsize(x)
00375       REAL(KIND=qPREC) :: x
00376       CHARACTER(LEN=10) :: printsize
00377       IF (abs(x) == 0) THEN
00378          write(printsize,'(A10)') '  ------  '
00379       ELSEIF (abs(x) > 1024d0**3) THEN
00380          write(printsize, '(F7.1,A3)') x/real(1024d0**3), ' gb'
00381       ELSEIF (abs(x) > 1024d0**2) THEN
00382          write(printsize, '(F7.1,A3)') x/real(1024d0**2), ' mb'
00383       ELSEIF (abs(x) > 1024d0) THEN
00384          write(printsize, '(F7.1,A3)') x/1024d0, ' kb'
00385       ELSE
00386          write(printsize, '(I4,A3)') NINT(x), ' by'
00387       END IF
00388    END FUNCTION printsize
00389 
00390    FUNCTION printtime(x)
00391       REAL(KIND=qPREC) :: x
00392       CHARACTER(LEN=11) :: printtime
00393       REAL(KIND=qPREC), PARAMETER :: kyr_=31556926000
00394       REAL(KIND=qPREC), PARAMETER :: yr_=31556926
00395       REAL(KIND=qPREC), PARAMETER :: month_=yr_/12d0
00396       REAL(KIND=qPREC), PARAMETER :: day_=24d0*3600d0
00397       REAL(KIND=qPREC), PARAMETER :: hr_=3600d0
00398       REAL(KIND=qPREC), PARAMETER :: min_=60d0
00399 
00400       IF (abs(x) == 0) THEN
00401          write(printtime,'(A10)') '  ------  '
00402       ELSEIF (abs(x) > 1000*kyr_) THEN
00403          write(printtime, '(A5)') 'never'
00404       ELSEIF (abs(x) > kyr_) THEN
00405          write(printtime, '(F7.1,A4)') x/kyr_, ' kyr'
00406       ELSEIF (abs(x) > yr_) THEN
00407          write(printtime, '(F7.1,A4)') x/yr_, ' yr '
00408       ELSEIF (abs(x) > month_) THEN
00409          write(printtime, '(F7.1,A4)') x/month_, ' mo '
00410       ELSEIF (abs(x) > day_) THEN
00411          write(printtime, '(F7.1,A4)') x/day_, ' day'
00412       ELSEIF (abs(x) > hr_) THEN
00413          write(printtime, '(F7.1,A4)') x/hr_, ' hr '
00414       ELSEIF (abs(x) > min_) THEN
00415          write(printtime, '(F7.1,A4)') x/min_, ' min'
00416       ELSE
00417          write(printtime, '(F7.1,A4)') x, ' s  '
00418       END IF
00419    END FUNCTION printtime
00420 
00421    SUBROUTINE CheckSlabSymmetric(q)
00422       REAL(KIND=qPREC), DIMENSION(:,:,:) :: q
00423       INTEGER :: i,j
00424       DO i=1,size(q,1)
00425          DO j=1,size(q,3)
00426             IF (maxval(q(i,:,j)) > minval(q(i,:,j))) THEN
00427                write(*,*) 'found a problem with field ', j, 'at index ', i, maxval(q(i,:,j)), minval(q(i,:,j))
00428                write(*,'(100E29.20)') q(i,:,j)
00429             END IF
00430          END DO
00431       END DO
00432    END SUBROUTINE CheckSlabSymmetric
00433 
00434 END Module GlobalDeclarations
00435 
 All Classes Files Functions Variables