Scrambler  1
hyperbolic_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 !    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 
 All Classes Files Functions Variables