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