Scrambler  1
uniformgravity.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 !    uniformgravity.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 !#########################################################################
00023 MODULE UniformGravitySrc
00024    USE GlobalDeclarations
00025    USE DataDeclarations
00026    USE PhysicsDeclarations
00027    USE EOS
00028    USE SourceDeclarations
00029    IMPLICIT NONE
00030    REAL(KIND=qPREC), DIMENSION(3), PARAMETER :: f_grav=(/0d0,1d0,0d0/)
00031 
00032 CONTAINS
00033   SUBROUTINE UniformGravity_src(q,dqdt,t,lform)
00034      REAL(KIND=qPrec) :: q(:)
00035      REAL(KIND=qPREC) :: dqdt(:)
00036      LOGICAL :: lform
00037      REAL(KIND=qPREC) :: t
00038      IF (lform .eqv. PRIMITIVE) THEN
00039         dqdt(imom(1:nDim))=dqdt(imom(1:nDim)) - UniformGravity * f_grav(1:nDim)
00040      ELSE
00041         dqdt(imom(1:nDim))=dqdt(imom(1:nDim)) - UniformGravity * f_grav(1:nDim) * q(1)
00042         IF (iE .ne. 0) dqdt(iE)=dqdt(iE) - UniformGravity * q(3)
00043      END IF
00044   END SUBROUTINE UniformGravity_src
00045 END MODULE UniformGravitySrc
 All Classes Files Functions Variables