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