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 UniformCollapse 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 TYPE(AmbientDef), POINTER :: Ambient 00048 CONTAINS 00049 00051 SUBROUTINE ProblemModuleInit() 00052 INTEGER :: i,edge 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 00072 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$ 00073 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$ 00074 REAL(KIND=qPREC) :: rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut 00075 NAMELIST /AmbientData/ rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut 00076 00077 NAMELIST /ProblemData/ density,velocity, xloc, radius, thickness, temp,theta, phi, B_tor, B_pol, beta_rot, alpha, m2A 00078 OPEN(UNIT=PROBLEM_DATA_HANDLE, FILE='problem.data', STATUS="OLD") 00079 READ(PROBLEM_DATA_HANDLE,NML=ProblemData) 00080 READ(PROBLEM_DATA_HANDLE,NML=AmbientData) 00081 CALL CreateAmbient(Ambient) 00082 Ambient%density=rhoOut 00083 Ambient%pressure=pOut 00084 Ambient%B(:)=(/BxOut, ByOut, BzOut/) 00085 Ambient%velocity(:)=(/vxOut, vyOut, vzOut/) 00086 CLOSE(PROBLEM_DATA_HANDLE) 00087 CALL CreateClump(myclump) 00088 ! Modify density or temperature based on alpha parameter 00089 IF (alpha == 0 .OR. .NOT. lSelfGravity) THEN 00090 ! myclump%density=density 00091 IF (MPI_ID == 0 .AND. lSelfGravity) write(*,*) 'alpha = ', 5d0/2d0*gamma*Temp/ScaleGrav/density/(4d0/3d0*pi*radius**2) 00092 ELSE 00093 IF (iEOS == EOS_ISOTHERMAL) THEN 00094 density=5d0/2d0*Iso_Speed2/ScaleGrav/alpha/(4d0/3d0*pi*radius**2) 00095 IF (MPI_ID == 0) write(*,*) "adjusting clump density to", density 00096 ELSE 00097 temp=2d0/5d0*density*ScaleGrav*alpha*(4d0/3d0*pi*radius**2)/gamma 00098 IF (MPI_ID == 0) write(*,*) "adjusting clump temperature to", temp 00099 END IF 00100 END IF 00101 00102 myclump%temperature=temp 00103 myclump%density=density 00104 ! Calculate solid body rotational velocity by beta_rot 00105 myclump%omega = sqrt(4d0*pi*ScaleGrav*density*beta_rot) 00106 myclump%velocity=velocity 00107 myclump%theta=theta 00108 myclump%phi=phi 00109 myclump%B_toroidal=B_tor 00110 myclump%B_poloidal=B_pol 00111 myclump%position=xloc 00112 myclump%thickness=thickness 00113 myclump%radius=radius 00114 myclump%m2A=m2A 00115 CALL UpdateClump(myclump) 00116 00117 nWinds=0 00118 DO i=1,nDim 00119 DO edge=1,2 00120 IF (Gmthbc(i,edge) == 1) THEN 00121 nWinds=nWinds+1 00122 CALL CreateWind(Wind) 00123 Wind%dir=i 00124 Wind%edge=edge 00125 END IF 00126 END DO 00127 END DO 00128 END SUBROUTINE ProblemModuleInit 00129 00132 SUBROUTINE ProblemGridInit(Info) 00133 TYPE(InfoDef) :: Info 00134 END SUBROUTINE ProblemGridInit 00135 00138 SUBROUTINE ProblemBeforeStep(Info) 00139 TYPE(InfoDef) :: Info 00140 INTEGER :: i 00141 INTEGER, DIMENSION(0:2) :: Steps = (/1,4,11/) 00142 LOGICAL, DIMENSION(0:2) :: RestartTriggered=(/.false.,.false.,.false./) 00143 IF (Info%level > 2) RETURN 00144 i = levels(Info%level)%CurrentLevelStep 00145 IF (steps(Info%level) == i .AND. MPI_ID == 0 .AND. .NOT. RestartTriggered(Info%level)) THEN 00146 write(*,*) 'Processor ', MPI_ID, ' purposely requesting restart on level ', Info%level, 'step ', i, 'to test code' 00147 lRequestRestart=.true. 00148 RestartTriggered(Info%level)=.true. 00149 END IF 00150 00151 ! DO i=1,nWinds 00152 ! CALL BeforeStepWind(Info,Wind(i)) 00153 ! END DO 00154 END SUBROUTINE ProblemBeforeStep 00155 00158 SUBROUTINE ProblemAfterStep(Info) 00159 TYPE(InfoDef) :: Info 00160 END SUBROUTINE ProblemAfterStep 00161 00164 SUBROUTINE ProblemSetErrFlag(Info) 00165 TYPE(InfoDef) :: Info 00166 END SUBROUTINE ProblemSetErrFlag 00167 00168 SUBROUTINE ProblemBeforeGlobalStep(n) 00169 INTEGER :: n 00170 END SUBROUTINE ProblemBeforeGlobalStep 00171 00172 END MODULE Problem 00173