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 MomentumConservation 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 USE ProcessingDeclarations 00043 IMPLICIT NONE 00044 SAVE 00045 00046 PUBLIC ProblemModuleInit, ProblemGridInit, & 00047 ProblemBeforeStep, ProblemAfterStep, ProblemSetErrFlag, ProblemBeforeGlobalStep 00048 TYPE(ClumpDef), POINTER :: myclump 00049 TYPE(WindDef), POINTER :: wind 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 !CALL AddAllTotals(GASCOMP) 00098 ! CALL AddAllTotals(BOTHCOMP) 00099 !CALL AddAllTotals(PARTICLECOMP) 00100 CALL CreateTotal(Total) 00101 Total%Field%Component=GASCOMP 00102 Total%Field%id=ivx 00103 Total%Field%name='Gas Px' 00104 00105 CALL CreateTotal(Total) 00106 Total%Field%Component=PARTICLECOMP 00107 Total%Field%id=ivx 00108 Total%Field%name='Particle Px' 00109 00110 CALL CreateTotal(Total) 00111 Total%Field%Component=BOTHCOMP 00112 Total%Field%id=ivx 00113 Total%Field%name='Combined Px' 00114 00115 CALL CreateTotal(Total) 00116 Total%Field%Component=GASCOMP 00117 Total%Field%id=1 00118 Total%Field%name='Gas rho' 00119 00120 CALL CreateTotal(Total) 00121 Total%Field%Component=PARTICLECOMP 00122 Total%Field%id=1 00123 Total%Field%name='Particle mass' 00124 00125 CALL CreateTotal(Total) 00126 Total%Field%Component=BOTHCOMP 00127 Total%Field%id=1 00128 Total%Field%name='Combined mass' 00129 00130 CALL AddDiagnosticVar(ChildMask_Field) 00131 CALL CreateClump(myclump) 00132 ! Modify density or temperature based on alpha parameter 00133 IF (alpha == 0 .OR. .NOT. lSelfGravity) THEN 00134 ! myclump%density=density 00135 IF (lSelfGravity) write(*,*) 'alpha = ', 5d0/2d0*gamma*Temp/ScaleGrav/density/(4d0/3d0*pi*radius**2) 00136 ELSE 00137 IF (iEOS == EOS_ISOTHERMAL) THEN 00138 density=5d0/2d0*Iso_Speed2/ScaleGrav/alpha/(4d0/3d0*pi*radius**2) 00139 write(*,*) "adjusting clump density to", density 00140 ELSE 00141 temp=2d0/5d0*density*ScaleGrav*alpha*(4d0/3d0*pi*radius**2)/gamma 00142 write(*,*) "adjusting clump temperature to", temp 00143 END IF 00144 END IF 00145 00146 myclump%temperature=temp 00147 myclump%density=density 00148 ! Calculate solid body rotational velocity by beta_rot 00149 myclump%omega = sqrt(4d0*pi*ScaleGrav*density*beta_rot) 00150 myclump%velocity=velocity 00151 myclump%theta=theta 00152 myclump%phi=phi 00153 myclump%B_toroidal=B_tor 00154 myclump%B_poloidal=B_pol 00155 myclump%position=xloc 00156 myclump%thickness=thickness 00157 myclump%radius=radius 00158 myclump%m2A=m2A 00159 CALL UpdateClump(myclump) 00160 00161 IF (nwaves > 0) THEN 00162 ALLOCATE(myclump%DensityPerturbation) 00163 myclump%DensityPerturbation%type=COSINESERIES 00164 CALL InitPerturbationWaves(Myclump%DensityPerturbation, nwaves) 00165 DO i=1,nWaves 00166 READ(PROBLEM_DATA_HANDLE, NML=WaveData) 00167 CALL AddPerturbationWave(Myclump%DensityPerturbation, wavevector, phase, amplitude) 00168 END DO 00169 END IF 00170 00171 IF (nMHDwaves > 0) THEN 00172 ALLOCATE(myclump%MagneticPerturbation(nEmf)) 00173 DO i=1,nEMF 00174 myclump%MagneticPerturbation%type=COSINESERIES 00175 CALL InitPerturbationWaves(Myclump%MagneticPerturbation(i), nMHDwaves) 00176 END DO 00177 DO i=1,nMHDWaves 00178 READ(PROBLEM_DATA_HANDLE, NML=MHDWaveData) 00179 DO j=1,nEMF 00180 CALL AddPerturbationWave(Myclump%MagneticPerturbation(j), wavevector, phase, amplitudes(j)) 00181 END DO 00182 END DO 00183 END IF 00184 00185 00186 CLOSE(PROBLEM_DATA_HANDLE) 00187 00188 nWinds=0 00189 DO i=1,nDim 00190 DO edge=1,2 00191 IF (Gmthbc(i,edge) == 1) THEN 00192 nWinds=nWinds+1 00193 CALL CreateWind(wind) 00194 wind%dir=i 00195 wind%edge=edge 00196 wind%density=ambient%density 00197 wind%temperature=ambient%pressure/ambient%density 00198 END IF 00199 END DO 00200 END DO 00201 END SUBROUTINE ProblemModuleInit 00202 00205 SUBROUTINE ProblemGridInit(Info) 00206 TYPE(InfoDef) :: Info 00207 END SUBROUTINE ProblemGridInit 00208 00211 SUBROUTINE ProblemBeforeStep(Info) 00212 TYPE(InfoDef) :: Info 00213 INTEGER :: i 00214 ! DO i=1,nWinds 00215 ! CALL BeforeStepWind(Info,Wind(i)) 00216 ! END DO 00217 END SUBROUTINE ProblemBeforeStep 00218 00221 SUBROUTINE ProblemAfterStep(Info) 00222 TYPE(InfoDef) :: Info 00223 END SUBROUTINE ProblemAfterStep 00224 00227 SUBROUTINE ProblemSetErrFlag(Info) 00228 TYPE(InfoDef) :: Info 00229 END SUBROUTINE ProblemSetErrFlag 00230 00231 SUBROUTINE ProblemBeforeGlobalStep(n) 00232 INTEGER :: n 00233 END SUBROUTINE ProblemBeforeGlobalStep 00234 00235 END MODULE Problem 00236