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 MolecularCloudFormation 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 DataDeclarations 00037 USE ParticleDeclarations 00038 USE ProcessingDeclarations 00039 USE CollidingFlows 00040 USE CoolingSrc 00041 USE Winds 00042 USE Ambients 00043 USE Histograms 00044 USE Fields 00045 USE Totals 00046 USE PDFs 00047 USE Projections 00048 USE Clumps 00049 USE Shapes 00050 USE Refinements 00051 IMPLICIT NONE 00052 SAVE 00053 00054 REAL(KIND=qPREC), DIMENSION(0:MaxDepth) :: cells_per_cooling_length=0 00055 REAL(KIND=qPREC), DIMENSION(0:MaxDepth) :: InterfaceWidth=0 00056 TYPE(CollidingFlowDef), POINTER :: CollidingFlow 00057 TYPE(ShapeDef), POINTER :: DerefineShape=>Null() 00058 PUBLIC ProblemModuleInit, ProblemGridInit, & 00059 ProblemBeforeStep, ProblemAfterStep, ProblemSetErrFlag, ProblemBeforeGlobalStep 00060 TYPE(CoolingDef),POINTER :: coolingobj 00061 REAL(KIND=qPREC) :: IIScaleCool, InterfaceTime, IIScaleHeat, derefine_radius=1e20 00062 INTEGER :: derefine_dist=0 00063 TYPE(AmbientDef), POINTER :: Ambient 00064 LOGICAL :: DeRefineOutSide=.false. 00065 LOGICAL :: lClumps=.false. 00066 LOGICAL :: lPlaceClumps=.true. 00067 REAL(KIND=qPREC) :: ClumpJeansFact = .5d0 !Make them 'X=.5' jeans lengths in diameter. 00068 REAL(KIND=qPREC) :: MeanDensitywClumps=3d0 00069 REAL(KIND=qPREC) :: ClumpChi=10 00070 REAL(KIND=qPREC) :: separation_param=.3d0 00071 REAL(KIND=qPREC) :: TShutOff=1d30 00072 REAL(KIND=qPREC) :: RampTime=1d0 00073 00074 CONTAINS 00075 00077 SUBROUTINE ProblemModuleInit() 00078 INTEGER :: nRegions, nWaves 00079 REAL(KIND=qPREC) :: density, temperature, smooth_distance, velocity, position(3), size_param(3), psi, theta, phi, wavevector(2), amplitude, phase, vel(3), a, alpha, dk, kmag, beta, mach, interface_dist, clumprho, clumptemp, clumpff, clumpradius, clumpnumbervolume, region(3,2), min_separation, ram_dens, ram_press, ram_temp, phi2 00080 REAL(KIND=qPREC), DIMENSION(:,:), POINTER :: positions 00081 INTEGER :: i, j, type, subsample=1, smooth_function, edge, kx, ky, interface_func 00082 LOGICAL :: lCooling 00083 TYPE(WindDef), POINTER :: Wind 00084 TYPE(HistogramDef), POINTER :: HISTOGRAM 00085 TYPE(PDFDef), POINTER :: PDF 00086 TYPE(ProjectionDef), POINTER :: Projection 00087 INTEGER :: nWinds, nbins=100, clumprefinelevel 00088 INTEGER, DIMENSION(10) :: myseed 00089 INTEGER :: kmax,nclumps,nParticleCells=0 00090 TYPE(ClumpDef), POINTER :: Clump 00091 TYPE(ShapeDef), POINTER :: LeftClumpRegion, RightClumpRegion, TotalShape 00092 LOGICAL :: lPersist=.true. 00093 REAL(KIND=qpREC) :: TotalWidth, FlowDiameter(2), ShearAngle, MaxDiameter 00094 TYPE(RefinementDef), POINTER :: Refinement 00095 INTEGER :: MustRefineDepth=MAXDEPTH 00096 INTEGER :: CanRefineDepth=MAXDEPTH 00097 REAL(KIND=qPREC) :: MustRefineWidth=0d0, CanRefineWidth=1d30 00098 NAMELIST /ProblemData/ density, velocity, mach, temperature, smooth_distance, smooth_function, subsample, lCooling, & 00099 myseed, A, alpha, kmax, beta, & 00100 interface_func, interface_dist, nbins, lClumps, ClumpJeansFact, MeanDensitywClumps, & 00101 ClumpChi, separation_param, nParticleCells,CellsPerJeansLength, clumprefinelevel, IICoolPar, TShutOff, RampTime, lPlaceClumps, & 00102 TotalWidth, FlowDiameter, ShearAngle, MustRefineWidth, MustRefineDepth, CanRefineWidth, CanRefineDepth 00103 00104 OPEN(UNIT=PROBLEM_DATA_HANDLE, FILE='problem.data', STATUS="OLD") 00105 READ(PROBLEM_DATA_HANDLE,NML=ProblemData) 00106 CLOSE(PROBLEM_DATA_HANDLE) 00107 00108 write(*,*) 'Shear angle=', ShearAngle 00109 ! Rescale various physical parameters to computational units 00110 FlowDiameter=FlowDiameter*pc/lScale 00111 density=density/nScale 00112 temperature=temperature/TempScale 00113 velocity=velocity*1e5/VelScale 00114 TotalWidth=TotalWidth*pc/lScale 00115 RampTime=RampTime*1e6*yr/TimeScale 00116 TShutOff=TShutOff*1e6*yr/TimeScale 00117 InterfaceTime=InterfaceTime*1e6*yr/TimeScale 00118 00119 IF (nParticleCells > 0) DefaultParticleRadius=nParticleCells 00120 00121 IF (lCooling) THEN 00122 IF (.NOT. lRestart) THEN 00123 CALL CreateCoolingObject(coolingobj) 00124 ELSE 00125 coolingobj => firstcoolingobj 00126 END IF 00127 coolingobj%iCooling=IICOOL 00128 coolingobj%floortemp=1d0 00129 coolingobj%mintemp=1d0 00130 END IF 00131 00132 IF (temperature == 0d0) THEN 00133 CALL InitIICool(coolingobj) 00134 temperature=GetIICoolEqTemp(density*nScale)/TempScale 00135 IF (MPI_ID == 0) write(*,*) 'Background Density = ', density*nScale, ' particles/cc' 00136 IF (MPI_ID == 0) write(*,*) 'Equilibrium temp = ', temperature*TempScale, ' K' 00137 IF (MPI_ID == 0) write(*,*) 'sound speed = ', sqrt(gamma*temperature), sqrt(gamma*temperature)*velscale/1e5, 'km/s' 00138 END IF 00139 IF (mach /= 0d0) velocity=mach*sqrt(gamma*temperature) 00140 00141 IF (MPI_ID == 0) write(*,*) 'Background Jeans Length =', JeansLength(density, temperature)*lScale/pc, ' pc' 00142 IF (MPI_ID == 0) write(*,*) 'Background free fall time =', sqrt(3d0*pi/32d0/ScaleGrav/density)*TimeScale/yr/1e6, 'myr' 00143 IF (MPI_ID == 0) write(*,*) 'flow velocity = ', velocity*velscale/1e5, 'km/s' 00144 00145 CALL CreateAmbient(Ambient) 00146 Ambient%density=density 00147 Ambient%pressure=density*temperature 00148 IF (beta /= 0d0) THEN 00149 Ambient%B=sqrt(2d0*temperature*density/beta)*(/1d0,0d0,0d0/) 00150 IF (MPI_ID == 0) write(*,'(A,3E25.15)') 'Ambient%B=',Ambient%B 00151 END IF 00152 00153 DO i=1,nDim 00154 DO edge=1,2 00155 IF (Gmthbc(i,edge) == 1) THEN 00156 CALL CreateWind(Wind) 00157 Wind%dir=i 00158 Wind%edge=edge 00159 Wind%type=OUTFLOW_ONLY 00160 Wind%density=Ambient%density 00161 Wind%temperature=Ambient%Pressure/Ambient%Density 00162 Wind%B=Ambient%B 00163 END IF 00164 END DO 00165 END DO 00166 00167 00168 00169 CALL CreateCollidingFlow(CollidingFlow) 00170 00171 MaxDiameter=maxval(FlowDiameter) 00172 CollidingFlow%SubSample = subsample 00173 CollidingFlow%density = density 00174 CollidingFlow%velocity = velocity 00175 CollidingFlow%Temperature = Temperature 00176 CollidingFlow%PersistInBoundaries = lPersist 00177 CollidingFlow%smooth_function = smooth_function 00178 CollidingFlow%smooth_distance = smooth_distance*MaxDiameter 00179 CollidingFlow%interface_func = interface_func 00180 CollidingFlow%interface_dist = interface_dist*MaxDiameter 00181 CollidingFlow%tShutOff = TShutOff 00182 CollidingFlow%RampTime = RampTime 00183 CALL AddTracer(CollidingFlow%iTracer(1),'FlowTracer1') 00184 CALL AddTracer(CollidingFlow%iTracer(2),'FlowTracer2') 00185 00186 CALL SetShapeType(CollidingFlow%Shape, ELLIPTICAL_PRISM, half*(/FlowDiameter(:),2d0*(GxBounds(1,2)-GxBounds(1,1))/)) 00187 CALL SetShapeOrientation(CollidingFlow%Shape, 0d0, Pi/2d0, 0d0) 00188 CollidingFlow%Shape%Position=half*SUM(GxBounds(:,:), 2) 00189 CALL SetShapeBounds(CollidingFlow%Shape) 00190 00191 IF (derefine_radius > 0d0) THEN 00192 CALL CreateShape(DerefineShape) 00193 CALL SetShapeType(DerefineShape, ELLIPTICAL_PRISM, (/derefine_radius*half*FlowDiameter(:), 2d0*(GxBounds(1,2)-GxBounds(1,1))/)) 00194 CALL SetShapeOrientation(DerefineShape, 0d0, Pi/2d0, 0d0) 00195 DerefineShape%position=half*SUM(GxBounds(:,:),2) 00196 CALL SetShapeBounds(DerefineShape) 00197 END IF 00198 IF (MPI_ID == 0) THEN 00199 write(*,*) 'mass flux = ', 2d0*velocity*velScale * (SUM(FlowDiameter(1:nDim-1)**2))*Pi/4d0*density*rScale*lScale**2/(mSolar/(1e6*yr)), 'm_sun/Myr' 00200 ram_press=velocity**2*TempScale*density*nScale 00201 write(*,*) 'ram pressure = ', ram_press, 'particles K/cc' 00202 ram_dens=GetIICoolEqDensity(ram_press) 00203 write(*,*) 'ram density = ', ram_dens, 'particles per cc' 00204 ram_temp=ram_press/ram_dens 00205 write(*,*) 'ram temp = ', ram_temp, 'K' 00206 write(*,*) 'ram density jeans length =', JeansLength(ram_dens/nScale, ram_temp/TempScale)*lScale/pc, ' pc' 00207 END IF 00208 ! Then set up interface 00209 CollidingFlow%InterfaceObj%Position=CollidingFlow%Shape%Position 00210 00211 IF (nDim == 2) THEN 00212 CALL SetInterfaceOrientation(CollidingFlow%InterfaceObj, Pi/2d0,ShearAngle/180d0*Pi) 00213 ELSE 00214 CALL SetInterfaceOrientation(CollidingFlow%InterfaceObj, Pi/2d0-ShearAngle/180d0*Pi,0d0) 00215 END IF 00216 CALL RANDOM_SEED(size=j) 00217 CALL RANDOM_SEED(PUT=myseed(1:j)) 00218 nWaves=0 00219 DO kx=1, kMax 00220 DO ky=1, kMax 00221 kmag=sqrt(real(kx**2+ky**2)) 00222 if (kmag < kMax) THEN 00223 nwaves=nwaves+1 00224 END if 00225 END DO 00226 END DO 00227 dk=2d0*Pi/MaxDiameter 00228 CALL InitInterfaceWaves(CollidingFlow%InterfaceObj, nWaves) 00229 DO kx=1, kMax 00230 DO ky=1, kMax 00231 kmag=sqrt(real(kx**2+ky**2)) 00232 if (kmag < kMax) THEN 00233 CALL RANDOM_NUMBER(phase) 00234 phase=phase*2d0*Pi 00235 wavevector=(/kx*dk,ky*dk/) 00236 amplitude=A*kmag**alpha*MaxDiameter 00237 CALL AddInterfaceWave(CollidingFlow%InterfaceObj, wavevector, phase, amplitude) 00238 ! write(*,*) wavevector, amplitude, phase 00239 END if 00240 END DO 00241 END DO 00242 00243 CALL ClearAllRefinements() 00244 00245 00246 !First create refinement object to refine around interface 00247 CALL CreateRefinement(Refinement) 00248 CALL CreateShape(Refinement%Shape) 00249 CALL SetShapeType(Refinement%Shape, ELLIPTICAL_PRISM, half*(/FlowDiameter(1)/cos(ShearAngle/180d0*Pi), FlowDiameter(2), MustRefineWidth/)) 00250 IF (nDim == 2) THEN 00251 CALL SetShapeOrientation(Refinement%Shape, 0d0, Pi/2d0, ShearAngle/180d0*Pi) 00252 ELSE 00253 CALL SetShapeOrientation(Refinement%Shape, 0d0, Pi/2d0-ShearAngle/180d0*Pi, 0d0) 00254 END IF 00255 Refinement%Shape%Position=CollidingFlow%Shape%Position 00256 CALL SetShapeBounds(Refinement%Shape) 00257 ! Refinement%field=Mass_Field 00258 ! Refinement%tolerance=1 00259 ! Refinement%scale=LOGSCALE 00260 Refinement%BufferCells=1 00261 Refinement%MaxLevel=MustRefineDepth 00262 00263 CALL CreateRefinement(Refinement) 00264 CALL CreateShape(Refinement%Shape) 00265 CALL SetShapeType(Refinement%Shape, ELLIPTICAL_PRISM, half*(/FlowDiameter(1)/cos(ShearAngle/180d0*Pi), FlowDiameter(2), CanRefineWidth/)) 00266 IF (nDim == 2) THEN 00267 CALL SetShapeOrientation(Refinement%Shape, 0d0, Pi/2d0, ShearAngle/180d0*Pi) 00268 ELSE 00269 CALL SetShapeOrientation(Refinement%Shape, 0d0, Pi/2d0-ShearAngle/180d0*Pi, 0d0) 00270 END IF 00271 Refinement%Shape%Position=CollidingFlow%Shape%Position 00272 CALL SetShapeBounds(Refinement%Shape) 00273 Refinement%field=Mass_Field 00274 Refinement%tolerance=1 00275 Refinement%scale=LOGSCALE 00276 Refinement%BufferCells=2 00277 Refinement%MaxLevel=CanRefineDepth 00278 00279 00280 CALL AddRefinementThreshold(JeansLength_Field, LESSTHAN, (/(CellsPerJeansLength*levels(i)%dx,i=0,MaxLevel)/)) 00281 00282 00283 ! CALL AddDiagnosticVar(ErrFlag_Field) 00284 00285 00286 ! Uncomment this to turn off processing stuff 00287 RETURN 00288 00289 CALL CreateShape(TotalShape) 00290 CALL SetShapeType(TotalShape, ELLIPTICAL_PRISM, half*(/FlowDiameter(:),TotalWidth/)) 00291 CALL SetShapeOrientation(TotalShape, 0d0, Pi/2-ShearAngle/180d0*Pi,0d0) 00292 TotalShape%position(:) = CollidingFlow%Shape%position 00293 CALL SetShapeBounds(TotalShape) 00294 00295 CALL AddAllTotals(GASCOMP, TotalShape) 00296 CALL AddAllTotals(PARTICLECOMP,TotalShape) 00297 CALL AddAllTotals(BOTHCOMP,TotalShape) 00298 00299 CALL CreatePDF(PDF) 00300 PDF%Field(1)%iD=Mass_Field 00301 PDF%Field(1)%name='density' 00302 PDF%Field(1)%component=GASCOMP 00303 PDF%Field(2)%iD=VMag_Field 00304 PDF%Field(2)%name='velocity' 00305 PDF%Field(2)%component=GASCOMP 00306 PDF%minvalue=(/.01,.001/) 00307 PDF%maxvalue=(/1e7,1e4/) 00308 PDF%nbins=(/400,400/) 00309 PDF%Scale=(/LOGSCALE,LOGSCALE/) 00310 PDF%WeightField=VOLUME 00311 PDF%Shape=>TotalShape 00312 00313 00314 CALL CreateHistogram(Histogram) 00315 Histogram%Field%iD=1 00316 Histogram%Field%name='density' 00317 Histogram%Field%component=GASCOMP 00318 Histogram%minvalue=.1d0 00319 Histogram%maxvalue=1d8 00320 Histogram%nbins=nbins 00321 Histogram%scale=LOGSCALE 00322 Histogram%shape=>TotalShape 00323 00324 00325 CALL CreateHistogram(Histogram) 00326 Histogram%Field%iD=MixingRatio12_Field 00327 Histogram%Field%name='Mixing_Ratio' 00328 Histogram%Field%component=GASCOMP 00329 Histogram%minvalue=0d0 00330 Histogram%maxvalue=1d0 00331 Histogram%nbins=nbins 00332 Histogram%scale=LINEARSCALE 00333 Histogram%WeightField=VOLUME 00334 Histogram%shape=>TotalShape 00335 00336 CALL CreatePDF(PDF) 00337 PDF%Field(:)%iD=(/Mass_Field, P_Field/) 00338 PDF%Field(1)%name='density' 00339 PDF%Field(2)%name='pressure' 00340 PDF%Field(:)%component=GASCOMP 00341 PDF%minvalue=(/.01,100.0/) 00342 PDF%maxvalue=(/1e7,1e6/) 00343 PDF%nbins=(/400,400/) 00344 PDF%Scale=(/LOGSCALE,LOGSCALE/) 00345 PDF%WeightField=MASS 00346 PDF%Shape=>TotalShape 00347 00348 00349 CALL CreateProjection(projection) 00350 Projection%Field%iD=Mass_Field 00351 Projection%Field%component=BOTHCOMP 00352 Projection%dim=1 00353 ! Projection%Shape=>TotalShape 00354 00355 CALL CreateProjection(projection) 00356 Projection%Field%iD=Mass_Field 00357 Projection%Field%component=BOTHCOMP 00358 Projection%dim=2 00359 00360 CALL CreateProjection(projection) 00361 Projection%Field%iD=Mass_Field 00362 Projection%Field%component=BOTHCOMP 00363 Projection%dim=3 00364 00365 END SUBROUTINE ProblemModuleInit 00366 00367 00370 SUBROUTINE ProblemGridInit(Info) 00371 TYPE(InfoDef) :: Info 00372 END SUBROUTINE ProblemGridInit 00373 00376 SUBROUTINE ProblemBeforeStep(Info) 00377 TYPE(InfoDef) :: Info 00378 END SUBROUTINE ProblemBeforeStep 00379 00382 SUBROUTINE ProblemAfterStep(Info) 00383 TYPE(InfoDef) :: Info 00384 00385 END SUBROUTINE ProblemAfterStep 00386 00387 00390 SUBROUTINE ProblemSetErrFlag(Info) 00391 TYPE(InfoDef) :: Info 00392 END SUBROUTINE ProblemSetErrFlag 00393 00394 00395 SUBROUTINE ProblemBeforeGlobalStep(n) 00396 INTEGER :: n 00397 END SUBROUTINE ProblemBeforeGlobalStep 00398 00399 00400 SUBROUTINE SetupTotals() 00401 00402 END SUBROUTINE SetupTotals 00403 00404 END MODULE Problem 00405