Scrambler  1
Bondi/problem.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 !    problem.f90 of module Bondi 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 !#########################################################################
00023 !Bondi Module
00024 
00025 MODULE Problem
00026 
00027    USE DataDeclarations
00028    USE GlobalDeclarations
00029    USE PhysicsDeclarations
00030    USE SourceDeclarations
00031    USE ParticleDeclarations
00032    USE CommonFunctions
00033    USE Bondi
00034    IMPLICIT NONE
00035    PRIVATE 
00036 
00037    PUBLIC ProblemModuleInit, ProblemGridInit, &
00038         ProblemBeforeStep, ProblemAfterStep, ProblemSetErrFlag, ProblemBeforeGlobalStep
00039    TYPE(PointGravityDef), POINTER :: PointGravityObj
00040    REAL(KIND=qprec) ::   namb, tamb, ibs, obs, mcent, r_bh
00041 CONTAINS
00042 
00043    SUBROUTINE ProblemModuleInit
00044       INTEGER :: iErr
00045       TYPE(ParticleDef), POINTER :: Particle
00046       NAMELIST /ProblemData/ namb, tamb, ibs, obs, mcent
00047 
00048 
00049       OPEN(UNIT=PROBLEM_DATA_HANDLE, FILE='problem.data')
00050       READ(PROBLEM_DATA_HANDLE,NML=ProblemData)
00051       CLOSE(PROBLEM_DATA_HANDLE, IOSTAT=iErr)
00052 
00053       IF (.not. lRestart) THEN
00054          NULLIFY(Particle)
00055          CALL CreateParticle(Particle)
00056          Particle%q(1)=mcent*MSolar/rScale/lScale**3
00057          Particle%xloc=0
00058          Particle%iAccrete=0 !KRUMHOLZ_ACCRETION
00059          Particle%lFixed=.true.
00060          particle%buffer(0:MaxLevel)=ceiling(ibs/levels(0:MaxLevel)%dx)
00061          CALL AddSinkParticle(Particle)
00062          CALL CreatePointGravityObject(PointGravityObj)
00063          PointGravityObj%soft_length=1d0*levels(MaxLevel)%dx
00064          PointGravityObj%soft_function=SPLINESOFT
00065          PointGravityObj%Mass=mcent*MSolar/rScale/lScale**3 !Central object mass in computational units
00066 
00067       END IF
00068 
00069       !Calculate Bondi radius
00070       r_BH=ScaleGrav*Particle%q(1)/(gamma*tamb/TempScale)
00071       write(*,*) 'Bondi radius = ', r_BH
00072    END SUBROUTINE ProblemModuleInit
00073 
00076    SUBROUTINE ProblemGridInit(Info)
00077       !! @brief Initializes the grid data according to the requirements of the problem.
00078       !! @param Info A grid structure.  
00079       TYPE (InfoDef) :: Info
00080       INTEGER :: i,j,k
00081       INTEGER :: rmbc,zrmbc,level
00082       INTEGER :: mx, my, mz
00083       INTEGER :: iErr
00084       REAL (KIND=qPrec), POINTER, DIMENSION (:,:,:,:) :: q
00085       REAL(KIND=xprec) :: x,y,z,xl,yl,zl,dx,dy,dz,r
00086       REAL(KIND=qPREC) :: x_, y_, z_, rho, v, temp
00087       level=Info%level
00088       q=>Info%q
00089       ! Calculating the number of ghost cells on each side of the grid.
00090       rmbc=levels(level)%gmbc(levels(level)%step)
00091       dx=levels(level)%dX
00092       dy=dx
00093       SELECT CASE(nDim)
00094       CASE(2)
00095          zrmbc=0
00096          dz=0d0
00097       CASE(3)
00098          zrmbc=rmbc
00099          dz=dx
00100       END SELECT
00101       mx = Info%mX(1)
00102       my = Info%mX(2)
00103       mz = Info%mX(3)
00104       xl=Info%xBounds(1,1)
00105       yl=Info%xBounds(2,1)
00106       zl=Info%xBounds(3,1)
00107 
00108       !All of the values below are in computational units
00109 
00110       DO i=1-rmbc, mx+rmbc  
00111          x = (xl+(REAL(i,xPrec)-half)*dx) 
00112          DO j=1-rmbc, my+rmbc  
00113             y = (yl+(REAL(j,xPrec)-half)*dy)
00114             DO k=1-zrmbc, mz+zrmbc 
00115                z = (zl+(REAL(k,xPrec)-half)*dz)
00116                r = sqrt(x**2 + y**2+z**2)
00117 
00118                ! Calculate non-dimensional radius(x_), density(z_), and velocity(y_)
00119                x_=max(r, ibs-5d0*levels(0)%dx)/r_BH
00120                z_=BH_alpha(x_)
00121                y_=Bondi_lambda/(z_*x_**(myDim-1))
00122 
00123                ! Then calculate physical values
00124                rho=z_*namb/nScale
00125                v=-y_*sqrt(gamma*tamb/TempScale)
00126                temp=tamb*(z_**(gamma1))/TempScale
00127 
00128                q(i,j,k,1)=rho
00129                q(i,j,k,ivx)=rho*v*x/r
00130                q(i,j,k,ivy)=rho*v*y/r
00131                q(i,j,k,iE)=half*rho*v**2+gamma7*rho*temp
00132 
00133             END DO
00134          END DO
00135       END DO
00136    END SUBROUTINE ProblemGridInit
00137 
00138    !! @param Info Info object
00139    SUBROUTINE ProblemBeforeStep(Info)
00140       !! @brief Performs any tasks required before the advance step.
00141       !! @param Info A grid structure.  
00142       TYPE (InfoDef) :: Info
00143       INTEGER :: i,j,k
00144       INTEGER :: rmbc,zrmbc,level
00145       INTEGER :: mx, my, mz
00146       REAL (KIND=qPrec), POINTER, DIMENSION (:,:,:,:) :: q
00147       REAL(KIND=xprec) :: x,y,z,xl,yl,zl,dx,dy,dz,r
00148       REAL(KIND=qPREC) :: x_, y_, z_, rho, v, temp
00149 
00150       level=Info%level
00151       q=>Info%q
00152       ! Calculating the number of ghost cells on each side of the grid.
00153       rmbc=levels(level)%gmbc(levels(level)%step)
00154       dx=levels(level)%dX
00155       dy=dx
00156       SELECT CASE(nDim)
00157       CASE(2)
00158          zrmbc=0
00159          dz=0d0
00160       CASE(3)
00161          zrmbc=rmbc
00162          dz=dx
00163       END SELECT
00164       mx = Info%mX(1)
00165       my = Info%mX(2)
00166       mz = Info%mX(3)
00167       xl=Info%xBounds(1,1)
00168       yl=Info%xBounds(2,1)
00169       zl=Info%xBounds(3,1)
00170 
00171       !All of the values below are in computational units
00172 
00173       DO i = 1-rmbc, mx+rmbc
00174          x = (xl+(REAL(i,xPrec)-half)*dx) 
00175          DO j = 1-rmbc, my+rmbc  
00176             y = (yl+(REAL(j,xPrec)-half)*dy)
00177             DO k = 1-zrmbc,mz+zrmbc 
00178                z = (zl+(REAL(k,xPrec)-half)*dz)
00179 
00180                r = sqrt(x**2 + y**2)
00181 
00182                IF (r < ibs .OR. r > obs) THEN !Set cells to analytic solution
00183 
00184                   x_=max(ibs-5d0*levels(0)%dx, r)/r_BH !Adjust values deep inside inner region to avoid extremely high velocities etc...
00185                   z_=BH_alpha(x_)
00186                   y_=Bondi_lambda/(z_*x_**(myDim-1))
00187                   rho=z_*namb/nScale
00188                   v=-y_*sqrt(gamma*tamb/TempScale)
00189                   temp=tamb*(z_**(gamma1))/TempScale
00190 
00191                   q(i,j,k,1)=rho
00192                   q(i,j,k,ivx)=rho*v*x/r
00193                   q(i,j,k,ivy)=rho*v*y/r
00194                   q(i,j,k,iE)=half*rho*v**2+gamma7*rho*temp
00195 
00196                END IF
00197 
00198 
00199 
00200             END DO
00201          END DO
00202       END DO
00203 
00204    END SUBROUTINE ProblemBeforeStep
00205 
00208    SUBROUTINE ProblemAfterStep(Info)
00209       !! @brief Performs any post-step corrections that are required.
00210       !! @param Info A grid structure.  
00211       TYPE (InfoDef) :: Info
00212       CALL ProblemBeforeStep(Info)
00213    END SUBROUTINE ProblemAfterStep
00214 
00217    SUBROUTINE ProblemSetErrFlag(Info)
00218       !! @brief Sets error flags according to problem-specific conditions..
00219       !! @param Info A grid structure.  
00220       TYPE (InfoDef) :: Info
00221    END SUBROUTINE ProblemSetErrFlag
00222 
00223    SUBROUTINE ProblemBeforeGlobalStep(n)
00224       INTEGER :: n
00225    END SUBROUTINE ProblemBeforeGlobalStep
00226 
00227 END MODULE Problem
00228 
00229 
 All Classes Files Functions Variables