Scrambler  1
selfgravity.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 !    selfgravity.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 SelfGravitySrc
00024    USE DataDeclarations
00025    USE PhysicsDeclarations
00026    USE EOS
00027    USE SourceDeclarations
00028    IMPLICIT NONE
00029    PRIVATE
00030    PUBLIC :: SelfGravity
00031 
00032 CONTAINS
00033 
00034 
00035 
00036    SUBROUTINE SelfGravity(q,dqdt,x,dx,t,Info,ip,lform)
00037       ! Interface declarations
00038       TYPE(InfoDef) :: Info
00039       INTEGER :: ip(3),ir(3),il(3)
00040       REAL(KIND=qPrec) :: q(:)
00041       REAL(KIND=qPrec) :: dqdt(:),x(3),dx,pos(3),t, pOffset(3),r2,r,f_grav(3)
00042       ! Internal declarations
00043       INTEGER :: level,i,j
00044       INTEGER :: smbc
00045       REAL(KIND=qPREC), DIMENSION(:,:,:), ALLOCATABLE :: gradPhi, Phi, rho
00046       LOGICAL :: lform
00047       level=Info%level
00048       ir=ip
00049       il=ip
00050 !      DO i=ip(1)-1,ip(1)+1
00051 !         DO j=ip(2)-1,ip(2)+1
00052 !            IF (iSNAN(Info%q(i,j,1,iPhiGas))) THEN
00053 !               write(*,*) 'found NAN in phi at', i,j
00054 !               write(*,*) 'ip =', ip
00055 !               write(*,*) 'x=', Info%xBounds(1:2,1)+levels(Info%level)%dx*REAL((/i,j/)-.5d0)
00056 !               STOP
00057 !            END IF
00058 !            IF (iSNAN(Info%q(i,j,1,iPhiDot))) THEN
00059 !               write(*,*) 'found NAN in phiDot at', i,j
00060 !               write(*,*) 'ip =', ip
00061 !               write(*,*) 'x=', Info%xBounds(1:2,1)+levels(Info%level)%dx*REAL((/i,j/)-.5d0)
00062 !               STOP
00063 !            END IF
00064 !         END DO
00065 !      END DO
00066       DO i=1,nDim
00067          ir(i)=min(ip(i)+1,uBound(Info%q,i))
00068          il(i)=max(ir(i)-2,lBound(Info%q,i))
00069          ir(i)=il(i)+2
00070          f_grav(i)=((Info%q(ir(1),ir(2),ir(3),iPhiGas)-Info%q(il(1),il(2),il(3),iPhiGas)))/2d0 !+ &
00071 !              (t-levels(level)%tnow)*(Info%q(ir(1),ir(2),ir(3),iPhiDot)-Info%q(il(1),il(2),il(3),iPhiDot))/2d0
00072          ir(i)=ip(i)
00073          il(i)=ip(i)
00074       END DO
00075 !      elliptic_maxspeed(level)=max(elliptic_maxspeed(level),sqrt(nDim*(maxval(abs(f_grav)))))
00076       f_grav(1:nDim)=-f_grav(1:nDim)/levels(level)%dx
00077       IF (lform .eqv. PRIMITIVE) THEN
00078          dqdt(imom(1:nDim))=dqdt(imom(1:nDim))+f_grav(1:nDim)
00079       ELSE
00080          dqdt(imom(1:nDim))=dqdt(imom(1:nDim))+f_grav(1:nDim)*q(1)
00081          IF (iE .ne. 0) dqdt(iE)=dqdt(iE)+SUM(f_grav(1:nDim)*q(imom(1:nDim)))
00082       END IF
00083 
00084    END SUBROUTINE SelfGravity
00085 
00086 END MODULE SelfGravitySrc
 All Classes Files Functions Variables