Scrambler
1
|
00001 !######################################################################### 00002 ! 00003 ! Copyright (C) 2003-2012 Department of Physics and Astronomy, 00004 ! University of Rochester, 00005 ! Rochester, NY 00006 ! 00007 ! particle_control.f90 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 00031 00035 00036 00039 MODULE ParticleControl 00040 USE ParticleDeclarations 00041 USE ParticleComms 00042 USE ParticleLevelOps 00043 USE ParticleAdvance 00044 USE Timing 00045 USE Bondi 00046 IMPLICIT NONE 00047 00048 ! -------------------------------------------------------------------------------------------------------- 00049 !This approach requires 3 collective calls before beginning the advance step. 00050 !But minimizes the amount of data transferred - as well as additional computations. 00051 00052 !1* !Ghost r_acc cells 00053 00054 !Sink Advance 00055 !Check for new particles and calculate moments 00056 !2 !Collect New Particles and moments 00057 !Do accretion 00058 !3 !Collect new masses, momentum, and advance particles 00059 00060 !Hydro Advance 00061 !Hydro Step 00062 00063 !Sink PostAdvance 00064 !4 !Calculate new particle multipole moments and reduce along with call to elliptic 00065 00066 !Elliptic 00067 !Calculate new gas potential 00068 00069 00070 ! ------------------------------------------------------ 00071 00072 PUBLIC Particle_WriteData, Particle_ReadData 00073 00074 CONTAINS 00075 00076 00077 SUBROUTINE SinkParticleBackup() 00078 TYPE(ParticleListDef), POINTER :: ParticleList, lastparticle 00079 TYPE(ParticleDef), POINTER :: BackupParticle 00080 !Need to duplicate particle list 00081 00082 ParticleList=>BackupParticles 00083 DO WHILE (ASSOCIATED(ParticleList)) 00084 IF (ASSOCIATED(ParticleList%self%PointGravityObj)) THEN 00085 DEALLOCATE(ParticleList%self%PointGravityObj) 00086 NULLIFY(ParticleList%self%PointGravityObj) 00087 END IF 00088 00089 IF (ASSOCIATED(ParticleList%self%OutflowObj)) THEN 00090 DEALLOCATE(ParticleList%self%OutflowObj) 00091 NULLIFY(ParticleList%self%OutflowObj) 00092 END IF 00093 ParticleList=>ParticleList%next 00094 END DO 00095 CALL DestroyParticleList(BackupParticles) 00096 NULLIFY(lastparticle) 00097 ParticleList=>SinkParticles 00098 DO WHILE (ASSOCIATED(ParticleList)) 00099 NULLIFY(BackupParticle) 00100 ALLOCATE(BackupParticle) 00101 BackupParticle=ParticleList%self 00102 IF (ASSOCIATED(ParticleList%self%PointGravityObj)) THEN 00103 NULLIFY(BackupParticle%PointGravityObj) 00104 ALLOCATE(BackupParticle%PointGravityObj) 00105 BackupParticle%PointGravityObj=ParticleList%self%PointGravityObj 00106 END IF 00107 IF (ASSOCIATED(ParticleList%self%OutflowObj)) THEN 00108 NULLIFY(BackupParticle%OutflowObj) 00109 ALLOCATE(BackupParticle%OutflowObj) 00110 BackupParticle%OutflowObj=ParticleList%self%OutflowObj 00111 END IF 00112 CALL AddParticleToList(BackupParticle,BackupParticles,lastParticle) 00113 ParticleList=>ParticleList%next 00114 END DO 00115 END SUBROUTINE SinkParticleBackup 00116 00117 00118 SUBROUTINE SinkParticleRestore() 00119 TYPE(ParticleListDef), POINTER :: ParticleList 00120 TYPE(ParticleDef), POINTER :: RestoreParticle 00121 !Need to remove old particles 00122 ParticleList=>SinkParticles 00123 DO WHILE (ASSOCIATED(ParticleList)) 00124 IF (ASSOCIATED(ParticleList%self%PointGravityObj)) THEN 00125 CALL DestroyPointGravityObject(ParticleList%self%PointGravityObj) 00126 END IF 00127 IF (ASSOCIATED(ParticleList%self%OutflowObj)) THEN 00128 CALL DestroyOutflowObject(ParticleList%self%OutflowObj) 00129 END IF 00130 ParticleList=>ParticleList%next 00131 END DO 00132 00133 CALL DestroyParticleList(SinkParticles) 00134 00135 NrSinkParticles=0 00136 NULLIFY(LastSinkParticle) 00137 ParticleList=>BackupParticles 00138 DO WHILE (ASSOCIATED(ParticleList)) 00139 NULLIFY(RestoreParticle) 00140 ALLOCATE(RestoreParticle) 00141 RestoreParticle=ParticleList%self 00142 IF (ASSOCIATED(ParticleList%self%PointGravityObj)) THEN 00143 NULLIFY(RestoreParticle%PointGravityObj) 00144 CALL CreatePointGravityObject(RestoreParticle%PointGravityObj) 00145 RestoreParticle%PointGravityObj=ParticleList%self%PointGravityObj 00146 END IF 00147 IF (ASSOCIATED(ParticleList%self%OutflowObj)) THEN 00148 NULLIFY(RestoreParticle%OutflowObj) 00149 CALL CreateOutflowObject(RestoreParticle%OutflowObj) 00150 RestoreParticle%OutflowObj=ParticleList%self%OutflowObj 00151 CALL AddOutflowObjToList(RestoreParticle%OutflowObj) 00152 END IF 00153 CALL AddParticleToList(RestoreParticle,SinkParticles,LastSinkParticle) 00154 ParticleList=>ParticleList%next 00155 NrSinkParticles=NrSinkParticles+1 00156 END DO 00157 00158 END SUBROUTINE SinkParticleRestore 00159 00161 SUBROUTINE SinkParticleInit 00162 INTEGER :: r2, i, j, k, ip(3,2) 00163 JeansFact=sqrt(pi*gamma/ScaleGrav)/(JEAN_CELLS*levels(MaxLevel)%dx) 00164 nParticleFields=nDim+nMoments 00165 sink_dv=levels(MaxLevel)%dx**nDim 00166 sink_dx=levels(MaxLevel)%dx 00167 ScaleGravdV=ScaleGrav*sink_dv 00168 r_acc=IR_ACC*levels(maxLevel)%dx 00169 r_soft=half*r_acc 00170 r_acc2=r_acc**2 00171 r_inner_acc=half*sink_dx*sqrt(REAL(nDim,8)) !This is the farthest that the host cell's center can be from the particle 00172 ip(nDim+1:3,:)=0 00173 ip(1:nDim,1)=0-IR_ACC 00174 ip(1:nDim,2)=0+IR_ACC 00175 r2=IR_ACC**2 00176 NrSinkParticles=0 00177 NULLIFY(SinkParticles, LastSinkParticle, BackupParticles, LastNewSinkParticle, NewSinkParticles) 00178 IF (lSinkParticles) THEN 00179 IF (ANY(levels(MaxLevel)%mX(1:nDim) <= 2*(levels(MaxLevel)%gmbc(1)+IR_ACC) .AND. lHydroPeriodic(1:nDim))) THEN 00180 PRINT *,'WARNING: Highest level grid should be at least ', 2*(levels(MaxLevel)%gmbc(1)+IR_ACC)+1, 'cells across for periodic bcs to work with accretion by sink particles. Unphysical results may ensue' 00181 END IF 00182 END IF 00183 ALLOCATE(lControlVolume(ip(1,1):ip(1,2),ip(2,1):ip(2,2),ip(3,1):ip(3,2))) 00184 FORALL(i=ip(1,1):ip(1,2),j=ip(2,1):ip(2,2),k=ip(3,1):ip(3,2)) 00185 lControlVolume(i,j,k)=SUM((/i,j,k/)**2) <= r2 00186 END FORALL 00187 IF (nDim == 2) THEN 00188 nAngularMomentum=1 00189 ELSE 00190 nAngularMomentum=3 00191 END IF 00192 IF (nDim == 2) THEN 00193 nDerivatives=5 !dx dy dxx dyy dxy 00194 ELSE 00195 nDerivatives=9 !dx dy dz dxx dyy dzz dxy dyz dzx 00196 END IF 00197 IF (lSinkParticles) THEN 00198 particle_mbc=IR_ACC !Minimum number of ghost zones required for determining new sink particles 00199 ELSEIF (lSelfGravity) THEN 00200 particle_mbc=0 !Need to get gas forces on particles 00201 ELSE 00202 particle_mbc=0 00203 END IF 00204 CALL InitializeBondi() 00205 00206 END SUBROUTINE SinkParticleInit 00207 00210 SUBROUTINE ParticlePreUpdate(n) 00211 INTEGER :: n 00212 IF (n < 0) RETURN 00213 CALL StartTimer(iParticleUpdate, n) 00214 IF (lSinkParticles) THEN 00215 CALL ClearParticleMomenta(n) 00216 IF (n == MaxLevel) THEN 00217 IF (NrSinkParticles > 0) THEN 00218 CALL CalcMoments() 00219 CALL SynchronizeMoments() 00220 END IF 00221 IF (lSelfGravity) THEN 00222 CALL CheckForNewParticles() 00223 CALL CollectNewParticles 00224 END IF 00225 ! END IF 00226 CALL DoAccretions() 00227 CALL SynchronizeAccretions() 00228 CALL FinalizeAccretions() 00229 END IF 00230 END IF 00231 CALL StopTimer(iParticleUpdate, n) 00232 END SUBROUTINE ParticlePreUpdate 00233 00234 SUBROUTINE ClearParticleMomenta(n) 00235 TYPE(ParticleListDef), POINTER :: particlelist 00236 TYPE(ParticleDef), POINTER :: particle 00237 INTEGER :: n 00238 particlelist=>SinkParticles 00239 DO WHILE(ASSOCIATED(particlelist)) 00240 particle=>particlelist%self 00241 IF (ASSOCIATED(Particle%PointGravityObj)) THEN 00242 Particle%PointGravityObj%dmom(n,:)=0d0 00243 END IF 00244 particlelist=>particlelist%next 00245 END DO 00246 END SUBROUTINE ClearParticleMomenta 00247 00250 SUBROUTINE ParticlePostUpdate(n) 00251 INTEGER :: n 00252 IF (n < 0) RETURN 00253 ! RETURN 00254 IF (lSinkParticles) THEN 00255 ! IF (lSelfGravity) THEN 00256 CALL SynchronizeGasForces(n) 00257 ! END IF 00258 IF (n == MaxLevel) THEN 00259 ! write(*,*) 'advancing particles on level', n 00260 CALL AdvanceParticles 00261 END IF 00262 END IF 00263 IF (lParticles .AND. n == MaxLevel) THEN 00264 CALL UpdateParticleObjects() 00265 END IF 00266 ! write(*,*) 'updating phi sinks on level', n 00267 END SUBROUTINE ParticlePostUpdate 00268 00269 00270 SUBROUTINE ParticlePostRestrict(n) 00271 INTEGER :: n 00272 END SUBROUTINE ParticlePostRestrict 00273 00274 SUBROUTINE UpdateParticleObjects() 00275 TYPE(ParticleListDef), POINTER :: particlelist 00276 TYPE(ParticleDef), POINTER :: particle 00277 REAL(KIND=qPREC) :: newmass 00278 particlelist=>SinkParticles 00279 DO WHILE(ASSOCIATED(particlelist)) 00280 particle=>particlelist%self 00281 !Calculate new mass 00282 IF (ASSOCIATED(Particle%PointGravityObj)) THEN 00283 Particle%PointGravityObj%v0(1:nDim)=Particle%q(imom(1:nDim)) 00284 Particle%PointGravityObj%x0=Particle%xloc 00285 Particle%PointGravityObj%t0=levels(MaxLevel)%tnow+levels(MaxLevel)%dt 00286 Particle%PointGravityObj%Mass=Particle%q(1) 00287 END IF 00288 IF (ASSOCIATED(Particle%OutflowObj)) THEN 00289 Particle%OutflowObj%source_vel=Particle%q(imom(1:nDim)) 00290 Particle%OutflowObj%position=Particle%xloc 00291 Particle%OutflowObj%t0=levels(MaxLevel)%tnow+levels(MaxLevel)%dt 00292 Particle%OutflowObj%Mass=Particle%q(1) 00293 CALL SetOutflowBounds(Particle%OutflowObj) 00294 END IF 00295 particlelist=>particlelist%next 00296 END DO 00297 END SUBROUTINE UpdateParticleObjects 00298 00299 SUBROUTINE FinalizeAccretions() 00300 TYPE(ParticleListDef), POINTER :: particlelist 00301 TYPE(ParticleDef), POINTER :: particle 00302 REAL(KIND=qPREC) :: newmass, newvel(3), temp 00303 REAL(KIND=qPREC), DIMENSION(3) :: accumdP=0 00304 particlelist=>SinkParticles 00305 DO WHILE(ASSOCIATED(particlelist)) 00306 particle=>particlelist%self 00307 !Calculate new mass 00308 ! write(*,*) 'B', MPI_ID, particle%dq(1) 00309 temp=particle%q(1)*particle%q(ivx) 00310 ! IF (MPI_ID == 0) write(*,'(A,10E24.15)') 'Particle%q= ',Particle%Q(1:NrHydroVars) 00311 ! IF (MPI_ID == 0) write(*,'(A,10E24.15)') 'Particle%dq= ', Particle%dQ(1:NrHydroVars) 00312 00313 IF (particle%dQ(1) > 0d0) THEN 00314 newmass=(Particle%Q(1)+Particle%dQ(1)) 00315 IF (newmass <= 0) THEN 00316 write(*,*) 'error in particle_control.f90' 00317 STOP 00318 END IF 00319 newvel(1:nDim)=(Particle%Q(imom(1:nDim))*Particle%Q(1)+Particle%dQ(imom(1:nDim)))/newmass 00320 IF (.NOT. Particle%lFixed) Particle%xloc=Particle%xloc+(Particle%drmass)/newmass 00321 Particle%Q(1:NrHydroVars)=Particle%Q(1:NrHydroVars)+Particle%dQ(1:NrHydroVars) 00322 Particle%Q(imom(1:nDim))=newvel 00323 ! Don't want fixed particles to give velocities to point gravity objects. 00324 IF (Particle%lFixed) Particle%q(imom(1:nDim))=0d0 00325 00326 ! mean_density=mean_density-Particle%dQ(1)/Product(GxBounds(1:nDim,2)-GxBounds(1:nDim,1)) 00327 END IF 00328 ! accumdP(1)=accumdP(1)+particle%dq(ivx) 00329 ! write(*,*) 'accumulated dp=', accumdP(1) 00330 ! write(*,*) 'particle p=', Particle%q(1)*particle%q(ivx) 00331 00332 IF (ASSOCIATED(Particle%OutflowObj)) THEN 00333 Particle%OutflowObj%accretionrate=Particle%dQ(1)/levels(MaxLevel)%dt 00334 END IF 00335 00336 ! write(*,*) 'momenta', temp+particle%dq(ivx), particle%q(1)*particle%q(ivx) 00337 00338 Particle%J=Particle%J+Particle%dJ 00339 00340 00341 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Print statements added by Erica to diagnose psrticle kicks 00342 00343 ! IF (MPI_ID == 0) THEN 00344 00345 ! write(*,*) 'dM=', Particle%dM 00346 ! write(*,*) 'dP=', Particle%dP 00347 ! write(*,*) 'avel=', Particle%vel 00348 ! write(*,'(A,3E20.12,A,E20.12)') 'axloc=', Particle%xloc, 'time', Levels(MaxLevel)%tnow 00349 ! write(*,'(A,5E20.12,A,E20.12)') 'dq:' , Particle%dQ(1:5), 'time' , Levels(MaxLevel)%tnow 00350 ! write(*,'(A,3E20.12,A,E20.12, A,10E20.12 )') 'Q:' , Particle%Q(1:5), 'time', Levels(MaxLevel)%tnow 00351 ! accumDP=accumdP+Particle%dP 00352 ! write(*,*) 'accumdP=', accumdP 00353 ! write(*,*) 'drmass=', Particle%drmass 00354 00355 ! END IF 00356 00357 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00358 00359 !zero out contributions 00360 Particle%dJ=0 00361 Particle%dQ=0 00362 Particle%drmass=0 00363 particlelist=>particlelist%next 00364 END DO 00365 END SUBROUTINE FinalizeAccretions 00366 00369 SUBROUTINE Particle_WriteData(chandle) 00370 00371 USE ChomboDeclarations, ONLY: ChomboHandle, Chombo_OpenParticleGroup, Chombo_CloseParticleGroup 00372 USE HDF5Declarations, ONLY: Add_HDF5_Attribute_Int 00373 00374 TYPE(ChomboHandle), POINTER :: chandle 00375 00376 TYPE(ParticleListDef), POINTER :: particle_list 00377 TYPE(ParticleDef), POINTER :: particle 00378 INTEGER :: i_err 00379 00380 00381 ! Create a new particle group in the chombo file, and write the number of particles to it. 00382 i_err = Chombo_OpenParticleGroup(chandle) 00383 00384 ! Store the number of components and the number of particles. 00385 CALL Add_HDF5_Attribute_Int("num_components", chandle%particle_group_id, IO_TRACKED_COMPONENTS) 00386 CALL Add_HDF5_Attribute_Int("num_particles", chandle%particle_group_id, NrSinkParticles) 00387 00388 ! If there are any sink particles, then create datasets to store their data. Otherwise, 00389 ! don't create the datasets (since there's no need to take up file space). 00390 ! IF (NrSinkParticles > 0) THEN 00391 00392 ! Initialize the Chombo datasets that will store the sink particle data. 00393 CALL Particle_InitChomboDatasets(chandle) 00394 00395 particle_list => SinkParticles 00396 00397 ! Loop over the list of sink particles and write their data to the new component datasets. 00398 DO WHILE (ASSOCIATED(particle_list)) 00399 particle => particle_list%self 00400 CALL Particle_WriteObjectToChomboFile(chandle, particle) 00401 particle_list => particle_list%next 00402 00403 END DO 00404 00405 ! END IF 00406 00407 ! Close the particles group. 00408 CALL Chombo_CloseParticleGroup(chandle) 00409 00410 END SUBROUTINE Particle_WriteData 00411 00414 SUBROUTINE Particle_ReadData(nframe) 00415 00416 USE ChomboDeclarations, ONLY: ChomboHandle, CHOMBO_HANDLE_READ, CreateChomboHandle, CloseChomboHandle, & 00417 Chombo_OpenParticleGroup, Chombo_CloseParticleGroup 00418 00419 INTEGER :: nframe 00420 00421 CHARACTER(LEN=23) :: s_filename 00422 TYPE(ChomboHandle), POINTER :: chandle 00423 TYPE(ParticleDef), POINTER :: particle 00424 INTEGER :: i_err 00425 INTEGER :: nr_particles 00426 00427 00428 ! Open a reading handle for the specified frame. 00429 WRITE(s_filename, '(A10,I5.5,A4)') 'out/chombo', nframe, '.hdf' 00430 CALL CreateChomboHandle(s_filename, chandle, CHOMBO_HANDLE_READ) 00431 00432 ! Open the 'particles' group, save the number of elements in it. 00433 nr_particles = Chombo_OpenParticleGroup(chandle) 00434 00435 chandle%particle_offset = 0 00436 IF (nr_particles > 0 .AND. MPI_ID == 0) write(*,*) "Found ", nr_particles, "particles" 00437 00438 DO WHILE (chandle%particle_offset < nr_particles) 00439 00440 ! Create a new particle object to be populated from the Chombo file. 00441 NULLIFY(particle) 00442 CALL CreateParticle(particle) 00443 00444 ! Read in the particle data from the Chombo file. This subroutine also advances the 00445 ! chandle%particle_offset variable. 00446 CALL Particle_ReadObjectFromChombo(chandle, particle) 00447 00448 ! Adds the particle to the particle list. I am only assuming at this point that I should 00449 ! be using AddSinkParticle and not AddNewSinkParticle; we will find out. 00450 CALL AddSinkParticle(particle) 00451 END DO 00452 00453 ! Close the particles group. 00454 CALL Chombo_CloseParticleGroup(chandle) 00455 00456 CALL CloseChomboHandle(chandle) 00457 00458 END SUBROUTINE Particle_ReadData 00459 00460 00461 00462 00463 00464 ! Other options for the sink particle algorithm 00465 00466 00467 00468 !To do the accretion on a cell by cell basis we need to be able to calculate the binding energy 00469 !of each particle and it's surrounding gas... This requires knowledge of the density in the accretion radius of each sink particle. 00470 !If the accretion radius is 4 - this is a 8x8x8 array of floats for each particle. 00471 00472 !Alternatively we could use a multipole expansion and store just the first few terms 00473 !1 !Then we would calculate the expansion and reduceall the particle moments 00474 !Each processor could then do the accretion step independently 00475 !2 !Each processor would also create a list of potential new particles that would be shared... 00476 !* !Then at the beginning of each hydro step during the overlap stage - the potential particles would collect grids as well. 00477 !These particles would then be checked and possibly created. 00478 !3 !Then a global reduce would collect all of the new particles 00479 !4 !Each grid would then receive updated data from the new particles first accretion... 00480 00481 00482 00483 ! - after a ghosting for the hydro solver - new zero mass particles could be checked for and created - and could accrete 00484 !Then any grid that overlapped a new particle could receive new ghost data 00485 00486 !As well as create new potential particles 00487 !Before creating new particles there would need to be a ghosting of all quantities in a 4 cell region 00488 !However if this is done before each hydro step - each particle creation did not modify any quantities - then every 00489 !This still requires ghosting of 4 cells around potential particles to check the other criteria... 00490 !Then there would be a collective gather of new particles and a reduceall of accreted masses etc... 00491 00492 00493 00494 00495 00496 00497 !Do accretion of gas (in ghost zones as well) (but only store contributions from local cells) 00498 00499 !2 !Collect new particles position/mass/velocity and reduce accreted mass, momentum, energy... 00500 !3 ! 00501 00502 !1 !Alternatively we could ghost enough cells so that every cell has enough information to calculate the potential directly... 00503 !This requires a an additional ghosting call of density for 8 cells around each grid and everything else for 4 cells... 00504 !But allows for particles to be directly created/accreted. 00505 !Every cell could determine whether it should become a new sink particle and accrete - or whether it should be accreted by an existing sink particle... 00506 !2 !There would still need to be a collective reduceall to get the new particles mass, velocity, and postion... 00507 !But this requires only two communication calls. 00508 00509 00510 ! 00511 00512 !Since we need to calculate the binding energy between the particles and 00513 00514 !We've just performed an accretion step so any particles inside the accretion radius of an existing particle cannot become new particles... 00515 00516 END MODULE ParticleControl