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 Binary 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 USE Disks 00040 USE Winds 00041 IMPLICIT NONE 00042 SAVE 00043 PUBLIC ProblemModuleInit, ProblemGridInit, & 00044 ProblemBeforeStep, ProblemAfterStep, ProblemSetErrFlag, ProblemBeforeGlobalStep 00045 REAL(KIND=qPREC) :: alpha, densw, velw, t1, t2 00046 INTEGER :: radiusw, nWinds 00047 LOGICAL :: windsPresent=.false., disk=.false. 00048 !TYPE(pWindDef), DIMENSION(:), ALLOCATABLE :: MyWinds 00049 00050 CONTAINS 00051 00053 SUBROUTINE ProblemModuleInit() 00054 TYPE(InfoDef) :: Info 00055 TYPE(WindDef), POINTER :: Wind 00056 INTEGER :: nParticles, edge 00057 REAL(KIND=qPREC) :: mass=0 00058 REAL(KIND=qPREC) :: xloc(3) 00059 REAL(KIND=qPREC) :: vel(3) 00060 TYPE(ParticleDef), POINTER :: Particle 00061 TYPE(ParticleListDef), POINTER :: particlelist 00062 INTEGER :: i, grav_soft_rad 00063 INTEGER :: ids(2) 00064 TYPE(AmbientDef), POINTER :: Ambient 00065 TYPE(DiskDef), POINTER :: mydisk 00066 REAL(KIND=qPREC) :: time, rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut, 00067 buff(17) 00068 NAMELIST /AmbientData/ rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut 00069 NAMELIST /ProblemData/ nParticles, densw, velw, windsPresent, disk, t1, t2 00070 NAMELIST /ParticleData/ mass,xloc,vel,alpha,radiusw,grav_soft_rad, buff 00071 NAMELIST /RestartData/ ids 00072 00073 ! time=levels(Info%level)%tnow 00074 00075 OPEN(UNIT=PROBLEM_DATA_HANDLE, FILE='problem.data', STATUS="OLD") 00076 READ(PROBLEM_DATA_HANDLE,NML=ProblemData) 00077 00078 if (.not. lrestart) then 00079 CALL CreateAmbient(Ambient) 00080 READ(PROBLEM_DATA_HANDLE,NML=AmbientData) 00081 if (disk) then 00082 Ambient%density=1d0 00083 else ; Ambient%density=rhoOut 00084 end if 00085 Ambient%pressure=Ambient%density 00086 Ambient%B(:)=(/BxOut, ByOut, BzOut/) 00087 Ambient%velocity(:)=(/vxOut, vyOut, vzOut/) 00088 end if 00089 00090 if (windsPresent) then 00091 DO i=1,nDim 00092 DO edge=1,2 00093 IF (Gmthbc(i,edge) == 1) THEN 00094 NULLIFY(Wind) 00095 CALL CreateWind(Wind) 00096 Wind%dir=i 00097 Wind%edge=edge 00098 Wind%type=OUTFLOW_ONLY 00099 END IF 00100 END DO 00101 END DO 00102 ! ALLOCATE(MyWinds(6)) 00103 ! nWinds=0 00104 ! DO i=1,nDim 00105 ! DO edge=1,2 00106 ! IF (Gmthbc(i,edge) == 1) THEN 00107 ! nWinds=nWinds+1 00108 ! CALL CreateWind(MyWinds(nWinds)%p) 00109 ! MyWinds(nWinds)%p%dir=i 00110 ! MyWinds(nWinds)%p%edge=edge 00111 ! MyWinds(nWinds)%p%type=OUTFLOW_ONLY 00112 ! END IF 00113 ! END DO 00114 ! END DO 00115 end if 00116 00117 IF (lRestart) THEN 00118 particleList=>SinkParticles 00119 i=1 00120 DO WHILE (ASSOCIATED(particlelist)) 00121 particle=>particlelist%self 00122 READ(PROBLEM_DATA_HANDLE,NML=ParticleData) 00123 00124 if (i==1) then 00125 Particle%PointGravityObj%soft_length=REAL(grav_soft_rad,qPREC)*sink_dx 00126 Particle%PointGravityObj%alpha = alpha 00127 if (alpha==0d0) then 00128 Particle%iAccrete=NOACCRETION 00129 else 00130 Particle%iAccrete=KRUMHOLZ_ACCRETION 00131 ! see particle_declarations 00132 end if 00133 end if 00134 00135 !if (time.ge.t1 .and. time.le.t2) then 00136 ! Particle%PointGravityObj%alpha = alpha*(time-t1)/(t2-t1) ! (0,1) 00137 !else ; Particle%PointGravityObj%alpha = 0d0 00138 !end if 00139 00140 IF (i==2) THEN 00141 CALL CreateOutflowObject(Particle%OutflowObj) 00142 Particle%OutflowObj%duration = 1.e30 00143 Particle%OutflowObj%radius =REAL(radiusw,qPREC)*sink_dx 00144 Particle%OutflowObj%thickness =REAL(radiusw,qPREC)*sink_dx 00145 Particle%OutflowObj%open_angle = Pi 00146 Particle%OutflowObj%density = densw 00147 Particle%OutflowObj%temperature = 1d0 00148 Particle%OutflowObj%velocity = velw 00149 Particle%OutflowObj%source_vel(1:nDim) = Particle%Q(imom(1:nDim)) 00150 Particle%OutflowObj%position= Particle%xloc 00151 CALL UpdateOutflow(Particle%OutflowObj) 00152 END IF 00153 particlelist=>particlelist%next 00154 i=i+1 00155 END DO 00156 00157 ELSE!lrestart 00158 00159 DO i=1,nParticles 00160 READ(PROBLEM_DATA_HANDLE,NML=ParticleData) 00161 NULLIFY(Particle) 00162 CALL CreateParticle(Particle) 00163 Particle%Q(1)=mass 00164 Particle%xloc=xloc 00165 Particle%Q(imom(1:nDim))=vel(1:nDim) 00166 Particle%Buffer=buff 00167 CALL AddSinkParticle(Particle) 00168 00169 if (i==1) then 00170 Particle%iAccrete=KRUMHOLZ_ACCRETION 00171 CALL CreatePointGravityObject(Particle%PointGravityObj) 00172 Particle%PointGravityObj%alpha = alpha 00173 Particle%PointGravityObj%soft_length = REAL(grav_soft_rad,qPREC)*sink_dx 00174 Particle%PointGravityObj%soft_function =SPLINESOFT 00175 Particle%PointGravityObj%Mass =Particle%Q(1) 00176 Particle%PointGravityObj%v0(1:nDim) =Particle%Q(imom(1:nDim)) 00177 Particle%PointGravityObj%x0 =Particle%xloc 00178 end if 00179 ! 00180 !!! 00181 if (disk) then 00182 ALLOCATE(MyDisk) 00183 ! mydisk%HeightProfile=0 00184 !mydisk%HeightProfile=1 !flared 00185 mydisk%soft_length=REAL(grav_soft_rad,qPREC)*sink_dx 00186 mydisk%soft_function=SPLINESOFT 00187 mydisk%density=densw 00188 mydisk%pressure= &!mydisk%density 00189 Ambient%pressure 00190 mydisk%velocity=Particle%Q(imom(1:nDim)) 00191 ! 00192 mydisk%theta=0d0 !5feb12 00193 !mydisk%theta=10d0*(Pi/180d0) !4feb12 00194 !mydisk%theta=Pi*.5d0 !3feb12 00195 ! 00196 mydisk%phi=0d0 00197 mydisk%position=Particle%xloc 00198 mydisk%thickness=0d0 00199 mydisk%radius= 2d0 !6dec 00200 !1d0 00201 !6d0*REAL(radiusw,qPREC)*sink_dx 00202 !24d0*sink_dx 00203 ! if (.not.mydisk%HeightProfile) 00204 mydisk%height=2d0*REAL(grav_soft_rad,qPREC)*sink_dx 00205 !mydisk%height=mydisk%radius*.1d0 00206 mydisk%central_mass=mass 00207 CALL UpdateDisk(mydisk) 00208 end if!lock 00209 !!! 00210 ! 00211 IF (i.eq.2) THEN 00212 CALL CreateOutflowObject(Particle%OutflowObj) 00213 Particle%OutflowObj%duration = 1.e30 00214 Particle%OutflowObj%radius =REAL(radiusw,qPREC)*sink_dx 00215 Particle%OutflowObj%thickness =REAL(radiusw,qPREC)*sink_dx 00216 Particle%OutflowObj%open_angle = Pi 00217 Particle%OutflowObj%density = densw 00218 Particle%OutflowObj%temperature = 1d0 00219 Particle%OutflowObj%velocity = velw 00220 Particle%OutflowObj%source_vel(1:nDim) = Particle%Q(imom(1:nDim)) 00221 Particle%OutflowObj%position= Particle%xloc 00222 CALL UpdateOutflow(Particle%OutflowObj) 00223 END IF 00224 END DO 00225 END IF!lrestart=0/1 00226 CLOSE(PROBLEM_DATA_HANDLE) 00227 00228 END SUBROUTINE ProblemModuleInit 00229 00232 SUBROUTINE ProblemGridInit(Info) 00233 TYPE(InfoDef) :: Info 00234 END SUBROUTINE ProblemGridInit 00235 00238 SUBROUTINE ProblemBeforeStep(Info) 00239 TYPE(InfoDef) :: Info 00240 INTEGER :: i, nParticles, grav_soft_rad 00241 REAL(KIND=xprec) :: beta,time, mass, xloc(3), vel(3),buff(17) 00242 TYPE(ParticleListDef), POINTER :: particlelist 00243 TYPE(ParticleDef), POINTER :: Particle 00244 LOGICAL,SAVE :: lock=.false. 00245 NAMELIST /ProblemData/ nParticles, densw, velw, windsPresent, disk, t1, t2 00246 NAMELIST /ParticleData/ mass,xloc,vel,alpha,radiusw,grav_soft_rad, buff 00247 00248 return 00249 00250 time=levels(Info%level)%tnow 00251 if (time.lt.t1) then ; return 00252 else if (time.ge.t1 .and. time.le.t2) then 00253 beta = (time-t1)/(t2-t1) ! 0<= beta <=1 00254 else ; beta=1d0 00255 end if 00256 00257 OPEN(UNIT=PROBLEM_DATA_HANDLE, FILE='problem.data', STATUS="OLD") 00258 READ(PROBLEM_DATA_HANDLE,NML=ProblemData) 00259 particleList=>SinkParticles 00260 i=1 00261 DO WHILE (ASSOCIATED(particlelist)) 00262 particle=>particlelist%self 00263 READ(PROBLEM_DATA_HANDLE,NML=ParticleData) 00264 if (i==1) then 00265 Particle%PointGravityObj%alpha =alpha*beta 00266 !print*,'t1,t2i,a*b=',t1,t2,i,alpha*beta 00267 end if 00268 particlelist=>particlelist%next 00269 i=i+1 00270 END DO 00271 CLOSE(PROBLEM_DATA_HANDLE) 00272 00273 if (time.gt.t2 .and. Particle%PointGravityObj%alpha.eq.1d0) lock=.true. 00274 00275 END SUBROUTINE ProblemBeforeStep 00276 00279 SUBROUTINE ProblemAfterStep(Info) 00280 TYPE(InfoDef) :: Info 00281 END SUBROUTINE ProblemAfterStep 00282 00285 SUBROUTINE ProblemSetErrFlag(Info) 00286 TYPE(InfoDef) :: Info 00287 END SUBROUTINE ProblemSetErrFlag 00288 00289 SUBROUTINE ProblemBeforeGlobalStep(n) 00290 INTEGER :: n 00291 END SUBROUTINE ProblemBeforeGlobalStep 00292 00293 END MODULE Problem 00294