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 OrbitingParticles 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 00032 00035 MODULE Problem 00036 USE DataDeclarations 00037 USE ParticleDeclarations 00038 USE Ambients 00039 IMPLICIT NONE 00040 SAVE 00041 PUBLIC ProblemModuleInit, ProblemGridInit, & 00042 ProblemBeforeStep, ProblemAfterStep, ProblemSetErrFlag, ProblemBeforeGlobalStep 00043 CONTAINS 00044 00046 SUBROUTINE ProblemModuleInit() 00047 INTEGER :: nParticles 00048 ! INTEGER, PARAMETER :: MaxParticles=50 00049 REAL(KIND=qPREC) :: mass=0 00050 REAL(KIND=qPREC) :: xloc(3) 00051 REAL(KIND=qPREC) :: vel(3) 00052 TYPE(ParticleDef), POINTER :: Particle 00053 INTEGER :: i 00054 INTEGER :: ids(2) 00055 TYPE(AmbientDef), POINTER :: Ambient 00056 REAL(KIND=qPREC) :: rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut 00057 NAMELIST /AmbientData/ rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut 00058 ! LOGICAL :: lRestart ! COMMENT!!! 00059 !INTEGER :: ids(MaxParticles) 00060 NAMELIST /ProblemData/ nParticles 00061 NAMELIST /ParticleData/ mass,xloc,vel 00062 NAMELIST /RestartData/ ids 00063 OPEN(UNIT=PROBLEM_DATA_HANDLE, FILE='problem.data', STATUS="OLD") 00064 READ(PROBLEM_DATA_HANDLE,NML=ProblemData) 00065 CALL CreateAmbient(Ambient) 00066 READ(PROBLEM_DATA_HANDLE,NML=AmbientData) 00067 Ambient%density=rhoOut 00068 Ambient%pressure=pOut 00069 Ambient%B(:)=(/BxOut, ByOut, BzOut/) 00070 Ambient%velocity(:)=(/vxOut, vyOut, vzOut/) 00071 00072 ! IF (nParticles > MaxParticles) THEN 00073 ! PRINT*, 'need to increase MaxParticles in problem.f90' 00074 ! STOP 00075 ! END IF 00076 ! IF (lRestart) THEN 00077 ! CLOSE(PROBLEM_DATA_HANDLE) 00078 ! OPEN(UNIT=PROBLEM_DATA_HANDLE, FILE='restart.data', STATUS="OLD") 00079 ! READ(PROBLEM_DATA_HANDLE,NML=RestartData) 00080 ! CLOSE(PROBLEM_DATA_HANDLE) 00081 ! DO i=1,nParticles 00082 ! ! CALL FindParticle(Particle,id(i)) 00083 ! IF (.NOT. ASSOCIATED(Particle)) THEN 00084 ! PRINT*, 'did not find particle in problem.f90' 00085 ! STOP 00086 ! END IF 00087 ! CALL CreatePointGravityObject(Particle%PointGravityObj) 00088 ! Particle%PointGravityObj%soft_length=Particle%radius*sink_dx 00089 ! Particle%PointGravityObj%soft_function=SPLINESOFT 00090 ! Particle%PointGravityObj%mass=Particle%mass 00091 ! END DO 00092 ! ELSE 00093 IF (.NOT. lRestart) THEN 00094 DO i=1,nParticles 00095 READ(PROBLEM_DATA_HANDLE,NML=ParticleData) 00096 NULLIFY(Particle) 00097 CALL CreateParticle(Particle) 00098 Particle%Q(1)=mass 00099 Particle%xloc=xloc 00100 Particle%Q(imom(1:nDim))=vel(1:nDim) 00101 CALL AddSinkParticle(Particle) 00102 ! 00103 CALL CreatePointGravityObject(Particle%PointGravityObj) 00104 Particle%PointGravityObj%soft_length=Particle%radius*sink_dx 00105 Particle%PointGravityObj%soft_function=SPLINESOFT 00106 Particle%PointGravityObj%Mass=Particle%Q(1) 00107 Particle%PointGravityObj%v0(1:nDim)=Particle%Q(imom(1:nDim)) 00108 Particle%PointGravityObj%x0=Particle%xloc 00109 IF (i.eq.2) THEN 00110 CALL CreateOutflowObject(Particle%OutflowObj) 00111 Particle%OutflowObj%duration = 1.e30 00112 Particle%OutflowObj%radius = 0.025d0 00113 Particle%OutflowObj%thickness = 0.025d0 00114 Particle%OutflowObj%open_angle = 1.57080 !pi/4 00115 Particle%OutflowObj%density = 4d0*rhoOut !see modules.data 00116 Particle%OutflowObj%temperature = pOut/rhoOut 00117 Particle%OutflowObj%velocity = 8.d0*abs(Particle%Q(imom(1)))*sqrt(2d0) !Escape velocity x 5 00118 !4.d0*abs(Particle%vel(1))*sqrt(2d0) !Escape velocity x 4 00119 !2.d0*abs(Particle%vel(1))*sqrt(2d0) !Escape velocity x 2 00120 Particle%OutflowObj%source_vel(1:nDim) = Particle%Q(imom(1:nDim)) 00121 Particle%OutflowObj%position = Particle%xloc 00122 CALL UpdateOutflow(Particle%OutflowObj) 00123 END IF 00124 END DO 00125 CLOSE(PROBLEM_DATA_HANDLE) 00126 OPEN(UNIT=PROBLEM_DATA_HANDLE, FILE='restart.data', STATUS="UNKNOWN") 00127 WRITE(PROBLEM_DATA_HANDLE,NML=RestartData) 00128 CLOSE(PROBLEM_DATA_HANDLE) 00129 END IF 00130 ! END IF 00131 END SUBROUTINE ProblemModuleInit 00132 00135 SUBROUTINE ProblemGridInit(Info) 00136 TYPE(InfoDef) :: Info 00137 END SUBROUTINE ProblemGridInit 00138 00141 SUBROUTINE ProblemBeforeStep(Info) 00142 TYPE(InfoDef) :: Info 00143 INTEGER :: i 00144 ! DO i=1,nWinds 00145 ! CALL BeforeStepWind(Info,Wind(i)) 00146 ! END DO 00147 END SUBROUTINE ProblemBeforeStep 00148 00151 SUBROUTINE ProblemAfterStep(Info) 00152 TYPE(InfoDef) :: Info 00153 END SUBROUTINE ProblemAfterStep 00154 00157 SUBROUTINE ProblemSetErrFlag(Info) 00158 TYPE(InfoDef) :: Info 00159 END SUBROUTINE ProblemSetErrFlag 00160 00161 SUBROUTINE ProblemBeforeGlobalStep(n) 00162 INTEGER :: n 00163 END SUBROUTINE ProblemBeforeGlobalStep 00164 00165 END MODULE Problem 00166