Scrambler  1
SlowMolecularCloudFormation/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 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 
 All Classes Files Functions Variables