Scrambler
1
|
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