Scrambler
1
|
00001 !######################################################################### 00002 ! 00003 ! Copyright (C) 2003-2012 Department of Physics and Astronomy, 00004 ! University of Rochester, 00005 ! Rochester, NY 00006 ! 00007 ! hyperbolic_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 00029 00032 00033 !============================================================================================ 00034 ! Module Name: HyperbolicDeclarations 00035 ! Module File: hyperbolic_declarations.f90 00036 ! Purpose: Contains variables and parameters used to initialize a hyperbolic solver. 00037 ! Created: 20100705 by Brandon D. Shroyer 00038 !============================================================================================ 00039 MODULE HyperbolicDeclarations 00040 USE GlobalDeclarations 00041 USE DataDeclarations 00042 IMPLICIT NONE 00043 SAVE 00044 00045 PUBLIC 00046 00047 INTEGER :: iScheme ! 0 = MUSCL scheme (MUSCLScheme) 00048 ! 1 = Sweep scheme (SweepScheme) 00049 00050 INTEGER :: iSolver = 0 ! Choice of Riemann Solver 00051 INTEGER, PARAMETER :: MUSCL_SCHEME_ID = 0 00052 INTEGER, PARAMETER :: SWEEP_SCHEME_ID = 1 00053 00054 INTEGER, PARAMETER :: SOLVER_DATA_HANDLE = 50 ! File handle for data file. 00055 CHARACTER(LEN=11), PARAMETER :: SOLVER_DATA_FILE = "solver.data" !A constant string containing the name of the solver's data file. 00056 00057 NAMELIST/SolverData/iScheme,iSolver ! This namelist will probably grow over time. 00058 00059 ! Global variables to be used in MUSCL and sweep schemes. 00060 REAL(Kind=qPREC), DIMENSION(:), ALLOCATABLE, PUBLIC :: maxspeed 00061 REAL(Kind=qPREC), DIMENSION(:), ALLOCATABLE, PUBLIC :: maxsolverspeed 00062 REAL(Kind=qPREC), DIMENSION(:), ALLOCATABLE, PUBLIC :: maxwavespeed 00063 00064 00065 ! REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE :: AdvanceClockByLevel 00066 00067 LOGICAL, DIMENSION(:), ALLOCATABLE :: NodeCompleted !Flag indicating whether nodelist for each level should be advanced. 00068 REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE :: AdvanceCoeffs 00069 REAL(KIND=qPREC), DIMENSION(:,:,:), ALLOCATABLE :: AdvanceGridTimes 00070 00071 REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE :: tused_this_grid 00072 INTEGER, DIMENSION(:), ALLOCATABLE :: AdvanceStencil 00073 REAL(8), DIMENSION(:), ALLOCATABLE :: t_startadvance 00074 REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE :: WorkDoneByLevel 00075 REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE :: WorkDoneByGrid 00076 00077 INTEGER(8), DIMENSION(:), ALLOCATABLE :: InternalCellUpdates !NumCellUpdatesByLevel, EffectiveCellUpdatesByLevel 00078 INTEGER(8), DIMENSION(:), ALLOCATABLE :: CellUpdates !NumCellUpdatesByLevel, EffectiveCellUpdatesByLevel 00079 00080 00081 INTEGER :: AdvanceState 00082 REAL(KIND=qPREC) :: tStopAdvance 00083 INTEGER, PARAMETER :: STOPPING = 0, RESUMING = 1, RUNNING = 2 00084 REAL(KIND=qPREC), PARAMETER :: FOREVER=huge(1d0) 00085 00086 00087 CONTAINS 00088 00089 FUNCTION SimpleAdvanceCost(mx) 00090 INTEGER :: mx(:) 00091 REAL(KIND=qPREC) :: SimpleAdvanceCost 00092 IF (ANY(mx < 1)) THEN 00093 SimpleAdvanceCost=0 00094 RETURN 00095 ELSE 00096 SimpleAdvanceCost=AdvanceCoeffs(1)*product(mx(:)) 00097 END IF 00098 END FUNCTION SimpleAdvanceCost 00099 00100 00101 FUNCTION AdvanceCost(mx) 00102 INTEGER :: mx(:) 00103 REAL(KIND=qPREC) :: idx(3), AdvanceCost 00104 idx=log(real(mx, KIND=qPREC))/log(2d0)+1d0 00105 IF (ANY(mx < 1)) THEN 00106 AdvanceCost=0 00107 RETURN 00108 ELSEIF (ANY(idx > REAL(shape(AdvanceGridTimes)+.0001))) THEN 00109 AdvanceCost=(SimpleAdvanceCost(mx)) 00110 ELSE 00111 IF (nDim == 1) THEN 00112 AdvanceCost=exp(Interp1D(idx(1), AdvanceGridTimes(:,1,1))) 00113 ELSEIF (nDim == 2) THEN 00114 AdvanceCost=exp(Interp2D(idx(1:2), AdvanceGridTimes(:,:,1))) 00115 ELSE 00116 AdvanceCost=exp(Interp3D(idx(1:3), AdvanceGridTimes(:,:,:))) 00117 END IF 00118 END IF 00119 END FUNCTION AdvanceCost 00120 00121 00122 00123 FUNCTION Interp1D(x, array) 00124 REAL(KIND=qPREC) :: array(:), Interp1D, x 00125 INTEGER :: iLo, iHi 00126 iLo=min(max(floor(x),1),size(array)-1) 00127 iHI=iLo+1 00128 Interp1D=array(iLo)+(array(iHi)-array(iLo))*(x-REAL(iLo, KIND=qpREC)) 00129 END FUNCTION Interp1D 00130 00131 00132 FUNCTION Interp2D(x, array) 00133 REAL(KIND=qPREC) :: x(2), array(:,:), Interp2D, fr(2) 00134 INTEGER :: iLo(2), iHi(2) 00135 iLo=min(max(floor(x),1),shape(array)-1) 00136 iHI=iLo+1 00137 fr(1)=Interp1D(x(1)-REAL(iLo(1))+1d0,array(iLo(1):iHi(1),iLo(2))) 00138 fr(2)=Interp1D(x(1)-REAL(iLo(1))+1d0,array(iLo(1):iHi(1),iHi(2))) 00139 Interp2D=Interp1D(x(2)-REAL(iLo(2))+1d0,fr(:)) 00140 END FUNCTION Interp2D 00141 00142 00143 FUNCTION Interp3D(x, array) 00144 REAL(KIND=qPREC) :: x(3), array(:,:,:), Interp3D, fr(2,2), gr(2) 00145 INTEGER :: iLo(3), iHi(3) 00146 iLo=min(max(floor(x),1),shape(array)-1) 00147 iHI=iLo+1 00148 fr(1,1)=Interp1D(x(1)-REAL(iLo(1))+1d0,array(iLo(1):iHi(1),iLo(2),iLo(3))) 00149 fr(2,1)=Interp1D(x(1)-REAL(iLo(1))+1d0,array(iLo(1):iHi(1),iHi(2),iLo(3))) 00150 fr(1,2)=Interp1D(x(1)-REAL(iLo(1))+1d0,array(iLo(1):iHi(1),iLo(2),iHi(3))) 00151 fr(2,2)=Interp1D(x(1)-REAL(iLo(1))+1d0,array(iLo(1):iHi(1),iHi(2),iHi(3))) 00152 gr(1)=Interp1D(x(2)-REAL(iLo(2))+1d0,fr(:,1)) 00153 gr(2)=Interp1D(x(2)-REAL(iLo(2))+1d0,fr(:,2)) 00154 Interp3D=Interp1D(x(3)-REAL(iLo(3))+1d0, gr) 00155 END FUNCTION Interp3D 00156 00157 00158 00159 00160 FUNCTION ChildAdvanceCost(mB,level) 00161 INTEGER :: i 00162 INTEGER :: mB(3,2) 00163 INTEGER :: mx2(3), mx(3) 00164 INTEGER :: level 00165 REAL(KIND=qPREC) :: ChildAdvanceCost 00166 ChildAdvanceCost=0 00167 mx=mB(:,2)-mB(:,1)+1 00168 IF (ANY(mx < 1)) THEN 00169 RETURN 00170 ELSE 00171 mx2=1 00172 DO i=1, levels(level+1)%steps 00173 mx2(1:nDim)=levels(level)%CoarsenRatio*mx(1:nDim)+2d0*levels(level+1)%ambc(i) 00174 !mx2(1:nDim)=levels(level)%CoarsenRatio*mx(1:nDim) 00175 ChildAdvancecost=ChildAdvanceCost+AdvanceCost(mx2) 00176 END DO 00177 END IF 00178 END FUNCTION ChildAdvanceCost 00179 00180 END MODULE HyperbolicDeclarations 00181