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