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 HydroStaticStar 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 MODULE Problem 00029 USE DataDeclarations 00030 USE Ambients 00031 USE PointGravitySrc 00032 USE ParticleDeclarations !n 00033 USE Profiles 00034 IMPLICIT NONE 00035 SAVE 00036 00037 PUBLIC ProblemModuleInit, ProblemGridInit, & 00038 ProblemBeforeStep, ProblemAfterStep, ProblemSetErrFlag, ProblemBeforeGlobalStep 00039 TYPE(AmbientDef), POINTER :: Ambient 00040 CONTAINS 00041 00043 SUBROUTINE ProblemModuleInit() 00044 INTEGER :: i, soft_function, nPoints 00045 TYPE(ParticleDef), POINTER :: Particle => null() 00046 TYPE(PointGravityDef), POINTER :: PointGravityObj => null() 00047 REAL(KIND=qPREC) :: mass=1d0 00048 REAL(KIND=qPREC) :: pressure_inf, soft_radius 00049 REAL(KIND=qPREC), DIMENSION(3) :: xloc, velocity= (/0,0,0/) 00050 REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE :: temp 00051 NAMELIST /ProblemData/ velocity, xloc, mass, soft_radius, soft_function, pressure_inf 00052 00053 OPEN(UNIT=PROBLEM_DATA_HANDLE, FILE='problem.data', STATUS="OLD") 00054 READ(PROBLEM_DATA_HANDLE,NML=ProblemData) 00055 CALL CreateAmbient(Ambient,1d0,1d0) 00056 Ambient%PersistInBoundaries=.true. 00057 00058 IF (.NOT. lRestart) THEN 00059 CALL CreateParticle(Particle) !n 00060 Particle%q(1)=mass*mSolar/mScale !n 00061 Particle%xloc=xloc !n 00062 CALL CreatePointGravityObject(Particle%PointGravityObj) 00063 Particle%lFixed=.true. !n 00064 PointGravityObj=>Particle%PointGravityObj 00065 ELSE 00066 ALLOCATE(PointGravityObj) 00067 ENDIF 00068 00069 PointGravityObj%mass=mass*mSolar/mScale 00070 PointGravityObj%x0=xloc 00071 PointGravityObj%v0=velocity 00072 PointGravityObj%t0=levels(0)%tnow 00073 PointGravityObj%soft_length=soft_radius 00074 PointGravityObj%soft_function=soft_function 00075 00076 CLOSE(PROBLEM_DATA_HANDLE) 00077 00078 !Open file containing density profile 00079 open(UNIT=PROBLEM_DATA_HANDLE, FILE='amb.data', STATUS='old', FORM='FORMATTED') 00080 READ(PROBLEM_DATA_HANDLE, *) nPoints 00081 00082 !Profile object is allocated 00083 CALL CreateProfile(Ambient%profile, nPoints, (/Mass_Field, P_Field/), RADIAL) 00084 DO i=1,nPoints 00085 READ(PROBLEM_DATA_HANDLE, *) Ambient%profile%data(i,:) ! position, density, pressure in cgs 00086 Ambient%profile%data(i,:)=Ambient%profile%data(i,:) / (/lScale, rScale, pScale/) !rescale to cu 00087 END DO 00088 00089 !Now soften the density profile using Plummer type softening with a soft radius that is 80% of the pointgravity soft_length 00090 ALLOCATE(temp(NPoints)) 00091 DO i=1,nPoints 00092 temp(i) = getProfileValue(sqrt(Ambient%profile%data(i,1)**2 & 00093 + (PointGravityObj%soft_length*0.8d0)**2),Mass_Field,Ambient%profile) 00094 END DO 00095 Ambient%profile%data(:,2)=temp 00096 DEALLOCATE(temp) 00097 00098 CLOSE(PROBLEM_DATA_HANDLE) 00099 00100 ! Density profile is now populated 00101 ! Calculate pressure profile needed for hydrostatic equilibrium 00102 CALL Profile_PointGravityHSE(Ambient%profile, PointGravityObj, pressure_inf) 00103 00104 00105 END SUBROUTINE ProblemModuleInit 00106 00109 SUBROUTINE ProblemGridInit(Info) 00110 TYPE(InfoDef) :: Info 00111 END SUBROUTINE ProblemGridInit 00112 00115 SUBROUTINE ProblemBeforeStep(Info) 00116 TYPE(InfoDef) :: Info 00117 END SUBROUTINE ProblemBeforeStep 00118 00121 SUBROUTINE ProblemAfterStep(Info) 00122 TYPE(InfoDef) :: Info 00123 END SUBROUTINE ProblemAfterStep 00124 00127 SUBROUTINE ProblemSetErrFlag(Info) 00128 TYPE(InfoDef) :: Info 00129 INTEGER :: i,j,k 00130 Info%ErrFlag(:,:,:)=1 ! refines over entire grid 00131 END SUBROUTINE ProblemSetErrFlag 00132 00133 SUBROUTINE ProblemBeforeGlobalStep(n) 00134 INTEGER :: n 00135 END SUBROUTINE ProblemBeforeGlobalStep 00136 00137 END MODULE Problem 00138