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