Scrambler  1
fields.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 !    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
 All Classes Files Functions Variables