Scrambler
1
|
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