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