Scrambler  1
particle_comms.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_comms.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 
00029 
00032 MODULE ParticleComms
00033    USE ParticleDeclarations
00034    USE GlobalDeclarations
00035    IMPLICIT NONE
00036    
00037    PUBLIC SynchronizeMoments, SynchronizeAccretions, CollectNewParticles, SynchronizeGasForces
00038 
00039 CONTAINS
00040 
00042    SUBROUTINE SynchronizeMoments()
00043       REAL(KIND=qPREC), DIMENSION(:,:), ALLOCATABLE :: SinkData
00044       INTEGER :: i, iErr
00045       TYPE(ParticleListDef), POINTER :: ParticleList
00046       TYPE(ParticleDef), POINTER :: Particle
00047 
00048       IF (NrSinkParticles == 0) RETURN
00049 
00050       ALLOCATE(SinkData((nMoments+2),NrSinkParticles))
00051       particlelist=>SinkParticles
00052       i=0
00053       DO WHILE(ASSOCIATED(particlelist))
00054          particle=>particlelist%self
00055          i=i+1
00056          SinkData(1:nMoments,i)=particle%moments
00057          SinkData(nMoments+1,i)=particle%accretionrate
00058          SinkData(nmoments+2,i)=particle%bondi_kernel
00059          particlelist=>particlelist%next
00060       END DO
00061       CALL MPI_ALLREDUCE(MPI_IN_PLACE,SinkData,i*(nMoments+2),MPI_DOUBLE_PRECISION, MPI_SUM, levels(MaxLevel)%MPI_COMM, iErr)
00062       particlelist=>SinkParticles
00063       i=0
00064       DO WHILE(ASSOCIATED(particlelist))
00065          particle=>particlelist%self
00066          i=i+1
00067          particle%moments=SinkData(1:nMoments,i)
00068          particle%AccretionRate=SinkData(nMoments+1,i)
00069          Particle%Bondi_kernel=SinkData(nMoments+2,i)
00070          particlelist=>particlelist%next
00071       END DO
00072       DEALLOCATE(SinkData)
00073    END SUBROUTINE SynchronizeMoments
00074 
00076    SUBROUTINE SynchronizeAccretions
00077       REAL(KIND=qPREC), DIMENSION(:,:), ALLOCATABLE :: SinkData
00078       INTEGER :: i, iErr, NrSinkFields
00079       TYPE(ParticleListDef), POINTER :: particlelist
00080       TYPE(ParticleDef), POINTER :: particle
00081 
00082       IF (NrSinkParticles==0) RETURN
00083       NrSinkFields=NrHydroVars+nDim+nAngularMomentum
00084 
00085       ALLOCATE(SinkData(NrSinkFields,NrSinkParticles))
00086       particlelist=>SinkParticles
00087       i=0
00088       DO WHILE(ASSOCIATED(particlelist))
00089          particle=>particlelist%self
00090          i=i+1
00091          SinkData(:,i)=(/particle%dQ(1:NrHydroVars), particle%drmass(1:nDim),particle%dJ(1:nAngularMomentum)/)
00092          particlelist=>particlelist%next
00093       END DO
00094       CALL MPI_ALLREDUCE(MPI_IN_PLACE,SinkData,i*NrSinkFields,MPI_DOUBLE_PRECISION, MPI_SUM, levels(MaxLevel)%MPI_COMM, iErr)
00095       particlelist=>SinkParticles
00096       i=0
00097       DO WHILE(ASSOCIATED(particlelist))
00098          particle=>particlelist%self
00099          i=i+1
00100          !Get collected contributions
00101          particle%dQ(1:NrHydroVars)=SinkData(1:NrHydroVars,i)
00102          Particle%drmass(1:nDim)=SinkData(NrHydroVars+1:NrHydroVars+nDim,i)
00103          Particle%dJ(1:nAngularMomentum)=SinkData(NrHydroVars+nDim+1:NrHydroVars+nDim+nAngularMomentum,i)
00104          particlelist=>particlelist%next
00105       END DO
00106 
00107       DEALLOCATE(SinkData)
00108 
00109    END SUBROUTINE SynchronizeAccretions
00110 
00111 
00113    SUBROUTINE SynchronizeGasForces(n)
00114       REAL(KIND=qPREC), DIMENSION(:,:), ALLOCATABLE :: SinkData
00115       INTEGER :: i, iErr, n
00116       TYPE(ParticleListDef), POINTER :: particlelist
00117       TYPE(ParticleDef), POINTER :: particle
00118       REAL(KIND=qPREC) :: newmass
00119 
00120       IF (NrSinkParticles==0) RETURN
00121 
00122       ALLOCATE(SinkData(nDim,NrSinkParticles))
00123       particlelist=>SinkParticles
00124       i=0
00125       DO WHILE(ASSOCIATED(particlelist))
00126          particle=>particlelist%self
00127          i=i+1
00128          IF (ASSOCIATED(particle%pointgravityobj)) &
00129               SinkData(:,i)=particle%pointgravityobj%dMom(n,1:nDim)
00130          particlelist=>particlelist%next
00131       END DO
00132       CALL MPI_ALLREDUCE(MPI_IN_PLACE,SinkData,Size(SinkData),MPI_DOUBLE_PRECISION, MPI_SUM, levels(MaxLevel)%MPI_COMM, iErr)
00133       particlelist=>SinkParticles
00134       i=0
00135       DO WHILE(ASSOCIATED(particlelist))
00136          particle=>particlelist%self
00137          i=i+1
00138          !Get collected contributions
00139          IF (ASSOCIATED(particle%pointgravityobj)) &
00140               Particle%pointgravityobj%dMom(n,1:nDim)=SinkData(:,i)
00141          particlelist=>particlelist%next
00142       END DO
00143       DEALLOCATE(SinkData)
00144 
00145    END SUBROUTINE SynchronizeGasForces
00146 
00147 
00149    SUBROUTINE CollectNewParticles()
00150       !Global communication routine to gather new particles
00151       INTEGER :: nparticles !Number of local new particles
00152       INTEGER :: nGlobalParticles !Number of global new particles
00153       INTEGER, DIMENSION(:), ALLOCATABLE :: NParticlesByProcessor !Array containing the number of new particles on each processor
00154       INTEGER, DIMENSION(:), ALLOCATABLE :: OffsetsByProcessor !Array containing the offsets for storing the new particles from each processor
00155       REAL(KIND=qPREC), DIMENSION(:,:), ALLOCATABLE :: Particles !arrays containing pertinent particle information for local particles
00156       REAL(KIND=qPREC), DIMENSION(:,:), ALLOCATABLE :: GlobalParticles !arrays containing pertinent particle information for global particles
00157       INTEGER :: iErr
00158       TYPE(ParticleListDef), POINTER :: particlelist
00159       TYPE(ParticleDef), POINTER :: particle, NewParticle
00160       INTEGER :: i
00161       ! Get local contribution to new particles
00162       nParticles=ParticleCount(NewSinkParticles)
00163       ALLOCATE(Particles(nParticleFields,nParticles))
00164       particlelist=>NewSinkParticles
00165       i=0
00166       DO WHILE (ASSOCIATED(particlelist))
00167          i=i+1
00168          particle=>particlelist%self
00169          Particles(:,i)=(/particle%xloc(1:nDim), particle%moments(1:nMoments)/)
00170          particlelist=>particlelist%next
00171       END DO
00172 
00173       ! Create space and receive information on number of particles 
00174       ALLOCATE(NParticlesByProcessor(MPI_NP), OffsetsByProcessor(MPI_NP))
00175       CALL MPI_AllGather(nParticles, 1, MPI_INTEGER, NParticlesByProcessor, 1, MPI_INTEGER, levels(MaxLevel)%MPI_COMM, iErr)
00176 
00177 !      write(*,*) "nParticlesByProcessor=", nParticlesByProcessor
00178 
00179       !Calculate Offsets
00180       OffsetsByProcessor(1)=0
00181       DO i=2,MPI_NP
00182          OffsetsByProcessor(i)=OffsetsByProcessor(i-1)+NParticlesByProcessor(i-1)
00183       END DO
00184       nGlobalParticles=OffsetsByProcessor(MPI_NP)+NParticlesByProcessor(MPI_NP)
00185       IF (nGlobalParticles > 0) THEN
00186          ! Allocate space for and receive (collect) all particle info
00187          ALLOCATE(GlobalParticles(nParticleFields,nGlobalParticles))
00188          CALL MPI_ALLGatherV(Particles,nParticles*nParticleFields,MPI_DOUBLE_PRECISION,GlobalParticles,NParticlesByProcessor*nParticleFields,OffsetsByProcessor*nParticleFields,MPI_DOUBLE_PRECISION,levels(MaxLevel)%MPI_COMM, iErr)
00189          !      write(*,*) "nGlobalParticles=",nGlobalParticles
00190          ! Replace local particle list with global particlelist
00191          CALL DestroyParticleList(NewSinkParticles)
00192          NULLIFY(NewSinkParticles, LastNewSinkParticle)
00193          DO i=1,nGlobalParticles         
00194             NULLIFY(NewParticle)
00195             CALL CreateParticle(NewParticle)
00196             NewParticle%xloc(1:nDim)=GlobalParticles(1:nDim,i)
00197             NewParticle%moments=GlobalParticles(nDim+1:,i)
00198             NewParticle%iAccrete=FEDERRATH_ACCRETION
00199             CALL AddSinkParticle(NewParticle)
00200             CALL CreatePointGravityObject(NewParticle%PointGravityObj)
00201             NewParticle%PointGravityObj%x0(1:nDim)=GlobalParticles(1:nDim,i)
00202             NewParticle%PointGravityObj%soft_length=1d0*sink_dx !NewParticle%radius*sink_dx
00203             NewParticle%PointGravityObj%soft_function=SPLINESOFT
00204          END DO
00205          DEALLOCATE(GlobalParticles)
00206       END IF
00207    END SUBROUTINE CollectNewParticles
00208 
00209 
00210 END MODULE ParticleComms
 All Classes Files Functions Variables