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