Scrambler  1
bviscosity.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 !    bviscosity.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 BViscositySrc
00024   USE GlobalDeclarations
00025   USE TreeDeclarations
00026   USE DataDeclarations
00027   USE ExplicitDeclarations
00028   USE PhysicsDeclarations
00029   USE EOS
00030 
00031 CONTAINS
00032 
00033   SUBROUTINE BViscosityGridAdvance(n,stepping)
00034     INTEGER :: n,stepping
00035     TYPE(NodeDef), POINTER :: node
00036     TYPE(NodeDefList), POINTER :: nodelist        
00037     IF(mpi_id==0)THEN
00038        PRINT*, "Advancing BV Solver on Grid..."
00039     END IF
00040     nodelist=>nodes(n)%p
00041     DO WHILE (associated(nodelist))
00042        node=>nodelist%self
00043        CALL BViscositySource(n,node%info,stepping)
00044        nodelist=>nodelist%next
00045     END DO
00046 
00047   END SUBROUTINE BViscosityGridAdvance
00048 
00049   SUBROUTINE BViscosityGridGetMaxSpeed(n)
00050     INTEGER :: n
00051     TYPE(NodeDef), POINTER :: node
00052     TYPE(NodeDefList), POINTER :: nodelist
00053     
00054     nodelist=>Nodes(n)%p 
00055     DO WHILE (associated(nodelist))
00056        node=>nodelist%self 
00057        CALL BViscosityGetMaxSpeed(node%info)
00058        nodelist=>nodelist%next 
00059     END DO
00060 
00061   END SUBROUTINE BViscosityGridGetMaxSpeed
00062 
00063 
00064   SUBROUTINE BViscositySource(n,Info,stepping)
00065     TYPE(InfoDef) :: Info
00066     INTEGER :: i,j,k,stepping,n,mx,my,mz,mbc,zmbc,msx(3,2),msy(3,2),msz(3,2)
00067     INTEGER,ALLOCATABLE,DIMENSION(:) :: iflux
00068     REAL(KIND=qPREC) :: dx,dt
00069     REAL(KIND=qPREC),ALLOCATABLE,DIMENSION(:) :: vvec,vdq
00070     REAL(KIND=qPREC),ALLOCATABLE,DIMENSION(:,:) :: bgvx,bgvy,bgvz
00071     REAL(KIND=qPREC),ALLOCATABLE,DIMENSION(:,:,:,:) :: xflux,yflux,zflux
00072     
00073     mx=Info%mX(1);my=Info%mX(2);mz=Info%mX(3)
00074     mbc=levels(n)%ambc(levels(n)%step)-stepping
00075     SELECT CASE(nDim)
00076     CASE(2)
00077        zmbc=0
00078     CASE(3)
00079        zmbc=mbc
00080     END SELECT
00081     dx=levels(n)%dx; dt=levels(n)%dt
00082     
00083     msx=reshape((/1-mbc,1-mbc,1-zmbc,mx+mbc+1,my+mbc,mz+zmbc/),(/3,2/))
00084     msy=reshape((/1-mbc,1-mbc,1-zmbc,mx+mbc,my+mbc+1,mz+zmbc/),(/3,2/))
00085     IF(nDim==3) msz=reshape((/1-mbc,1-mbc,1-zmbc,mx+mbc,my+mbc,mz+zmbc+1/),(/3,2/))
00086     
00087     ALLOCATE(iflux(1:nDim+1))
00088     iflux(1:nDim)=imom(1:nDim);iflux(nDim+1)=iE
00089     
00090     ALLOCATE(bgvx(1:ndim,1:ndim)); ALLOCATE(bgvy(1:ndim,1:ndim))
00091     ALLOCATE(vvec(1:ndim)); ALLOCATE(vdq(1:ndim+1))
00092     ALLOCATE(xflux(msx(1,1):msx(1,2),msx(2,1):msx(2,2),msx(3,1):msx(3,2),1:nDim+1))
00093     ALLOCATE(yflux(msy(1,1):msy(1,2),msy(2,1):msy(2,2),msy(3,1):msy(3,2),1:nDim+1))
00094     IF(nDim==3) ALLOCATE(bgvz(1:ndim,1:ndim))
00095     IF(nDim==3) ALLOCATE(zflux(msz(1,1):msz(1,2),msz(2,1):msz(2,2),msz(3,1):msz(3,2),1:nDim+1))
00096     
00097     DO k=msx(3,1),msx(3,2); DO j=msx(2,1),msx(2,2); DO i=msx(1,1),msx(1,2)
00098        IF(nDim==3)THEN
00099           CALL bvTensor3D(n,Info,i,j,k,1,bgvx)
00100        ELSE
00101           CALL bvTensor2D(n,Info,i,j,k,1,bgvx)
00102        END IF
00103        vvec(1:nDim)=0.5*(Info%q(i-1,j,k,imom(1:nDim))/Info%q(i-1,j,k,1)+Info%q(i,j,k,imom(1:nDim))/Info%q(i,j,k,1))
00104        xflux(i,j,k,1:nDim)=bgvx(1,:)
00105        xflux(i,j,k,nDim+1)=DOT_PRODUCT(bgvx(:,1),vvec)
00106     END DO; END DO; END DO
00107     
00108     DO k=msy(3,1),msy(3,2); DO j=msy(2,1),msy(2,2); DO i=msy(1,1),msy(1,2)
00109        IF(nDim==3)THEN
00110           CALL bvTensor3D(n,Info,i,j,k,2,bgvy)
00111        ELSE
00112           CALL bvTensor2D(n,Info,i,j,k,2,bgvy)
00113        END IF
00114        vvec(1:nDim)=0.5*(Info%q(i,j-1,k,imom(1:nDim))/Info%q(i,j-1,k,1)+Info%q(i,j,k,imom(1:nDim))/Info%q(i,j,k,1))
00115        yflux(i,j,k,1:nDim)=bgvy(2,:)
00116        yflux(i,j,k,nDim+1)=DOT_PRODUCT(bgvy(:,2),vvec)
00117     END DO; END DO; END DO
00118     
00119     IF(nDim==3) THEN
00120        DO k=msz(3,1),msz(3,2); DO j=msz(2,1),msz(2,2); DO i=msz(1,1),msz(1,2)
00121           IF(nDim==3)THEN
00122              CALL bvTensor3D(n,Info,i,j,k,3,bgvz)
00123           ELSE
00124              CALL bvTensor2D(n,Info,i,j,k,3,bgvz)
00125           END IF
00126        END DO; END DO; END DO
00127        vvec(1:nDim)=0.5*(Info%q(i,j,k-1,imom(1:nDim))/Info%q(i,j,k-1,1)+Info%q(i,j,k,imom(1:nDim))/Info%q(i,j,k,1))
00128        zflux(i,j,k,1:nDim)=bgvz(3,:)
00129        zflux(i,j,k,nDim+1)=DOT_PRODUCT(bgvz(:,3),vvec)
00130     END IF
00131     
00132     DEALLOCATE(bgvx);DEALLOCATE(bgvy)
00133     DEALLOCATE(vvec)
00134 
00135     IF(nDim==3) THEN
00136        DEALLOCATE(bgvz)
00137     END IF
00138     
00139     DO k=1-zmbc,mz+zmbc; DO j=1-mbc,my+mbc; DO i=1-mbc,mx+mbc
00140        vdq(:)=-dt*(xflux(i+1,j,k,:)-xflux(i,j,k,:)+yflux(i,j+1,k,:)-yflux(i,j,k,:))/dx
00141        IF(nDim==3) vdq(:)=vdq(:)-dt*(zflux(i,j,k+1,:)-zflux(i,j,k,:))/dx
00142        Info%q(i,j,k,imom(1:nDim))=vdq(1:nDim)+Info%q(i,j,k,imom(1:nDim))
00143        Info%q(i,j,k,iE)=vdq(nDim+1)+Info%q(i,j,k,iE)
00144     END DO; END DO; END DO
00145     
00146     DEALLOCATE(vdq)
00147     
00148     CALL storefixupfluxes(Info,msx,1,xflux,iflux)
00149     CALL storefixupfluxes(Info,msy,2,yflux,iflux)
00150     IF(nDim==3) CALL storefixupfluxes(Info,msz,3,zflux,iflux)
00151     
00152     DEALLOCATE(xflux); DEALLOCATE(yflux)
00153     IF(nDim==3) DEALLOCATE(zflux)
00154     DEALLOCATE(iflux)
00155     
00156   END SUBROUTINE BViscositySource
00157   
00158   SUBROUTINE bvTensor2D(n,Info,i,j,k,dir,bv)
00159     TYPE(InfoDef) :: Info
00160     INTEGER:: i,j,k,l,dir
00161     REAL(KIND=qPREC) :: bvmag,ath,templ,tempr
00162     REAL(KIND=qPREC), DIMENSION(2,2) :: ii,bb,dvel,bv
00163     
00164     ath=1d0/3d0; ii=RESHAPE((/1,0,0,1/),(/2,2/));
00165     dx=levels(n)%dx
00166     
00167     CALL bbTensor2D(Info,i,j,k,dir,bb)
00168     CALL VelocityDiffTensor2D(Info,i,j,k,dir,dvel); dvel=dvel/dx
00169     
00170     bv=bb-0.3*ii
00171     bvmag=(bb(1,1)-ath)*dvel(1,1)+(bb(2,2)-ath)*dvel(2,2)+bb(1,2)*(dvel(1,2)+dvel(2,1))
00172     CALL getT(Info,i,j,k,tempr)
00173     SELECT CASE(dir)
00174     CASE(1)
00175        CALL getT(Info,i-1,j,k,templ)
00176     CASE(2)
00177        CALL getT(Info,i,j-1,k,templ)
00178     END SELECT
00179     
00180     bvmag=-3d0*bviscosity*(0.5*(templ+tempr))**2.5*bvmag
00181     bv=bvmag*bv
00182     
00183   END SUBROUTINE bvTensor2D
00184   
00185   
00186   SUBROUTINE bvTensor3D(n,Info,i,j,k,dir,bv)
00187     TYPE(InfoDef) :: Info
00188     INTEGER :: n,i,j,k,dir
00189     REAL(KIND=qPREC),DIMENSION(3,3) :: bv
00190     
00191     SELECT CASE(dir)
00192     CASE(1)
00193     CASE(2)
00194     CASE(3)
00195     END SELECT
00196 
00197 
00198   END SUBROUTINE bvTensor3D
00199 
00200 
00201   SUBROUTINE bbTensor2D(Info,i,j,k,dir,bb)
00202     TYPE(InfoDef) :: Info
00203     INTEGER :: i,j,k,dir
00204     REAL(KIND=qPREC) :: bbx,bby,bstr
00205     REAL(KIND=qPREC), DIMENSION(2,2) :: bb
00206     
00207     bb(:,:)=RESHAPE((/1d0/3d0,1d0,1d0,1d0/3d0/),(/2,2/))
00208     IF(VisType==1) RETURN
00209     SELECT CASE(dir)
00210     CASE(1)
00211        bbx=Info%aux(i,j,k,1)
00212        bby=0.25*(Info%aux(i-1,j,k,2)+Info%aux(i,j,k,2)+Info%aux(i-1,j+1,k,2)+Info%aux(i,j+1,k,2))
00213     CASE(2)
00214        bbx=0.25*(Info%aux(i,j-1,k,1)+Info%aux(i,j,k,1)+Info%aux(i+1,j-1,k,1)+Info%aux(i+1,j,k,1))
00215        bby=Info%aux(i,j,k,2)
00216     END SELECT
00217     bstr=bbx**2+bby**2
00218     IF(bstr==0d0) RETURN
00219     bb(1,1)=bbx**2/bstr; bb(2,2)=bby**2/bstr
00220     bb(1,2)=bbx*bby/bstr; bb(2,1)=bb(1,2)
00221     
00222   END SUBROUTINE bbTensor2D
00223 
00224 
00225   SUBROUTINE VelocityDiffTensor2D(Info,i,j,k,dir,dvel)
00226     TYPE(InfoDef) :: Info
00227     INTEGER :: i,j,k,l,dir
00228     REAL(KIND=qPREC) :: vl(1:ndim), vr(1:ndim)
00229     REAL(KIND=qPREC),DIMENSION(2,2) :: dvel
00230     
00231     SELECT CASE(dir)
00232     CASE(1)
00233        dvel(1,1:ndim)=Info%q(i,j,k,imom(1:ndim))/Info%q(i,j,k,1)-Info%q(i-1,j,k,imom(1:ndim))/Info%q(i-1,j,k,1)
00234        vl(1:ndim)=0.5*(Info%q(i-1,j,k,imom(1:ndim))/Info%q(i-1,j,k,1)-Info%q(i-1,j-1,k,imom(1:ndim))/Info%q(i-1,j-1,k,1)+&
00235             Info%q(i,j,k,imom(1:ndim))/Info%q(i,j,k,1)-Info%q(i,j-1,k,imom(1:ndim))/Info%q(i,j-1,k,1))
00236        vr(1:ndim)=0.5*(Info%q(i-1,j+1,k,imom(1:ndim))/Info%q(i-1,j+1,k,1)-Info%q(i-1,j,k,imom(1:ndim))/Info%q(i-1,j,k,1)+&
00237             Info%q(i,j+1,k,imom(1:ndim))/Info%q(i,j+1,k,1)-Info%q(i,j,k,imom(1:ndim))/Info%q(i,j,k,1))
00238        DO l=1,ndim
00239           dvel(2,l)=MCLimiter(vl(l),vr(l))
00240        END DO
00241     CASE(2)
00242        vl(1:ndim)=0.5*(Info%q(i,j,k,imom(1:ndim))/Info%q(i,j,k,1)-Info%q(i-1,j,k,imom(1:ndim))/Info%q(i-1,j,k,1)+&
00243             Info%q(i,j-1,k,imom(1:ndim))/Info%q(i,j-1,k,1)-Info%q(i-1,j-1,k,imom(1:ndim))/Info%q(i-1,j-1,k,1))
00244        vr(1:ndim)=0.5*(Info%q(i+1,j,k,imom(1:ndim))/Info%q(i+1,j,k,1)-Info%q(i,j,k,imom(1:ndim))/Info%q(i,j,k,1)+&
00245             Info%q(i+1,j-1,k,imom(1:ndim))/Info%q(i+1,j-1,k,1)-Info%q(i,j-1,k,imom(1:ndim))/Info%q(i,j-1,k,1))
00246        DO l=1,ndim
00247           dvel(1,l)=MCLimiter(vl(l),vr(l))
00248        END DO
00249        dvel(2,1:ndim)=(Info%q(i,j,k,imom(1:ndim))/Info%q(i,j,k,1)-Info%q(i,j-1,k,imom(1:ndim))/Info%q(i,j-1,k,1))
00250     END SELECT
00251   END SUBROUTINE VelocityDiffTensor2D
00252 
00253 
00254   SUBROUTINE VelocityDiffTensor3D(Info,i,j,k,dir,dvdx)
00255     TYPE(InfoDef) :: Info
00256     INTEGER :: i,j,k,dir
00257     REAL(KIND=qPREC),DIMENSION(3,3) :: dvdx
00258     
00259     SELECT CASE(dir)
00260     CASE(1)
00261     CASE(2)
00262     CASE(3)
00263     END SELECT
00264     
00265 
00266   END SUBROUTINE VelocityDiffTensor3D
00267 
00268 
00269   REAL FUNCTION MCLimiter(xl,xr)
00270     REAL(KIND=qPREC) :: xl, xr
00271     
00272     IF((xl+xr==0d0).or.(xl*xr<0d0)) THEN
00273        MCLimiter=0d0
00274        RETURN
00275     END IF
00276 
00277     MCLimiter = 2d0*xl*xr/(xl+xr)
00278     RETURN
00279     
00280   END FUNCTION MCLimiter
00281   
00282 
00283   SUBROUTINE getT(Info,i,j,k,temp)
00284     TYPE(InfoDef) :: Info
00285     INTEGER :: i,j,k
00286     REAL(KIND=qPREC) :: temp
00287 
00288     temp=(gamma-1d0)*(Info%q(i,j,k,iE)-0.5*SUM(Info%q(i,j,k,imom(1:nDim))**2)/Info%q(i,j,k,1)&
00289          -0.5*SUM(Info%q(i,j,k,iBx:iBx+nDim-1)**2))/Info%q(i,j,k,1)
00290     
00291   END SUBROUTINE getT
00292 
00293 
00294   SUBROUTINE BViscosityGetMaxSpeed(Info)
00295     TYPE(InfoDef) :: Info
00296     INTEGER :: level, m
00297     REAL(KIND=qPREC) :: dx
00298     
00299     level=Info%level
00300     dx=levels(level)%dx
00301     
00302     explicit_maxspeed(level) = max(explicit_maxspeed(level),2d0*resistivity/dx)
00303 
00304   END SUBROUTINE BViscosityGetMaxSpeed
00305 
00306 
00307 
00308 END MODULE BViscositySrc
00309 
00310 
00311 
 All Classes Files Functions Variables