Scrambler  1
rotating.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 !    rotating.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 RotatingSrc
00024 
00025   USE DataDeclarations
00026   USE PhysicsDeclarations
00027   USE EOS
00028   USE SourceDeclarations
00029 
00030   IMPLICIT NONE
00031   PRIVATE
00032   PUBLIC Rotating
00033   
00034 CONTAINS
00035 
00036   SUBROUTINE Rotating(q,dqdt,pos,lform)
00037     ! Interface declarations
00038     REAL(KIND=qPrec) :: q(:)
00039     REAL(KIND=qPrec),INTENT(INOUT) :: dqdt(:)
00040     REAL(KIND=xPrec) :: pos(:)
00041     LOGICAL :: lform
00042     
00043     SELECT CASE(lform)
00044     CASE(PRIMITIVE)
00045        CALL PrimRot(q,dqdt,pos)
00046     CASE(CONSERVATIVE)
00047        CALL ConsRot(q,dqdt,pos)
00048     END SELECT
00049 
00050   END SUBROUTINE Rotating
00051 
00053   SUBROUTINE PrimRot(q,dqdt,pos)
00054     ! Interface declarations
00055     REAL(KIND=qPrec) :: q(:)
00056     REAL(KIND=qPrec),INTENT(INOUT) :: dqdt(:)
00057     REAL(KIND=xPrec) :: pos(:)
00058     ! Local declarations
00059     REAL(KIND=qPrec) :: r
00060 
00061     ! local vars for readability
00062 
00063     r=sqrt(sum(pos(1:2)**2))
00064     
00065     !centrifugal force ( a_coriolis = -2*omega cross v )
00066     dqdt(imom(1:2))=dqdt(imom(1:2))-2d0*OmegaRot*(/-q(imom(2)), +q(imom(1))/)
00067     
00068     !centripetal force ( a_centrip = -omega cross (omega cross r) ) 
00069     dqdt(imom(1:2))=dqdt(imom(1:2))+OmegaRot**2*pos(1:2)
00070 !    write(*,*) r, OmegaRot, dqdt(imom(1:2))
00071   END SUBROUTINE PrimRot
00072 
00073 
00075   SUBROUTINE ConsRot(q,dqdt,pos)!,rotobj)
00076     ! Interface declarations
00077     REAL(KIND=qPrec) :: q(:)
00078     REAL(KIND=qPrec),INTENT(INOUT) :: dqdt(:)
00079     REAL(KIND=xPrec) :: pos(:)
00080     ! Local declarations
00081     REAL(KIND=qPrec) :: r
00082 
00083     write(*,*) 'consrot not implemented yet'
00084     STOP
00085 
00086     ! local vars for readability
00087 
00088     r=sqrt(sum(pos(1:2)**2))
00089     
00090     !centrifugal force ( a_coriolis = -2*omega cross v )
00091     dqdt(imom(1:2))=dqdt(imom(1:2))-2d0*OmegaRot*(/-q(imom(2)), +q(imom(1))/)
00092     
00093     !centripetal force ( a_centrip = -omega cross (omega cross r) ) 
00094     dqdt(imom(1:2))=dqdt(imom(1:2))+OmegaRot**2*pos(1:2)*q(1)
00095   END SUBROUTINE ConsRot
00096 END MODULE RotatingSrc
 All Classes Files Functions Variables