Scrambler  1
MultiClumps/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 MultiClumps 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 Clumps
00039   USE CoolingSrc
00040   USE Winds  
00041   USE Ambients
00042   IMPLICIT NONE
00043   SAVE
00044 
00045   PUBLIC ProblemModuleInit, ProblemGridInit, &
00046        ProblemBeforeStep, ProblemAfterStep, ProblemSetErrFlag, ProblemBeforeGlobalStep
00047   TYPE(CoolingDef),POINTER :: coolingobj
00048   REAL(KIND=qPREC) :: wind_thickness, wind_vel, wind_refinement_time
00049   TYPE(WindDef), POINTER :: Wind
00050 CONTAINS
00051 
00053    SUBROUTINE ProblemModuleInit()      
00054       INTEGER :: nClumps, ClumpTracer, AltClumpTracer,i, dir, edge, ClumpToTrace
00055       TYPE(ClumpDef), POINTER :: Clump
00056       LOGICAL :: lCooling
00057       REAL(KIND=qPREC) :: density, temperature, velocity, smooth_distance, position(3), radius, B(3)
00058       TYPE(AmbientDef), POINTER :: Ambient
00059       REAL(KIND=qPREC) :: rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut
00060       NAMELIST /AmbientData/ rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut
00061       NAMELIST /ProblemData/ nClumps, lCooling, ClumpToTrace
00062       NAMELIST /WindData/ density, temperature, velocity, B,  wind_thickness, wind_refinement_time, dir, edge
00063       NAMELIST /ClumpData/ density, temperature, radius, smooth_distance, position
00064       OPEN(UNIT=PROBLEM_DATA_HANDLE, FILE='problem.data', STATUS="OLD")
00065       READ(PROBLEM_DATA_HANDLE,NML=ProblemData)
00066       dir=1
00067       edge=1
00068       CALL AddTracer(ClumpTracer, 'ClumpTracer')
00069       CALL AddTracer(AltClumpTracer, 'AltClumpTracer')
00070       CALL CreateAmbient(Ambient)
00071       READ(PROBLEM_DATA_HANDLE,NML=AmbientData)
00072       Ambient%density=rhoOut
00073       Ambient%pressure=pOut
00074       Ambient%B(:)=(/BxOut, ByOut, BzOut/)
00075       Ambient%velocity(:)=(/vxOut, vyOut, vzOut/)
00076 
00077       READ(PROBLEM_DATA_HANDLE,NML=WindData)
00078       CALL CreateWind(Wind)
00079       Wind%density=density
00080       Wind%temperature=temperature
00081       Wind%velocity=velocity
00082       Wind%B=B
00083       wind_vel=velocity
00084       CALL AddTracer(Wind%iTracer, 'Wind_Tracer')
00085       Wind%dir=dir
00086       Wind%edge=edge
00087       DO i=1, nClumps
00088          READ(PROBLEM_DATA_HANDLE,NML=ClumpData)
00089          CALL CreateClump(Clump)
00090          Clump%density=density
00091          Clump%temperature=temperature
00092          Clump%position=position
00093          IF (i == ClumpToTrace) THEN
00094             Clump%iTracer=AltClumpTracer
00095          ELSE
00096             Clump%iTracer=ClumpTracer
00097          END IF
00098          Clump%thickness=smooth_distance
00099          Clump%radius=radius
00100          CALL UpdateClump(Clump)
00101       END DO
00102 
00103       IF (lCooling) THEN
00104          IF (.NOT. lRestart) THEN
00105             ! see sources/cooling.f90::CreateCoolingObject for
00106             ! default values of a cooling source term
00107             CALL CreateCoolingObject(coolingobj)
00108          ELSE
00109             coolingobj => firstcoolingobj
00110          END IF
00111          coolingobj%iCooling=DMCOOL
00112          coolingobj%floortemp=100d0
00113          coolingobj%mintemp=1
00114       END IF
00115    END SUBROUTINE ProblemModuleInit
00116 
00119    SUBROUTINE ProblemGridInit(Info)
00120       TYPE(InfoDef) :: Info
00121 
00122    END SUBROUTINE ProblemGridInit
00123 
00126    SUBROUTINE ProblemBeforeStep(Info)
00127       TYPE(InfoDef) :: Info
00128    END SUBROUTINE ProblemBeforeStep
00129 
00132    SUBROUTINE ProblemAfterStep(Info)
00133       TYPE(InfoDef) :: Info
00134    END SUBROUTINE ProblemAfterStep
00135 
00138    SUBROUTINE ProblemSetErrFlag(Info)
00139       TYPE(InfoDef) :: Info
00140       INTEGER :: ip(3,2)
00141       REAL(KIND=qPREC) :: wind_pos, dx
00142       
00143       IF (levels(Info%level)%tnow <= wind_refinement_time) THEN
00144          dx=levels(Info%level)%dx
00145          wind_pos=wind_vel/2d0*levels(Info%level)%tnow
00146          ip(:,1)=1
00147          ip(:,2)=Info%mX
00148          ip(wind%dir,1)=ceiling((wind_pos-wind_thickness-Info%xBounds(wind%dir,1))/dx)
00149          ip(wind%dir,2)=ceiling((wind_pos+wind_thickness-Info%xBounds(wind%dir,1))/dx)
00150          ip(wind%dir,1)=max(ip(wind%dir,1), 1)
00151          ip(wind%dir,2)=min(ip(wind%dir,2),Info%mX(wind%dir))
00152          IF (ip(wind%dir,2) >= ip(wind%dir,1)) Info%ErrFlag(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2))=1
00153       END IF
00154    END SUBROUTINE ProblemSetErrFlag
00155 
00156    SUBROUTINE ProblemBeforeGlobalStep(n)
00157       INTEGER :: n
00158    END SUBROUTINE ProblemBeforeGlobalStep
00159 
00160 END MODULE Problem
00161 
 All Classes Files Functions Variables