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 RTInstability 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 00037 ! In general, DataDeclarations is always used since it defines the InfoDef type 00038 ! PhysicsDeclarations and GlobalDeclarations are almost always used 00039 ! To see exactly what these "sub-modules" define, look at their .f90 files in the astrobear directory 00040 USE DataDeclarations 00041 USE PhysicsDeclarations 00042 USE GlobalDeclarations 00043 USE SourceDeclarations 00044 IMPLICIT NONE 00045 SAVE 00046 00047 ! This PUBLIC statement must be present 00048 PUBLIC ProblemModuleInit, ProblemGridInit, & 00049 ProblemBeforeStep, ProblemAfterStep, ProblemSetErrFlag, ProblemBeforeGlobalStep 00050 00051 ! Some variables are used in more than one SUBROUTINE so they are defined here 00052 ! qPREC is a type of precision defined in GlobalDeclarations 00053 REAL(KIND=qPREC), PUBLIC :: DensityAbove, DensityBelow, Amplitude, atwood_number, wave_number, lambda_analytic 00054 00055 CONTAINS 00056 00057 ! Initialize module variables 00058 SUBROUTINE ProblemModuleInit() 00059 00060 ! Define variables and namelists 00061 INTEGER :: OpenStatus 00062 NAMELIST /ProblemData/ DensityAbove, DensityBelow, Amplitude 00063 00064 ! Open problem.data and read in data 00065 ! Problem_Data_Handle is just an integer defined in GlobalDeclarations 00066 ! OpenStatus variable could be used to check if file is opening correctly 00067 OPEN(UNIT=Problem_Data_Handle, FILE='problem.data', STATUS="OLD",IOSTAT=OpenStatus) 00068 READ(Problem_Data_Handle, NML=ProblemData) 00069 CLOSE(Problem_Data_Handle) 00070 END SUBROUTINE ProblemModuleInit 00071 00072 ! Initialize data arrays 00073 SUBROUTINE ProblemGridInit(Info) 00074 00075 ! User defined variables, note which ones must be REAL and which are INTEGER 00076 TYPE(InfoDef) :: Info 00077 INTEGER :: rmbc, zrmbc, mx, my, mz, i, j, k 00078 REAL(KIND=qPREC) :: x, y, z, rho, P, Lx, Ly, Lz, vy 00079 REAL(KIND=qPREC) :: dx, dz, xlower, ylower, zlower 00080 00081 ! Initializes the q-array 00082 Info%q=0 00083 00084 ! levels is defined in GlobalDeclarations 00085 rmbc=levels(Info%level)%gmbc(levels(Info%level)%step) 00086 00087 ! Assign some useful values with convenient names for ease of use and readability 00088 ! Gxbounds is defined in GlobalDeclarations 00089 mx=Info%mX(1); dx=levels(Info%level)%dX; xlower=Info%xbounds(1,1); Lx=Gxbounds(1,2)-Gxbounds(1,1) 00090 my=Info%mX(2); dz=levels(Info%level)%dX; ylower=Info%xbounds(2,1); Ly=Gxbounds(2,2)-Gxbounds(2,1) 00091 mz=Info%mX(3); zlower=Info%xbounds(3,1); Lz=Gxbounds(3,2)-Gxbounds(3,1) 00092 00093 ! Allows for 2D or 3D simulations 00094 ! Note that in 2D, Lz is explicitly set to 1 so there is no divide by zero in the perturbation 00095 SELECT CASE(nDim) 00096 CASE(2) 00097 zrmbc=0;mz=1;zlower=0;dz=0;Lz=1 00098 CASE(3) 00099 zrmbc=rmbc 00100 END SELECT 00101 00102 00103 00104 ! Initialize the grid 00105 DO k=1-zrmbc, mz+zrmbc 00106 DO j=1-rmbc, my+rmbc 00107 DO i=1-rmbc, mx+rmbc 00108 00109 ! Cell-to-space conversion (half is defined in GlobalDeclarations) 00110 x=(xlower + (REAL(i) - half) * dx) 00111 y=(ylower + (REAL(j) - half) * dx) 00112 z=(zlower + (REAL(k) - half) * dz) 00113 00114 ! Define density profile 00115 IF (y < 0) THEN 00116 rho = DensityBelow 00117 ELSE 00118 rho = DensityAbove 00119 END IF 00120 00121 ! Define pressure gradient 00122 P = 2.5 - rho * UniformGravity * y 00123 00124 ! Define perturbation (Pi is defined in PhysicsDeclarations) 00125 vy = Amplitude * (1+COS(2*Pi*x/Lx)) * (1+COS(2*Pi*y/Ly)) * (1+COS(2*Pi*z/Lz)) / 8 00126 00127 ! Put information into q-array (gamma, ivy, iE are defined in PhysicsDeclarations) 00128 Info%q(i, j, k, 1) = rho 00129 Info%q(i, j, k, ivy) = rho * vy 00130 Info%q(i, j, k, iE) = P / (gamma - 1.0) + half * rho * vy**2 00131 END DO 00132 END DO 00133 END DO 00134 00135 ! For analysis...calculates the analytic growth rate and saves it in a file 00136 atwood_number = (DensityAbove - DensityBelow) / (DensityAbove + DensityBelow) 00137 wave_number = 2*Pi/Lx 00138 lambda_analytic = SQRT(atwood_number * wave_number * UniformGravity) 00139 OPEN(UNIT=82,FILE='GrowthRate.data',STATUS='unknown') 00140 WRITE(82,*) lambda_analytic 00141 CLOSE(82) 00142 00143 END SUBROUTINE ProblemGridInit 00144 00145 ! Place any pre-processing operations here (This is what is meant by leaving a SUBROUTINE as a stub) 00146 SUBROUTINE ProblemBeforeStep(Info) 00147 TYPE(InfoDef) :: Info 00148 END SUBROUTINE ProblemBeforeStep 00149 00150 ! Place any post-processing operations here 00151 SUBROUTINE ProblemAfterStep(Info) 00152 TYPE(InfoDef) :: Info 00153 END SUBROUTINE ProblemAfterStep 00154 00155 ! Can be used to set additional refinement 00156 SUBROUTINE ProblemSetErrFlag(Info) 00157 TYPE(InfoDef) :: Info 00158 REAL(KIND=qPREC) :: pos 00159 REAL(KIND=qPREC), PARAMETER :: lambda = 0.6472 00160 REAL(KIND=qPREC), DIMENSION(0:MaxLevel) :: mybuffer 00161 REAL(KIND=qPREC), DIMENSION(:,:), POINTER :: offsets 00162 REAL(KIND=qPREC), DIMENSION(3,2) :: xBounds 00163 INTEGER, DIMENSION(3,2) :: mS 00164 INTEGER, DIMENSION(:,:,:), POINTER :: mSs 00165 INTEGER :: i, nOverlaps 00166 mybuffer(0:MaxLevel)=4d0*levels(0:MaxLevel)%dx 00167 xBounds=GxBounds 00168 pos=0.003d0*EXP(lambda*levels(Info%level)%tnow) + mybuffer(Info%level) 00169 xBounds(2,:)=(/-pos,+pos/) 00170 CALL CalcPhysicalOverlaps(Info, xBounds, mSs, nOverlaps, offsets, IEVERYWHERE, lHydroPeriodic,0) 00171 IF (nOverlaps > 0) THEN 00172 DO i=1,nOverlaps 00173 mS=mSs(i,:,:) 00174 Info%ErrFlag(mS(1,1):mS(1,2), mS(2,1):mS(2,2), mS(3,1):mS(3,2)) = 1 00175 END DO 00176 DEALLOCATE(mSs, offsets) 00177 NULLIFY(mSs, offsets) 00178 END IF 00179 END SUBROUTINE ProblemSetErrFlag 00180 00181 SUBROUTINE ProblemBeforeGlobalStep(n) 00182 INTEGER :: n 00183 END SUBROUTINE ProblemBeforeGlobalStep 00184 00185 END MODULE Problem