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 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