Scrambler  1
particle_level_ops.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_level_ops.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 ParticleLevelOps
00033    USE ParticleDeclarations
00034    USE GlobalDeclarations
00035    USE TreeDeclarations
00036    USE ParticleInfoOps
00037 
00038    IMPLICIT NONE
00039    PUBLIC  CalcMoments, CheckForNewParticles, DoAccretions, GetGasForces
00040 
00041    PRIVATE
00042 CONTAINS
00043 
00045    SUBROUTINE CalcMoments()
00046       TYPE(NodeDefList), POINTER :: nodelist
00047       TYPE(ParticleListDef), POINTER :: particlelist     
00048       particlelist=>SinkParticles
00049       DO WHILE (ASSOCIATED(particlelist))
00050          nodelist=>Nodes(MaxLevel)%p
00051          IF (particlelist%self%iaccrete == FEDERRATH_ACCRETION) THEN
00052             particlelist%self%moments=0
00053             DO WHILE (ASSOCIATED(nodelist))
00054                CALL CalcMoment(particlelist%self,nodelist%self%info,.false.)
00055                nodelist=>nodelist%next
00056             END DO
00057             !         write(*,*) "calculated moment for particle", particlelist%self%moments
00058          ELSEIF (particlelist%self%iaccrete == KRUMHOLZ_ACCRETION) THEN
00059             Particlelist%self%AccretionRate=0d0
00060             Particlelist%self%Bondi_kernel=0d0
00061             DO WHILE (ASSOCIATED(nodelist))
00062                CALL BondiAccretionRate(particlelist%self, nodelist%self%info)
00063                nodelist=>nodelist%next
00064             END DO
00065          END IF
00066          particlelist=>particlelist%next
00067       END DO
00068    END SUBROUTINE CalcMoments
00069 
00070 
00072    SUBROUTINE CheckForNewParticles()
00073       TYPE(NodeDefList), POINTER :: nodelist
00074       TYPE(ParticleDef), POINTER :: Particle, NewParticle      
00075       nodelist=>Nodes(MaxLevel)%p
00076       DO WHILE (ASSOCIATED(nodelist))
00077          CALL CheckForNewParticle(nodelist%self%info)
00078          nodelist=>nodelist%next
00079       END DO
00080 
00081       !      IF (MPI_ID == 0) THEN
00082       !         CALL CreateParticle(NewParticle)
00083       !         NewParticle%moments(1)=5
00084       !         NewParticle%mass=1
00085       !         NewParticle%xloc=(/2,3,4/)
00086       !         CALL AddNewSinkParticle(NewParticle)
00087       !      ELSE IF (MPI_ID == 1) THEN
00088       !         CALL CreateParticle(NewParticle)
00089       !         NewParticle%moments(1)=10
00090       !         NewParticle%mass=6
00091       !         NewParticle%xloc=(/7,8,9/)        
00092       !         CALL AddNewSinkParticle(NewParticle)
00093       !         NULLIFY(NewParticle)
00094       !         CALL CreateParticle(NewParticle)
00095       !         NewParticle%moments(1)=15
00096       !         NewParticle%mass=11
00097       !         NewParticle%xloc=(/12,13,14/)        
00098       !         CALL AddNewSinkParticle(NewParticle)
00099       !      END IF
00100 
00101 
00102    END SUBROUTINE CheckForNewParticles
00103 
00105    SUBROUTINE DoAccretions()
00106       TYPE(NodeDefList), POINTER :: nodelist
00107       TYPE(ParticleListDef), POINTER :: ParticleList
00108       IF (NrSinkParticles == 0) RETURN
00109       nodelist=>Nodes(MaxLevel)%p
00110       DO WHILE (ASSOCIATED(nodelist))
00111          CALL DoAccretion(nodelist%self%info)
00112          nodelist=>nodelist%next
00113       END DO
00114       
00115       !Now iterate adjusting mass accretion by massloss due to outflow particles
00116 !      ParticleList=>SinkParticles
00117 !      DO WHILE (ASSOCIATED(ParticleList))
00118 !         IF (ASSOCIATED(ParticleList%self%OutflowObj)) THEN
00119 !            ParticleList%self%dM=ParticleList%self%dM-ParticleList%self%OutflowObj%massloss
00120 !            ParticleList%self%OutflowObj%massloss=0
00121 !         END IF
00122 !         ParticleList=>ParticleList%next
00123 !      END DO
00124       
00125    END SUBROUTINE DoAccretions
00126 
00128    SUBROUTINE GetGasForces()
00129       TYPE(NodeDefList), POINTER :: nodelist
00130       TYPE(ParticleListDef), POINTER :: ParticleList
00131 
00132       IF (NrSinkParticles == 0) RETURN
00133 
00134       ParticleList=>SinkParticles
00135       DO WHILE (ASSOCIATED(ParticleList))
00136          ParticleList%self%gas_accel=0
00137          nodelist=>Nodes(MaxLevel)%p
00138          DO WHILE (ASSOCIATED(nodelist))
00139             CALL GetGasForce(ParticleList%self, nodelist%self%Info)
00140             nodelist=>nodelist%next
00141          END DO
00142          ParticleList=>ParticleList%next
00143       END DO
00144    END SUBROUTINE GetGasForces
00145 END MODULE ParticleLevelOps
 All Classes Files Functions Variables