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 SlowMolecularCloudFormation 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 IMPLICIT NONE 00041 SAVE 00042 PUBLIC ProblemModuleInit, ProblemGridInit, & 00043 ProblemBeforeStep, ProblemAfterStep, ProblemSetErrFlag, ProblemBeforeGlobalStep 00044 TYPE(ClumpDef), POINTER :: myclump 00045 TYPE(WindDef), POINTER :: Wind 00046 INTEGER :: nWinds 00047 00048 CONTAINS 00049 00051 SUBROUTINE ProblemModuleInit() 00052 INTEGER :: i,edge,j 00053 REAL(KIND=qPREC) :: radius=1 !clump radius 00054 REAL(KIND=qPREC) :: thickness=.1 !thickness of clump smoothing region 00055 REAL(KIND=qPREC) :: density=10 !Clump peak density 00056 REAL(KIND=qPREC) :: temp=.1 !Clump temperature 00057 REAL(KIND=qPREC), DIMENSION(3) :: velocity= (/0,0,0/) !Clump velocity (in direction of clump axis) 00058 REAL(KIND=qPREC) :: theta=0 !Angle between X-axis and clump axis (towards y-axis) 00059 REAL(KIND=qPREC) :: phi=0 !Angle around X-axis to clump axis 00060 ! REAL(KIND=qPREC) :: mu=0 !Defines ratio of maximum magnetic pressure to ambient pressure 00061 ! REAL(KIND=qPREC) :: eta=0 !Parameter that determines ratio of maximum poloidal pressure to maximum toroidal pressure 00062 ! REAL(KIND=qPREC) :: B_theta=0 !Angle from clump axis to define clump orientation 00063 ! REAL(KIND=qPREC) :: B_phi=0 !Rotation around clump axis to define clump orientation(velocity) 00064 REAL(KIND=qPREC) :: B_tor=0 !Maximum Bfield for toroidal configuration 00065 REAL(KIND=qPREC) :: B_pol=0 !Maximum Bfield for poloidal configuration 00066 REAL(KIND=qPREC) :: Omega=0 !Solid body angular rotation 00067 REAL(KIND=qPREC) :: m2A !Azimuthal density perturbation 00068 REAL(KIND=qPREC), DIMENSION(3) :: xloc=(/0,0,0/) !Clump location 00069 INTEGER :: iTracer !Clump Tracer 00070 00071 INTEGER :: nwaves=0, nMHDwaves=0 00072 REAL(KIND=qPREC), DIMENSION(3) :: wavevector 00073 REAL(KIND=qPREC) :: phase, amplitude, amplitudes(3) 00074 00075 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$ 00076 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$ 00077 00078 TYPE(AmbientDef), POINTER :: Ambient 00079 REAL(KIND=qPREC) :: rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut 00080 NAMELIST /AmbientData/ rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut 00081 NAMELIST /ProblemData/ density,velocity, xloc, radius, thickness, temp,theta, phi, B_tor, B_pol, beta_rot, alpha, m2A, nwaves, nMHDwaves 00082 NAMELIST /WaveData/ wavevector, amplitude, phase 00083 NAMELIST /MHDWaveData/ wavevector, amplitudes, phase 00084 00085 OPEN(UNIT=PROBLEM_DATA_HANDLE, FILE='problem.data', STATUS="OLD") 00086 CALL CreateAmbient(Ambient) 00087 READ(PROBLEM_DATA_HANDLE,NML=AmbientData) 00088 Ambient%density=rhoOut 00089 Ambient%pressure=pOut 00090 Ambient%B(:)=(/BxOut, ByOut, BzOut/) 00091 Ambient%velocity(:)=(/vxOut, vyOut, vzOut/) 00092 00093 READ(PROBLEM_DATA_HANDLE,NML=ProblemData) 00094 00095 00096 CALL CreateClump(myclump) 00097 ! Modify density or temperature based on alpha parameter 00098 IF (alpha == 0 .OR. .NOT. lSelfGravity) THEN 00099 ! myclump%density=density 00100 IF (lSelfGravity) write(*,*) 'alpha = ', 5d0/2d0*gamma*Temp/ScaleGrav/density/(4d0/3d0*pi*radius**2) 00101 ELSE 00102 IF (iEOS == EOS_ISOTHERMAL) THEN 00103 density=5d0/2d0*Iso_Speed2/ScaleGrav/alpha/(4d0/3d0*pi*radius**2) 00104 write(*,*) "adjusting clump density to", density 00105 ELSE 00106 temp=2d0/5d0*density*ScaleGrav*alpha*(4d0/3d0*pi*radius**2)/gamma 00107 write(*,*) "adjusting clump temperature to", temp 00108 END IF 00109 END IF 00110 00111 myclump%temperature=temp 00112 myclump%density=density 00113 ! Calculate solid body rotational velocity by beta_rot 00114 myclump%omega = sqrt(4d0*pi*ScaleGrav*density*beta_rot) 00115 myclump%velocity=velocity 00116 myclump%theta=theta 00117 myclump%phi=phi 00118 myclump%B_toroidal=B_tor 00119 myclump%B_poloidal=B_pol 00120 myclump%position=xloc 00121 myclump%thickness=thickness 00122 myclump%radius=radius 00123 myclump%m2A=m2A 00124 CALL UpdateClump(myclump) 00125 00126 IF (nwaves > 0) THEN 00127 ALLOCATE(myclump%DensityPerturbation) 00128 myclump%DensityPerturbation%type=COSINESERIES 00129 CALL InitPerturbationWaves(Myclump%DensityPerturbation, nwaves) 00130 DO i=1,nWaves 00131 READ(PROBLEM_DATA_HANDLE, NML=WaveData) 00132 CALL AddPerturbationWave(Myclump%DensityPerturbation, wavevector, phase, amplitude) 00133 END DO 00134 END IF 00135 00136 IF (nMHDwaves > 0) THEN 00137 ALLOCATE(myclump%MagneticPerturbation(nEmf)) 00138 DO i=1,nEMF 00139 myclump%MagneticPerturbation%type=COSINESERIES 00140 CALL InitPerturbationWaves(Myclump%MagneticPerturbation(i), nMHDwaves) 00141 END DO 00142 DO i=1,nMHDWaves 00143 READ(PROBLEM_DATA_HANDLE, NML=MHDWaveData) 00144 DO j=1,nEMF 00145 CALL AddPerturbationWave(Myclump%MagneticPerturbation(j), wavevector, phase, amplitudes(j)) 00146 END DO 00147 END DO 00148 END IF 00149 00150 00151 CLOSE(PROBLEM_DATA_HANDLE) 00152 00153 nWinds=0 00154 DO i=1,nDim 00155 DO edge=1,2 00156 IF (Gmthbc(i,edge) == 1) THEN 00157 nWinds=nWinds+1 00158 CALL CreateWind(Wind) 00159 Wind%dir=i 00160 Wind%edge=edge 00161 END IF 00162 END DO 00163 END DO 00164 END SUBROUTINE ProblemModuleInit 00165 00168 SUBROUTINE ProblemGridInit(Info) 00169 TYPE(InfoDef) :: Info 00170 END SUBROUTINE ProblemGridInit 00171 00174 SUBROUTINE ProblemBeforeStep(Info) 00175 TYPE(InfoDef) :: Info 00176 INTEGER :: i 00177 ! DO i=1,nWinds 00178 ! CALL BeforeStepWind(Info,Wind(i)) 00179 ! END DO 00180 END SUBROUTINE ProblemBeforeStep 00181 00184 SUBROUTINE ProblemAfterStep(Info) 00185 TYPE(InfoDef) :: Info 00186 END SUBROUTINE ProblemAfterStep 00187 00190 SUBROUTINE ProblemSetErrFlag(Info) 00191 TYPE(InfoDef) :: Info 00192 END SUBROUTINE ProblemSetErrFlag 00193 00194 SUBROUTINE ProblemBeforeGlobalStep(n) 00195 INTEGER :: n 00196 END SUBROUTINE ProblemBeforeGlobalStep 00197 00198 END MODULE Problem 00199