Scrambler  1
TrueLoveProblems/problem.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 !    problem.f90 of module TrueLoveProblems 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 !#########################################################################
00025 
00028 
00032 
00035 MODULE Problem
00036   USE Clumps
00037   USE Winds
00038   USE DataDeclarations
00039   USE Ambients
00040   USE Totals
00041   USE Fields
00042 
00043   IMPLICIT NONE
00044   SAVE
00045 
00046   PUBLIC ProblemModuleInit, ProblemGridInit, &
00047        ProblemBeforeStep, ProblemAfterStep, ProblemSetErrFlag, ProblemBeforeGlobalStep
00048   TYPE(ClumpDef), POINTER :: myclump
00049   TYPE(pWindDef), DIMENSION(:), ALLOCATABLE :: MyWinds
00050   INTEGER :: nWinds
00051   TYPE(AmbientDef), POINTER :: Ambient
00052 CONTAINS
00053 
00055    SUBROUTINE ProblemModuleInit()
00056       INTEGER :: i,edge,j
00057       REAL(KIND=qPREC) :: radius=1    !clump radius
00058       REAL(KIND=qPREC) :: thickness=.1 !thickness of clump smoothing region
00059       REAL(KIND=qPREC) :: density=10   !Clump peak density
00060       REAL(KIND=qPREC) :: temp=.1      !Clump temperature
00061       REAL(KIND=qPREC), DIMENSION(3) :: velocity= (/0,0,0/)  !Clump velocity (in direction of clump axis)
00062       REAL(KIND=qPREC) :: theta=0     !Angle between X-axis and clump axis (towards y-axis)
00063       REAL(KIND=qPREC) :: phi=0       !Angle around X-axis to clump axis
00064       !     REAL(KIND=qPREC) :: mu=0        !Defines ratio of maximum magnetic pressure to ambient pressure
00065       !     REAL(KIND=qPREC) :: eta=0       !Parameter that determines ratio of maximum poloidal pressure to maximum toroidal pressure
00066       !     REAL(KIND=qPREC) :: B_theta=0   !Angle from clump axis to define clump orientation
00067       !     REAL(KIND=qPREC) :: B_phi=0     !Rotation around clump axis to define clump orientation(velocity)
00068       REAL(KIND=qPREC) :: B_tor=0     !Maximum Bfield for toroidal configuration
00069       REAL(KIND=qPREC) :: B_pol=0     !Maximum Bfield for poloidal configuration
00070       REAL(KIND=qPREC) :: Omega=0     !Solid body angular rotation
00071       REAL(KIND=qPREC) :: m2A         !Azimuthal density perturbation
00072       REAL(KIND=qPREC), DIMENSION(3) :: xloc=(/0,0,0/)  !Clump location
00073       INTEGER :: iTracer                                !Clump Tracer
00074       
00075       INTEGER :: nwaves=0, nMHDwaves=0
00076       REAL(KIND=qPREC), DIMENSION(3) :: wavevector
00077       REAL(KIND=qPREC) :: phase, amplitude, amplitudes(3)
00078 
00079       REAL(KIND=qPREC) :: alpha        !< True love alpha parameter (ratio of thermal to gravitational energy). \f$ \alpha = \frac{5}{2} \left ( \frac{3}{4 \pi \rho_o M^2} \right )^(1/3) \frac{c_s^2}{G} \f$
00080       REAL(KIND=qPREC) :: beta_rot   !< True love beta rotational parameter (ratio of rotational to gravitational energy). \f$ \beta_{\Omega} = \frac{1}{4 \pi} \frac{\Omega^2}{G \rho_o} \f$
00081 
00082       REAL(KIND=qPREC) :: rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut
00083       TYPE(TotalDef), POINTER :: Total
00084       NAMELIST /AmbientData/ rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut
00085       NAMELIST /ProblemData/ density,velocity, xloc, radius, thickness, temp,theta, phi, B_tor, B_pol, beta_rot, alpha, m2A, nwaves, nMHDwaves
00086       NAMELIST /WaveData/ wavevector, amplitude, phase
00087       NAMELIST /MHDWaveData/ wavevector, amplitudes, phase
00088 
00089       OPEN(UNIT=PROBLEM_DATA_HANDLE, FILE='problem.data', STATUS="OLD")
00090       READ(PROBLEM_DATA_HANDLE,NML=ProblemData)
00091       READ(PROBLEM_DATA_HANDLE,NML=AmbientData)
00092       CALL CreateAmbient(Ambient)
00093       Ambient%density=rhoOut
00094       Ambient%pressure=pOut
00095       Ambient%B(:)=(/BxOut, ByOut, BzOut/)
00096       Ambient%velocity(:)=(/vxOut, vyOut, vzOut/)
00097 
00098       CALL CreateTotal(Total)
00099       Total%Field%Component=GASCOMP
00100       Total%Field%id=ivx
00101       Total%Field%name='Gas Px'
00102       
00103       CALL CreateTotal(Total)
00104       Total%Field%Component=PARTICLECOMP
00105       Total%Field%id=ivx
00106       Total%Field%name='Particle Px'
00107       
00108       CALL CreateTotal(Total)
00109       Total%Field%Component=BOTHCOMP
00110       Total%Field%id=ivx
00111       Total%Field%name='Combined Px'
00112 
00113 
00114       CALL CreateClump(myclump)
00115       ! Modify density or temperature based on alpha parameter
00116       IF (alpha == 0 .OR. .NOT. lSelfGravity) THEN
00117 !         myclump%density=density
00118          IF (lSelfGravity) write(*,*) 'alpha = ', 5d0/2d0*gamma*Temp/ScaleGrav/density/(4d0/3d0*pi*radius**2)
00119       ELSE
00120          IF (iEOS == EOS_ISOTHERMAL) THEN
00121             density=5d0/2d0*Iso_Speed2/ScaleGrav/alpha/(4d0/3d0*pi*radius**2)
00122             write(*,*) "adjusting clump density to", density
00123          ELSE
00124             temp=2d0/5d0*density*ScaleGrav*alpha*(4d0/3d0*pi*radius**2)/gamma
00125             write(*,*) "adjusting clump temperature to", temp
00126          END IF
00127       END IF
00128 
00129       myclump%temperature=temp
00130       myclump%density=density
00131       ! Calculate solid body rotational velocity by beta_rot
00132       myclump%omega = sqrt(4d0*pi*ScaleGrav*density*beta_rot)
00133       myclump%velocity=velocity
00134       myclump%theta=theta
00135       myclump%phi=phi
00136       myclump%B_toroidal=B_tor
00137       myclump%B_poloidal=B_pol
00138       myclump%position=xloc
00139       myclump%thickness=thickness
00140       myclump%radius=radius
00141       myclump%m2A=m2A
00142       CALL UpdateClump(myclump)
00143       
00144       IF (nwaves > 0) THEN
00145          ALLOCATE(myclump%DensityPerturbation)
00146          myclump%DensityPerturbation%type=COSINESERIES
00147          CALL InitPerturbationWaves(Myclump%DensityPerturbation, nwaves)
00148          DO i=1,nWaves
00149             READ(PROBLEM_DATA_HANDLE, NML=WaveData)
00150             CALL AddPerturbationWave(Myclump%DensityPerturbation, wavevector, phase, amplitude)
00151          END DO
00152       END IF
00153 
00154       IF (nMHDwaves > 0) THEN
00155          ALLOCATE(myclump%MagneticPerturbation(nEmf))        
00156          DO i=1,nEMF
00157             myclump%MagneticPerturbation%type=COSINESERIES
00158             CALL InitPerturbationWaves(Myclump%MagneticPerturbation(i), nMHDwaves)
00159          END DO
00160          DO i=1,nMHDWaves
00161             READ(PROBLEM_DATA_HANDLE, NML=MHDWaveData)
00162             DO j=1,nEMF
00163                CALL AddPerturbationWave(Myclump%MagneticPerturbation(j), wavevector, phase, amplitudes(j))
00164             END DO
00165          END DO
00166       END IF
00167 
00168 
00169       CLOSE(PROBLEM_DATA_HANDLE)
00170 
00171       ALLOCATE(MyWinds(6))
00172       nWinds=0
00173       DO i=1,nDim
00174          DO edge=1,2
00175             IF (Gmthbc(i,edge) == 1) THEN 
00176                nWinds=nWinds+1
00177                CALL CreateWind(MyWinds(nWinds)%p)
00178                MyWinds(nWinds)%p%dir=i
00179                MyWinds(nWinds)%p%edge=edge
00180             END IF
00181          END DO
00182       END DO
00183    END SUBROUTINE ProblemModuleInit
00184 
00187   SUBROUTINE ProblemGridInit(Info)
00188     TYPE(InfoDef) :: Info
00189   END SUBROUTINE ProblemGridInit
00190 
00193   SUBROUTINE ProblemBeforeStep(Info)
00194     TYPE(InfoDef) :: Info
00195     INTEGER :: i
00196 !    DO i=1,nWinds
00197 !       CALL BeforeStepWind(Info,Wind(i))
00198 !    END DO
00199   END SUBROUTINE ProblemBeforeStep
00200 
00203   SUBROUTINE ProblemAfterStep(Info)
00204     TYPE(InfoDef) :: Info
00205   END SUBROUTINE ProblemAfterStep
00206 
00209   SUBROUTINE ProblemSetErrFlag(Info)
00210     TYPE(InfoDef) :: Info
00211   END SUBROUTINE ProblemSetErrFlag
00212 
00213   SUBROUTINE ProblemBeforeGlobalStep(n)
00214      INTEGER :: n
00215   END SUBROUTINE ProblemBeforeGlobalStep
00216 
00217 END MODULE Problem
00218 
 All Classes Files Functions Variables