Scrambler
1
|
00001 !######################################################################### 00002 ! 00003 ! Copyright (C) 2003-2012 Department of Physics and Astronomy, 00004 ! University of Rochester, 00005 ! Rochester, NY 00006 ! 00007 ! fields.f90 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 !######################################################################### 00023 MODULE Fields 00024 USE PhysicsDeclarations 00025 USE GlobalDeclarations 00026 USE EllipticDeclarations 00027 USE EOS 00028 USE ParticleDeclarations 00029 USE TreeDeclarations 00030 USE DataDeclarations 00031 USE CoolingSrc 00032 USE NEQCoolingSrc 00033 USE Emissions 00034 USE SourceDeclarations 00035 USE Shapes 00036 IMPLICIT NONE 00037 PUBLIC 00038 INTEGER, PARAMETER :: MAXFIELDSLENGTH=20 00039 CHARACTER(LEN=MAXFIELDSLENGTH), PARAMETER :: UNDEFINEDFIELDNAME='undefined ' 00040 INTEGER, PARAMETER :: GASCOMP=1, PARTICLECOMP=2, BOTHCOMP=3 00041 TYPE FieldDef 00042 INTEGER :: ID 00043 CHARACTER(LEN=MAXFIELDSLENGTH) :: Name=UNDEFINEDFIELDNAME 00044 INTEGER :: component=GASCOMP 00045 END type FieldDef 00046 00047 00048 INTEGER, PARAMETER :: 00049 Mass_Field=101, 00050 Px_Field=102, 00051 Py_Field=103, 00052 Pz_Field=104, 00053 E_Field=105, 00054 Bx_Field=106, 00055 By_Field=107, 00056 Bz_Field=108, 00057 KE_Field=109, 00058 iE_Field=110, 00059 BE_Field=111, 00060 P_Field=112, 00061 Temp_Field=113, 00062 GravEnergy_Field=114, 00063 MixingRatio12_Field=115, !First two tracers 00064 JeansLength_Field=116, 00065 CoolingStrength_Field=117, 00066 vx_Field=118, 00067 vy_Field=119, 00068 vz_Field=120, 00069 VMag_Field=121, 00070 Enstrophy_Field=122, 00071 SoundSpeed_Field=123, 00072 SqrtPress_Field=124, 00073 SoundSpeed2_Field=125, 00074 CellSize_Field=126, 00075 GasPotential_Field=127, 00076 RhoSoundSpeed_Field=128, 00077 srhovx_Field=129, 00078 srhovy_Field=130, 00079 srhovz_Field=131, 00080 OI_Field=132, 00081 NII_Field=133, 00082 SII_6716_Field=134, 00083 SII_6731_Field=135, 00084 Halpha_Field=136, 00085 MPI_ID_FIELD=137, 00086 ChildMask_Field=138, 00087 ErrFlag_Field=139, 00088 Divergence_Field=140 00089 00090 INTERFACE GetName 00091 MODULE PROCEDURE GetNameByID, GetNameByField 00092 END INTERFACE GetName 00093 00094 00095 CONTAINS 00096 00097 00098 00099 FUNCTION GetField(Info,i,j,k,id,pos_opt,emissinfo) 00100 TYPE(InfoDef) :: Info 00101 REAL(KIND=qPREC), DIMENSION(:), POINTER :: q 00102 REAL(KIND=qPREC) :: GetField 00103 INTEGER :: i,j,k, id 00104 TYPE(ParticleListDef), POINTER :: ParticleList 00105 REAL(KIND=qPREC), OPTIONAL :: pos_opt(3) 00106 REAL(KIND=qPREC) :: pos(3) 00107 REAL(KIND=qPREC) :: P, T0, nH, ne, x, mu, emiss 00108 REAL(KIND=qPREC), DIMENSION(0:nSpeciesHi) :: nvec 00109 LOGICAL :: lform 00110 INTEGER, DIMENSION(1:3), OPTIONAL :: emissinfo 00111 IF (PRESENT(pos_opt)) THEN 00112 pos=pos_opt 00113 ELSE 00114 pos=CellPos(Info, i, j, k) 00115 END IF 00116 q=>Info%q(i,j,k,:) 00117 IF (id >= 1 .AND. id <= NrVars) THEN 00118 GetField=q(id) 00119 ELSE 00120 IF (id >= OI_Field .AND. id <= Halpha_Field) THEN ! If desired field is an emission 00121 ! P = MERGE(PrimPress(q), Press(q), lform .eqv. PRIMITIVE) ! line then get the parameters that 00122 P = Press(q) ! are common to all the different 00123 CALL GetNEQvars(q, mu, nvec) ! emission fields 00124 T0 = P/q(1) * TempScale * mu 00125 CALL GetZvars(nvec, ne, x, nH) 00126 END IF 00127 SELECT CASE(id) 00128 CASE(Mass_Field) 00129 GetField=q(1) 00130 CASE(Px_Field) 00131 GetField=q(ivx) 00132 CASE(Py_Field) 00133 GetField=q(ivy) 00134 CASE(Pz_Field) 00135 GetField=q(ivz) 00136 CASE(E_Field) 00137 GetField=q(iE) 00138 CASE(Bx_Field) 00139 GetField=q(iBx) 00140 CASE(By_Field) 00141 GetField=q(iBy) 00142 CASE(Bz_Field) 00143 GetField=q(iBz) 00144 CASE(KE_Field) 00145 GetField=half*sum(q(m_low:m_high)**2)/q(1) 00146 CASE(iE_Field) 00147 GetField=InternalEnergy(q) 00148 CASE(BE_Field) 00149 GetField=half*sum(q(iBx:iBz)**2) 00150 CASE(P_Field) 00151 GetField=Press(q) 00152 CASE(Temp_Field) 00153 GetField=Press(q)/q(1) 00154 CASE(GravEnergy_Field) 00155 IF (iPhiGas /= 0) THEN 00156 GetField=half*q(iPhiGas)*q(1) 00157 ELSE 00158 GetField=0d0 00159 END IF 00160 ParticleList=>SinkParticles 00161 DO WHILE (ASSOCIATED(ParticleList)) 00162 IF (ASSOCIATED(ParticleList%self%PointGravityObj)) THEN 00163 GetField=GetField+q(1)*GravityPotential(ParticleList%self%q(1), pos-ParticleList%self%xloc, ParticleList%self%PointGravityObj%soft_length, ParticleList%self%PointGravityObj%soft_function) 00164 END IF 00165 ParticleList=>ParticleList%next 00166 END DO 00167 CASE(MixingRatio12_Field) 00168 GetField=2d0*min(q(nTracerLo), q(nTracerLo+1))/(max(q(1), q(nTracerLo)+q(nTracerLo+1))) 00169 CASE(JeansLength_Field) 00170 GetField=SoundSpeed(q)*sqrt(pi/(ScaleGrav*q(1))) 00171 CASE(CoolingStrength_Field) 00172 GetField=GetCoolingStrength(q,CONSERVATIVE) 00173 CASE(vx_Field) 00174 GetField=q(ivx)/q(1) 00175 CASE(vy_Field) 00176 GetField=q(ivy)/q(1) 00177 CASE(vz_Field) 00178 GetField=q(ivz)/q(1) 00179 CASE(VMag_Field) 00180 GetField=sqrt(sum(q(imom(1:nDim))**2))/q(1) 00181 CASE(Enstrophy_Field) 00182 IF (nDim == 2) THEN 00183 GetField=half*(Curl2D(Info%q(i-1:i+1,j-1:j+1,k,imom(1:2))/spread(Info%q(i-1:i+1,j-1:j+1,k,1),3,2), levels(Info%level)%dx))**2 00184 ELSE 00185 GetField=half*sum(Curl3D(Info%q(i-1:i+1,j-1:j+1,k-1:k+1,imom(1:3))/spread(Info%q(i-1:i+1,j-1:j+1,k-1:k+1,1),3,3), levels(Info%level)%dx)**2) 00186 END IF 00187 CASE(SoundSpeed_Field) 00188 GetField=SoundSpeed(q) 00189 CASE(SqrtPress_Field) 00190 GetField=sqrt(q(1))*SoundSpeed(q) 00191 CASE(SoundSpeed2_Field) 00192 GetField=SoundSpeed(q)**2 00193 CASE(RhoSoundSpeed_Field) 00194 GetField=SoundSpeed(q)*q(1) 00195 CASE(CellSize_Field) 00196 GetField=levels(Info%level)%dx 00197 CASE(srhovx_Field) 00198 GetField=q(ivx)/sqrt(q(1))!cos(half*Pi*sqrt((pos-50d0)**2) 00199 CASE(srhovy_Field) 00200 GetField=q(ivy)/sqrt(q(1)) 00201 CASE(srhovz_Field) 00202 GetField=q(ivz)/sqrt(q(1)) 00203 CASE(GasPotential_Field) 00204 IF (iPhiGas /= 0) THEN 00205 GetField=q(iPhiGas) 00206 ELSE 00207 GetField=0d0 00208 END IF 00209 CASE(OI_Field) 00210 CALL CalcEmiss(ne,T0,x,nH,iOI,emiss) 00211 GetField = emiss 00212 CASE(NII_Field) 00213 CALL CalcEmiss(ne,T0,x,nH,iNII,emiss) 00214 GetField = emiss 00215 CASE(SII_6716_Field) 00216 CALL CalcEmiss(ne,T0,x,nH,iSII_6716,emiss) 00217 GetField = emiss 00218 CASE(SII_6731_Field) 00219 CALL CalcEmiss(ne,T0,x,nH,iSII_6731,emiss) 00220 GetField = emiss 00221 CASE(Halpha_Field) 00222 CALL CalcEmiss(ne,T0,x,nH,iHalpha,emiss) 00223 GetField = emiss 00224 CASE(MPI_ID_FIELD) 00225 GetField=MPI_ID 00226 CASE(ChildMask_Field) 00227 GetField=Info%ChildMask(i,j,k) 00228 CASE(ErrFlag_Field) 00229 IF (Info%level < MaxLevel) THEN 00230 GetField=Info%ErrFlag(i,j,k) 00231 ELSE 00232 GetField=0d0 00233 END IF 00234 CASE (Divergence_Field) 00235 IF (nDim == 2) THEN 00236 GetField=(Info%aux(i+1,j,k,1)-Info%aux(i,j,k,1)+Info%aux(i,j+1,k,2)-Info%aux(i,j,k,2))/levels(Info%level)%dx 00237 ELSE 00238 GetField=(Info%aux(i+1,j,k,1)-Info%aux(i,j,k,1)+Info%aux(i,j+1,k,2)-Info%aux(i,j,k,2)+Info%aux(i,j,k+1,3)-Info%aux(i,j,k,3))/levels(Info%level)%dx 00239 END IF 00240 CASE DEFAULT 00241 IF (MPI_ID == 0) PRINT*, 'Warning, field not recognized:', i 00242 GetField=0d0 00243 END SELECT 00244 END IF 00245 00246 END FUNCTION GetField 00247 00248 00249 00250 FUNCTION GetParticleField(Particle, i) 00251 REAL(KIND=qPREC) :: GetParticleField, r, temp(3) 00252 TYPE(ParticleDef), TARGET :: Particle 00253 TYPE(ParticleListDef), POINTER :: ParticleList 00254 INTEGER :: i 00255 IF (i >= 1 .AND. i <= NrVars) THEN 00256 temp=Particle%q(m_low:m_high) 00257 Particle%q(m_low:m_high)=Particle%q(m_low:m_high)*particle%q(1) 00258 GetParticleField=Particle%q(i) 00259 Particle%q(m_low:m_high)=temp(1:m_high-m_low+1) 00260 ELSE 00261 SELECT CASE(i) 00262 CASE(Mass_Field) 00263 GetParticleField=Particle%q(1) 00264 CASE(Px_Field) 00265 GetParticleField=Particle%q(ivx)*Particle%q(1) 00266 CASE(Py_Field) 00267 GetParticleField=Particle%q(ivy)*Particle%q(1) 00268 CASE(Pz_Field) 00269 GetParticleField=Particle%q(ivz)*Particle%q(1) 00270 CASE(E_Field) 00271 IF (iE /= 0) THEN 00272 GetParticleField=Particle%q(iE) 00273 ELSE 00274 GetParticleField=Particle%q(1)*Iso_Speed2/(gamma-1d0)+half*sum(Particle%q(m_low:m_high)**2)*Particle%q(1) 00275 END IF 00276 CASE(KE_Field) 00277 GetParticleField=half*sum(Particle%q(m_low:m_high)**2)*Particle%q(1) 00278 CASE(iE_Field) 00279 IF (iE /= 0) THEN 00280 GetParticleField=Particle%q(iE)-half*sum(Particle%q(m_low:m_high)**2)*Particle%q(1) 00281 ELSE 00282 GetParticleField=Particle%q(1)*Iso_speed2 00283 END IF 00284 CASE(GravEnergy_Field) !Only particle particle potential. Gas Particle potential can be found in GasGravEnergy as this uses Phi and not PhiGas 00285 GetParticleField=0d0 00286 ParticleList=>SinkParticles 00287 DO WHILE (ASSOCIATED(ParticleList)) 00288 IF (.NOT. ASSOCIATED(ParticleList%self, Particle)) THEN 00289 IF (ASSOCIATED(ParticleList%self%PointGravityObj)) THEN 00290 GetParticleField=GetParticleField+half*Particle%q(1)*GravityPotential(ParticleList%self%q(1), Particle%xloc-ParticleList%self%xloc, ParticleList%self%PointGravityObj%soft_length, ParticleList%self%PointGravityObj%soft_function) 00291 END IF 00292 END IF 00293 ParticleList=>ParticleList%next 00294 END DO 00295 CASE(MixingRatio12_Field) 00296 GetParticleField=2d0*min(Particle%q(nTracerLo), Particle%q(nTracerLo+1))/(max(Particle%q(1), Particle%q(nTracerLo)+Particle%q(nTracerLo+1))) 00297 CASE(vx_Field) 00298 GetParticleField=Particle%q(ivx) 00299 CASE(vy_Field) 00300 GetParticleField=Particle%q(ivy) 00301 CASE(vz_Field) 00302 GetParticleField=Particle%q(ivz) 00303 CASE(VMag_Field) 00304 GetParticleField=sqrt(sum(Particle%q(imom(1:nDim))**2)) 00305 CASE DEFAULT 00306 IF (MPI_ID == 0) PRINT*, 'Warning, particle field not recognized', i, GetName(i) 00307 GetParticleField=0d0 00308 END SELECT 00309 END IF 00310 END FUNCTION GetParticleField 00311 00312 00313 FUNCTION GetNameByField(Field) 00314 TYPE(FieldDef) :: Field 00315 CHARACTER(LEN=MAXFIELDSLENGTH) :: GetNameByField 00316 IF (Field%Name == UNDEFINEDFIELDNAME) THEN 00317 GetNameByField=GetNameByID(Field%id) 00318 ELSE 00319 GetNameByField=Field%Name 00320 END IF 00321 END FUNCTION GetNameByField 00322 00323 FUNCTION GetNameByID(i) 00324 CHARACTER(LEN=MAXFIELDSLENGTH) :: GetNameByID 00325 INTEGER :: i 00326 IF (i >= 1 .AND. i <= NrFieldVars) THEN 00327 GetNameByID=FieldName(i) 00328 ELSEIF (i >= NrFieldVars+1 .AND. i <= NrFieldVars+NrTracerVars) THEN 00329 GetNameByID=TracerName(i-NrFieldVars) 00330 ELSEIF (i >= NrHydroVars+1 .AND. i <= NrHydroVars+NrEllipticVars) THEN 00331 GetNameByID=EllipticName(i-NrHydroVars) 00332 ELSE 00333 SELECT CASE(i) 00334 CASE(Mass_Field) 00335 GetNameByID='Mass' 00336 CASE(Px_Field) 00337 GetNameByID='Px' 00338 CASE(Py_Field) 00339 GetNameByID='Py' 00340 CASE(Pz_Field) 00341 GetNameByID='Pz' 00342 CASE(Bx_Field) 00343 GetNameByID='Bx' 00344 CASE(By_Field) 00345 GetNameByID='By' 00346 CASE(Bz_Field) 00347 GetNameByID='Bz' 00348 CASE(KE_Field) 00349 GetNameByID='Kinetic_Energy' 00350 CASE(iE_Field) 00351 GetNameByID='Internal_Energy' 00352 CASE(BE_Field) 00353 GetNameByID='Magnetic_Energy' 00354 CASE(P_Field) 00355 GetNameByID='Pressure' 00356 CASE(Temp_Field) 00357 GetNameByID='Temp' 00358 CASE(GravEnergy_Field) 00359 GetNameByID='Grav_Energy' 00360 CASE(MixingRatio12_Field) 00361 GetNameByID='Mixing_Ratio_12' 00362 CASE(JeansLength_Field) 00363 GetNameByID='Jeans_Length' 00364 CASE(CoolingStrength_Field) 00365 GetNameByID='Cooling_Strength' 00366 CASE(vx_Field) 00367 GetNameByID='vx' 00368 CASE(vy_Field) 00369 GetNameByID='vy' 00370 CASE(vz_Field) 00371 GetNameByID='vz' 00372 CASE(VMag_Field) 00373 GetNameByID='V_mag' 00374 CASE(Enstrophy_Field) 00375 GetNameByID='Enstrophy' 00376 CASE(srhovx_Field) 00377 GetNameByID='srho_vx' 00378 CASE(srhovy_Field) 00379 GetNameByID='srho_vy' 00380 CASE(srhovz_Field) 00381 GetNameByID='srho_vz' 00382 CASE(MPI_ID_Field) 00383 GetNameById='MPI_ID' 00384 CASE(ChildMask_Field) 00385 GetNameById='ChildMask' 00386 CASE(ErrFlag_Field) 00387 GetNameById='ErrFlag' 00388 CASE(Divergence_Field) 00389 GetNameById='Divergence' 00390 CASE DEFAULT 00391 IF (MPI_ID == 0) PRINT *, 'Warning - unrecognized field total requested' 00392 write(GetNameById,'(A5,I5.5)') 'Field', i 00393 END SELECT 00394 END IF 00395 END FUNCTION GetNameByID 00396 00397 00398 FUNCTION FindMin(Field, OptShape) 00399 TYPE(FieldDef) :: Field 00400 INTEGER :: n,i,j,k 00401 TYPE(ShapeDef), OPTIONAL, POINTER :: OptShape 00402 TYPE(ParticleListDef), POINTER :: ParticleList 00403 TYPE(NodeDefList), POINTER :: NodeList 00404 TYPE(InfoDef), POINTER :: Info 00405 REAL(KIND=qPREC) :: FindMin, rpos(3) 00406 FindMin=Huge(1d0) 00407 IF (Field%Component==GASCOMP .OR. Field%Component==BOTHCOMP) THEN 00408 DO n=0, MaxLevel 00409 Nodelist=>Nodes(n)%p 00410 DO WHILE (ASSOCIATED(NodeList)) 00411 info=>nodelist%self%info 00412 DO i=1, info%mx(1) 00413 DO j=1, info%mx(2) 00414 DO k=1, info%mx(3) 00415 IF (Present(OptShape)) THEN 00416 IF (.NOT. IsInShape(OptShape, Cellpos(info, i, j, k), rpos, levels(Info%level)%tnow)) CYCLE 00417 END IF 00418 IF (info%level < MaxLevel) THEN 00419 IF (info%Childmask(i,j,k) /= 0) CYCLE 00420 END IF 00421 FindMin=min(FindMin, GetField(info,i,j,k, Field%id)) 00422 END DO 00423 END DO 00424 END DO 00425 Nodelist=>Nodelist%next 00426 END DO 00427 END DO 00428 END IF 00429 IF (Field%Component==PARTICLECOMP .OR. Field%Component==BOTHCOMP) THEN 00430 ParticleList=>SinkParticles 00431 DO WHILE (ASSOCIATED(ParticleList)) 00432 FindMin=min(FindMin, GetParticleField(ParticleList%self, Field%ID)) 00433 ParticleList=>ParticleList%next 00434 END DO 00435 END IF 00436 00437 00438 END FUNCTION FindMin 00439 00440 00441 FUNCTION FindMax(Field, OptShape) 00442 TYPE(FieldDef) :: Field 00443 INTEGER :: n,i,j,k 00444 TYPE(ShapeDef), OPTIONAL, POINTER :: OptShape 00445 TYPE(ParticleListDef), POINTER :: ParticleList 00446 TYPE(NodeDefList), POINTER :: NodeList 00447 TYPE(InfoDef), POINTER :: Info 00448 REAL(KIND=qPREC) :: FindMax, rpos(3) 00449 FindMax=-Huge(1d0) 00450 IF (Field%Component==GASCOMP .OR. Field%Component==BOTHCOMP) THEN 00451 DO n=0, MaxLevel 00452 Nodelist=>Nodes(n)%p 00453 DO WHILE (ASSOCIATED(NodeList)) 00454 Info=>nodelist%self%info 00455 DO i=1, info%mx(1) 00456 DO j=1, info%mx(2) 00457 DO k=1, info%mx(3) 00458 IF (Present(OptShape)) THEN 00459 IF (.NOT. IsInShape(OptShape, Cellpos(Info, i, j, k), rpos, levels(Info%level)%tnow)) CYCLE 00460 END IF 00461 00462 IF (info%level < MaxLevel) THEN 00463 IF (info%Childmask(i,j,k) /= 0) CYCLE 00464 END IF 00465 FindMax=max(FindMax, GetField(info,i,j,k, Field%id)) 00466 END DO 00467 END DO 00468 END DO 00469 Nodelist=>Nodelist%next 00470 END DO 00471 END DO 00472 END IF 00473 IF (Field%Component==PARTICLECOMP .OR. Field%Component==BOTHCOMP) THEN 00474 ParticleList=>SinkParticles 00475 DO WHILE (ASSOCIATED(ParticleList)) 00476 FindMax=max(FindMax, GetParticleField(ParticleList%self, Field%ID)) 00477 ParticleList=>ParticleList%next 00478 END DO 00479 END IF 00480 00481 00482 END FUNCTION FindMax 00483 00484 00485 END MODULE Fields