Scrambler
1
|
00001 !######################################################################### 00002 ! 00003 ! Copyright (C) 2003-2012 Department of Physics and Astronomy, 00004 ! University of Rochester, 00005 ! Rochester, NY 00006 ! 00007 ! winds.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 !######################################################################### 00025 00029 00032 MODULE Winds 00033 USE GlobalDeclarations 00034 USE DataDeclarations 00035 USE PhysicsDeclarations 00036 USE EOS 00037 USE ObjectDeclarations 00038 IMPLICIT NONE 00040 00041 INTEGER, PARAMETER :: NOWAVE = 0, SQUAREWAVE = 1, SINEWAVE = 2 00042 00043 TYPE WindDef 00044 REAL(KIND=qPREC) :: velocity = 0d0 00045 REAL(KIND=qPREC) :: density=1d0 00046 REAL(KIND=qPREC) :: temperature=1d0 00047 REAL(KIND=qPREC) :: B(3) = 0d0 !magnetic field 00048 REAL(KIND=qPREC) :: period = 0d0 00049 REAL(KIND=qPREC) :: amplitude = 0d0 00050 INTEGER :: dir = 1 00051 INTEGER :: edge = 1 00052 INTEGER :: waveform = NOWAVE 00053 INTEGER :: Type = 0 00054 INTEGER :: iTracer = 0 !Tracer slot index (1 - NrTracerVars) 00055 INTEGER :: ObjId 00056 ! TYPE(ShapeDef), POINTER :: shape 00057 END TYPE WindDef 00058 00059 ! new declaration 00060 TYPE pWindDef 00061 TYPE(WindDef), POINTER :: ptr 00062 END TYPE pWindDef 00063 TYPE(pWindDef) :: pWind 00064 ! 00065 00066 00067 INTEGER, PARAMETER :: USER_DEFINED = 0, OUTFLOW_ONLY = 1 00068 CONTAINS 00069 00072 SUBROUTINE CreateWind(Wind, density, temperature, velocity) 00073 TYPE(WindDef), POINTER :: Wind 00074 REAL(KIND=qPREC), OPTIONAL :: density, temperature, velocity 00075 ALLOCATE(Wind) 00076 IF (Present(density)) Wind%density=density 00077 IF (Present(velocity)) Wind%velocity=velocity 00078 IF (Present(temperature)) Wind%temperature=temperature 00079 CALL AddWindToList(Wind) 00080 END SUBROUTINE CreateWind 00081 00082 00083 SUBROUTINE UpdateWind(Wind) 00084 TYPE(WindDef), POINTER :: Wind 00085 END SUBROUTINE UpdateWind 00086 00087 SUBROUTINE AddWindToList(Wind) 00088 TYPE(WindDef), POINTER :: Wind 00089 TYPE(ObjectDef), POINTER :: Object 00090 Wind%ObjId = ObjectListAdd(Object,WindOBJ) 00091 pWind%ptr => Wind 00092 len = size(transfer(pWind, dummy_char)) 00093 ALLOCATE(Object%storage(len)) 00094 Object%storage = transfer(pWind,Object%storage) 00095 END SUBROUTINE AddWindToList 00096 00097 00098 SUBROUTINE WindGridInit(Info, Wind) 00099 TYPE(InfoDef) :: Info 00100 TYPE(WindDef) :: Wind 00101 CALL WindBeforeStep(Info, Wind) 00102 END SUBROUTINE WindGridInit 00103 00104 00108 SUBROUTINE WindBeforeStep(Info, Wind) 00109 TYPE(InfoDef) :: Info 00110 TYPE(WindDef) :: Wind 00111 INTEGER, DIMENSION(3,2) :: ip,iq 00112 INTEGER :: rmbc, m,j 00113 REAL(KIND=qPREC) :: windvals(5) 00114 INTEGER :: nwindvars 00115 INTEGER :: windvars(5) 00116 IF (GhostOverlap(Info, wind%dir, wind%edge,ip)) THEN 00117 SELECT CASE (Wind%Type) 00118 CASE (USER_DEFINED) 00119 Info%q(ip(1,1):ip(1,2),ip(2,1):ip(2,2),ip(3,1):ip(3,2),1:NrHydroVars)=0d0 00120 Info%q(ip(1,1):ip(1,2),ip(2,1):ip(2,2),ip(3,1):ip(3,2),1)=wind%density 00121 Info%q(ip(1,1):ip(1,2),ip(2,1):ip(2,2),ip(3,1):ip(3,2),m_low:m_high)=0 00122 00123 SELECT CASE (wind%waveform) 00124 CASE(NOWAVE) 00125 Info%q(ip(1,1):ip(1,2),ip(2,1):ip(2,2),ip(3,1):ip(3,2),imom(wind%dir))=wind%velocity 00126 00127 CASE(SQUAREWAVE) 00128 Info%q(ip(1,1):ip(1,2),ip(2,1):ip(2,2),ip(3,1):ip(3,2),imom(wind%dir))=wind%velocity*(1d0 + wind%amplitude*SIGN(1d0,SIN(2d0*pi*levels(info%level)%tnow/wind%period))) 00129 00130 CASE(SINEWAVE) 00131 Info%q(ip(1,1):ip(1,2),ip(2,1):ip(2,2),ip(3,1):ip(3,2),imom(wind%dir))=wind%velocity*(1d0 + wind%amplitude*SIN(2d0*pi*levels(info%level)%tnow/wind%period)) 00132 END SELECT 00133 00134 IF (iE .ne. 0) Info%q(ip(1,1):ip(1,2),ip(2,1):ip(2,2),ip(3,1):ip(3,2),iE)=wind%density*wind%temperature 00135 IF (lMHD) THEN 00136 Info%q(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2), iBx)=wind%B(1) 00137 Info%q(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2), iBy)=wind%B(2) 00138 Info%q(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2), iBz)=wind%B(3) 00139 IF(MaintainAuxArrays) THEN 00140 DO j=1,nDim 00141 IF (j == wind%dir) cycle 00142 ip(j,2)=ip(j,2)+1 00143 Info%aux(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2), j) = wind%B(j) 00144 ip(j,2)=ip(j,2)-1 00145 END DO 00146 IF (wind%edge == 2) ip(wind%dir,:)=ip(wind%dir,:)+1 00147 Info%aux(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2), wind%dir) = wind%B(wind%dir) 00148 IF (wind%edge == 2) ip(wind%dir,:)=ip(wind%dir,:)-1 00149 iq=ip 00150 iq(wind%dir,:)=iq(wind%dir,:)+1 00151 Info%q(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2), iBx-1+wind%dir) = half*( & 00152 Info%aux(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2), wind%dir) + & 00153 Info%aux(iq(1,1):iq(1,2), iq(2,1):iq(2,2), iq(3,1):iq(3,2), wind%dir)) 00154 END IF 00155 END IF 00156 CALL Prim_To_Cons(Info,ip) 00157 CASE (OUTFLOW_ONLY) 00158 CALL ConvertTotalToInternalEnergy(Info%q(ip(1,1):ip(1,2),ip(2,1):ip(2,2),ip(3,1):ip(3,2),:)) 00159 IF (wind%edge == 1) THEN 00160 Info%q(ip(1,1):ip(1,2),ip(2,1):ip(2,2),ip(3,1):ip(3,2),imom(wind%dir))=& 00161 min(Info%q(ip(1,1):ip(1,2),ip(2,1):ip(2,2),ip(3,1):ip(3,2),imom(wind%dir)),0d0) 00162 ELSE 00163 Info%q(ip(1,1):ip(1,2),ip(2,1):ip(2,2),ip(3,1):ip(3,2),imom(wind%dir))=& 00164 max(Info%q(ip(1,1):ip(1,2),ip(2,1):ip(2,2),ip(3,1):ip(3,2),imom(wind%dir)),0d0) 00165 END IF 00166 IF (iE .ne. 0) THEN 00167 IF (ivz /= 0) THEN 00168 windvars(1:5)=(/1,ivx,ivy,ivz,iE/) 00169 nwindvars=5 00170 ELSEIF (ivy /= 0) THEN 00171 windvars(1:4)=(/1,ivx,ivy,iE/) 00172 nwindvars=4 00173 ELSE 00174 windvars(1:3)=(/1,ivx,iE/) 00175 nwindvars=3 00176 END IF 00177 ELSE 00178 IF (ivz /= 0) THEN 00179 windvars(1:4)=(/1,ivx,ivy,ivz/) 00180 nwindvars=4 00181 ELSEIF (ivy /= 0) THEN 00182 windvars(1:3)=(/1,ivx,ivy/) 00183 nwindvars=3 00184 ELSE 00185 windvars(1:2)=(/1,ivx/) 00186 nwindvars=2 00187 END IF 00188 END IF 00189 windvals(1)=wind%density 00190 windvals(m_low:m_high)=0 00191 IF (iE .ne. 0) windvals(iE)=gamma7*wind%density*wind%temperature 00192 00193 FORALL (m=1:nwindvars) 00194 WHERE(Info%q(ip(1,1):ip(1,2),ip(2,1):ip(2,2),ip(3,1):ip(3,2),imom(wind%dir)) == 0) 00195 Info%q(ip(1,1):ip(1,2),ip(2,1):ip(2,2),ip(3,1):ip(3,2),windvars(m)) = windvals(windvars(m)) 00196 END WHERE 00197 END FORALL 00198 IF (lMHD) THEN 00199 Info%q(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2), iBx)=wind%B(1) 00200 Info%q(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2), iBy)=wind%B(2) 00201 Info%q(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2), iBz)=wind%B(3) 00202 IF(MaintainAuxArrays) THEN 00203 DO j=1,nDim 00204 IF (j == wind%dir) cycle 00205 ip(j,2)=ip(j,2)+1 00206 Info%aux(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2), j) = wind%B(j) 00207 ip(j,2)=ip(j,2)-1 00208 END DO 00209 IF (wind%edge == 2) ip(wind%dir,:)=ip(wind%dir,:)+1 00210 Info%aux(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2), wind%dir) = wind%B(wind%dir) 00211 IF (wind%edge == 2) ip(wind%dir,:)=ip(wind%dir,:)-1 00212 iq=ip 00213 iq(wind%dir,:)=iq(wind%dir,:)+1 00214 Info%q(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2), iBx-1+wind%dir) = half*( & 00215 Info%aux(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2), wind%dir) + & 00216 Info%aux(iq(1,1):iq(1,2), iq(2,1):iq(2,2), iq(3,1):iq(3,2), wind%dir)) 00217 END IF 00218 END IF 00219 00220 00221 CALL ConvertInternalToTotalEnergy(Info%q(ip(1,1):ip(1,2),ip(2,1):ip(2,2),ip(3,1):ip(3,2),:)) 00222 END SELECT 00223 IF (wind%iTracer .ne. 0) Info%q(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2), wind%iTracer)=wind%density 00224 END IF 00225 END SUBROUTINE WindBeforeStep 00226 00227 00228 SUBROUTINE WindSetErrFlag(Info, Wind) 00229 TYPE(InfoDef) :: Info 00230 Type(WindDef), POINTER :: Wind 00231 END SUBROUTINE WindSetErrFlag 00232 00233 SUBROUTINE WindBeforeGlobalStep(n) 00234 INTEGER :: n 00235 END SUBROUTINE WindBeforeGlobalStep 00236 00237 00238 END MODULE Winds 00239