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 SingleClump 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 ! USE VectorPerturbation 00043 ! USE Histograms 00044 ! USE Totals 00045 ! USE Fields 00046 IMPLICIT NONE 00047 SAVE 00048 00049 PUBLIC ProblemModuleInit, ProblemGridInit, & 00050 ProblemBeforeStep, ProblemAfterStep, ProblemSetErrFlag, ProblemBeforeGlobalStep 00051 TYPE(CoolingDef),POINTER :: coolingobj 00052 REAL(KIND=qPREC) :: wind_thickness, wind_vel, wind_refinement_time 00053 TYPE(WindDef), POINTER :: Wind 00054 CONTAINS 00055 00057 SUBROUTINE ProblemModuleInit() 00058 INTEGER :: ClumpTracer, AltClumpTracer,i,j,dir,edge 00059 Logical :: ClumpToTrace 00060 TYPE(ClumpDef), POINTER :: Clump 00061 !TYPE(HistogramDef), POINTER :: Histogram 00062 !TYPE(TotalDef), POINTER :: KE,TE,BE,ENSTROPHY 00063 !LOGICAL :: lCooling!, lMagClump, lMHDPerturbation 00064 LOGICAL :: lCooling 00065 REAL(KIND=qPREC) :: density, temperature, velocity, smooth_distance, position(3), radius, B(3) 00066 REAL(KIND=qPREC) :: realden, realradius, realbeta, realtemp, realspeed, realcs, realpressure 00067 REAL(KIND=qPREC) :: theta=0 00068 REAL(KIND=qPREC) :: phi=0 00069 REAL(KIND=qPREC) :: B_tor=0 00070 REAL(KIND=qPREC) :: B_pol=0 00071 REAL(KIND=qPREC) :: B_phi=0 00072 REAL(KIND=qPREC) :: B_theta=0 00073 TYPE(AmbientDef), POINTER :: Ambient 00074 REAL(KIND=qPREC) :: rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut 00075 !INTEGER :: kmin, kmax 00076 !REAL(KIND=qPREC) :: beta, field_amp, kscale 00077 !INTEGER :: nwaves=0, nMHDwaves=0 00078 NAMELIST /AmbientData/ rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut 00079 NAMELIST /ProblemData/ lCooling, ClumpToTrace!, lMagClump, lMHDPerturbation 00080 NAMELIST /WindData/ density, temperature, velocity, B, wind_thickness, wind_refinement_time, dir, edge 00081 NAMELIST /ClumpData/ density, temperature, radius, smooth_distance, theta, phi, B_tor, B_pol, B_theta, B_phi, position 00082 !NAMELIST /PerturbData/ nwaves, nMHDwaves 00083 !NAMELIST /MHDPerturbationData/ kmin, kmax, beta, field_amp, kscale 00084 00085 OPEN(UNIT=PROBLEM_DATA_HANDLE, FILE='problem.data', STATUS="OLD") 00086 READ(PROBLEM_DATA_HANDLE,NML=ProblemData) 00087 dir=1 00088 edge=1 00089 CALL AddTracer(ClumpTracer, 'ClumpTracer') 00090 CALL AddTracer(AltClumpTracer, 'AltClumpTracer') 00091 CALL CreateAmbient(Ambient) 00092 READ(PROBLEM_DATA_HANDLE,NML=AmbientData) 00093 Ambient%density=rhoOut 00094 Ambient%pressure=pOut 00095 Ambient%B(:)=(/BxOut, ByOut, BzOut/) 00096 !Ambient%v(:)=(/vxOut, vyOut, vzOut/) 00097 Ambient%velocity(:)=(/vxOut, vyOut, vzOut/) 00098 00099 00100 READ(PROBLEM_DATA_HANDLE,NML=ClumpData) 00101 CALL CreateClump(Clump) 00102 Clump%density=density 00103 Clump%temperature=temperature 00104 Clump%position=position 00105 IF (ClumpToTrace) THEN 00106 Clump%iTracer=AltClumpTracer 00107 ELSE 00108 Clump%iTracer=ClumpTracer 00109 END IF 00110 Clump%thickness=smooth_distance 00111 Clump%radius=radius 00112 !Clump%Magnetized=lMagClump 00113 Clump%B_toroidal=B_tor 00114 Clump%B_poloidal=B_pol 00115 Clump%theta=theta*pi/180d0 00116 Clump%phi=phi*pi/180d0 00117 Clump%B_theta=B_theta*pi/180d0 00118 Clump%B_phi=B_phi*pi/180d0 00119 CALL UpdateClump(Clump) 00120 00121 !IF (lMHDPerturbation) THEN 00122 ! READ(PROBLEM_DATA_HANDLE, NML=MHDPerturbationData) 00123 ! CALL CreateVectorPerturbationObj(Clump%MagneticPerturbation) 00124 ! CALL CreateSolenoidalSpectra(Clump%MagneticPerturbation, kmin, kmax, beta, field_amp, kscale) 00125 !END IF 00126 00127 IF (lCooling) THEN 00128 IF (.NOT. lRestart) THEN 00129 ! see sources/cooling.f90::CreateCoolingObject for 00130 ! default values of a cooling source term 00131 CALL CreateCoolingObject(coolingobj) 00132 ELSE 00133 coolingobj => firstcoolingobj 00134 END IF 00135 coolingobj%iCooling=DMCOOL 00136 coolingobj%floortemp=100d0 00137 coolingobj%mintemp=1 00138 END IF 00139 00140 realtemp=(TempScale*ambient%pressure/ambient%density) 00141 realpressure=pScale*ambient%pressure 00142 realbeta=2.0*ambient%pressure/SUM((ambient%B(:))**2) 00143 realden=(rScale*ambient%density) 00144 realradius=(lScale)*10.0 00145 realcs=sqrt(gamma*realpressure/realden) 00146 00147 READ(PROBLEM_DATA_HANDLE,NML=WindData) 00148 CALL CreateWind(Wind) 00149 Wind%density=density 00150 Wind%temperature=temperature 00151 Wind%velocity=realcs*velocity/VelScale 00152 Wind%B=B 00153 wind_vel=realcs*velocity/VelScale 00154 CALL AddTracer(Wind%iTracer, 'Wind_Tracer') 00155 Wind%dir=dir 00156 Wind%edge=edge 00157 00158 realspeed=(wind%velocity*VelScale) 00159 IF(mpi_id==0)THEN 00160 PRINT*, "realdensity = ", realden*1d3, "mg/cc" 00161 PRINT*, "realtemp = ", Boltzmann*realtemp/1.602d-12, "ev" 00162 PRINT*, "realradius = ", realradius, "mm" 00163 PRINT*, "realbeta = ", realbeta 00164 PRINT*, "realspeed = ", realspeed/1d5, "km/s" 00165 PRINT*, "timescale = ", timescale 00166 !PRINT*, "Reynolds# = ", wind%velocity*clump%radius/resistivity 00167 END IF 00168 !STOP 00169 00170 !CALL CreateTotal(KE) 00171 !KE%Field%id=PKE_Field 00172 !KE%Field%component=GASCOMP 00173 !KE%Field%name='PKE' 00174 00175 !CALL CreateTotal(TE) 00176 !TE%Field%id=PiE_Field 00177 !TE%Field%component=GASCOMP 00178 !TE%Field%name='PTE' 00179 00180 !CALL CreateTotal(BE) 00181 !BE%Field%id=BE_Field 00182 !BE%Field%component=GASCOMP 00183 !BE%Field%name='BE' 00184 00185 ! CALL CreateHistogram(Histogram) 00186 ! Histogram%Field%id=MixingRatio12_Field 00187 ! Histogram%Field%component=GASCOMP 00188 ! Histogram%minvalue=0d0 00189 ! Histogram%maxvalue=1d0 00190 ! Histogram%nbins=100 00191 ! Histogram%scale=LINEARSCALE 00192 ! Histogram%WeightField=MASS 00193 00194 !CALL CreateTotal(ENSTROPHY) 00195 !ENSTROPHY%Field%iD=Enstrophy_Field 00196 !ENSTROPHY%Field%Component=GASCOMP 00197 !ENSTROPHY%Field%name='ENSTROPHY' 00198 !Processing_mbc=max(Processing_mbc,1) 00199 00200 00201 END SUBROUTINE ProblemModuleInit 00202 00205 SUBROUTINE ProblemGridInit(Info) 00206 TYPE(InfoDef) :: Info 00207 END SUBROUTINE ProblemGridInit 00208 00211 SUBROUTINE ProblemBeforeStep(Info) 00212 TYPE(InfoDef) :: Info 00213 END SUBROUTINE ProblemBeforeStep 00214 00217 SUBROUTINE ProblemAfterStep(Info) 00218 TYPE(InfoDef) :: Info 00219 END SUBROUTINE ProblemAfterStep 00220 00223 SUBROUTINE ProblemSetErrFlag(Info) 00224 TYPE(InfoDef) :: Info 00225 INTEGER :: ip(3,2) 00226 REAL(KIND=qPREC) :: wind_pos, dx 00227 00228 IF (levels(Info%level)%tnow <= wind_refinement_time) THEN 00229 dx=levels(Info%level)%dx 00230 wind_pos=wind_vel/2d0*levels(Info%level)%tnow 00231 ip(:,1)=1 00232 ip(:,2)=Info%mX 00233 ip(wind%dir,1)=ceiling((wind_pos-wind_thickness-Info%xBounds(wind%dir,1))/dx) 00234 ip(wind%dir,2)=ceiling((wind_pos+wind_thickness-Info%xBounds(wind%dir,1))/dx) 00235 ip(wind%dir,1)=max(ip(wind%dir,1), 1) 00236 ip(wind%dir,2)=min(ip(wind%dir,2),Info%mX(wind%dir)) 00237 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 00238 END IF 00239 END SUBROUTINE ProblemSetErrFlag 00240 00241 SUBROUTINE ProblemBeforeGlobalStep(n) 00242 INTEGER :: n 00243 END SUBROUTINE ProblemBeforeGlobalStep 00244 00245 00246 END MODULE Problem 00247