Scrambler
1
|
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