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