Scrambler  1
particle_control.f90
Go to the documentation of this file.
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
 All Classes Files Functions Variables