c ----------------------------------------------------- c Predefined internal physical boundary conditions c for Euler equations in WENO solver c ----------------------------------------------------- c Transformation of vector of conserved quantities c into primitives (rho,u,v,0,p,s1,s2,dc) c ===================================================== SUBROUTINE it2eu(mx,my,meqn,q,qt) c ===================================================== IMPLICIT NONE INTEGER mx, my, meqn DOUBLE PRECISION q(meqn,mx,my) DOUBLE PRECISION qt(meqn,mx,my) c ---- Local variables INTEGER i, j, m, nvars, ierr DOUBLE PRECISION Temperature(1) call cles_getiparam('nvars', nvars, ierr) DO j = 1, my DO i = 1, mx ! rho qt(1,i,j) = q(1,i,j) ! u, v, w do m=2, nvars qt(m,i,j) = q(m,i,j)/q(1,i,j) enddo ! p call cles_eqstate(q(1,i,j),meqn,qt(1,i,j),nvars,1,0) ! temperature qt(nvars+1,i,j) = q(nvars+1,i,j) ! dcflag qt(nvars+2,i,j) = 0.0 ! all others DO m=nvars+3, meqn qt(m,i,j) = q(m,i,j) END Do ENDDO ENDDO RETURN END c ----------------------------------------------------- c Construction of reflective boundary conditions from c mirrored primitive values and application in c conservative form in local patch in 2D c ----------------------------------------------------- c ===================================================== SUBROUTINE ip2eurfl(q,mx,my,lb,ub,meqn,nc,idx, $ qex,xc,phi,vn,maux,auex,dx,time) c ===================================================== IMPLICIT NONE INTEGER mx, my, meqn, maux, nc, idx(2,nc), lb(2), ub(2) DOUBLE PRECISION xc(2,nc), $ phi(nc), vn(2,nc), auex(maux,nc), dx(2), time DOUBLE PRECISION q(meqn, mx, my) DOUBLE PRECISION qex(meqn,nc) c ---- Local variables INTEGER i, j, n, m, stride, getindx, nvars, useViscous, ierr DOUBLE PRECISION u(2), ul call cles_getiparam('nvars', nvars, ierr) call cles_getiparam('useviscous', useViscous, ierr) stride = (ub(1) - lb(1))/(mx-1) DO n = 1, nc i = getindx(idx(1,n), lb(1), stride) j = getindx(idx(2,n), lb(2), stride) u(1) = -qex(2,n) u(2) = -qex(3,n) c ---- Add boundary velocities if available if (maux.ge.2) then u(1) = u(1) + auex(1,n) u(2) = u(2) + auex(2,n) endif u(1) = 2.d0*u(1) u(2) = 2.d0*u(2) c ---- Invert entire velocity vector for Navier-Stokes IF (useViscous.eq.1) THEN qex(2,n) = qex(2,n) + u(1) qex(3,n) = qex(3,n) + u(2) c ---- Invert only normal velocity vector for Euler ELSE ul = u(1)*vn(1,n)+u(2)*vn(2,n) qex(2,n) = qex(2,n) + ul*vn(1,n) qex(3,n) = qex(3,n) + ul*vn(2,n) ENDIF q(1,i,j) = qex(1,n) do m=2, nvars q(m,i,j) = qex(m,n)*qex(1,n) enddo call cles_inveqst(q(1,i,j),meqn,qex(1,n),nvars,1,0) ! temperature q(nvars+1,i,j) = qex(nvars+1,n) do m=nvars+3, meqn ! skip dcflag q(m,i,j) = qex(m,n) enddo END DO RETURN END c ----------------------------------------------------- c Injection of conservative extrapolated values in local patch c ----------------------------------------------------- c ===================================================== SUBROUTINE ip2euex(q,mx,my,lb,ub,meqn,nc,idx, $ qex,xc,phi,vn,maux,auex,dx,time) c ===================================================== IMPLICIT NONE INTEGER mx, my, meqn, maux, nc, idx(2,nc), lb(2), ub(2) DOUBLE PRECISION xc(2,nc), $ phi(nc), vn(2,nc), auex(maux,nc), dx(2), time DOUBLE PRECISION q(meqn, mx, my) DOUBLE PRECISION qex(meqn,nc) c ---- Local variables INTEGER i, j, n, m, stride, getindx, nvars, ierr DOUBLE PRECISION u, v, vl call cles_getiparam('nvars', nvars, ierr) stride = (ub(1) - lb(1))/(mx-1) DO n = 1, nc i = getindx(idx(1,n), lb(1), stride) j = getindx(idx(2,n), lb(2), stride) u = qex(2,n) v = qex(3,n) c ---- Prescribe normal velocity vector vl = u*vn(1,n)+v*vn(2,n) qex(2,n) = vl*vn(1,n) qex(3,n) = vl*vn(2,n) ! rho q(1,i,j) = qex(1,n) ! rho (u,v,w) do m=2, nvars q(m,i,j) = qex(m,n)*qex(1,n) enddo ! E call cles_inveqst(q(1,i,j),meqn,qex(1,n),nvars,1,0) ! temperature q(nvars+1,i,j) = qex(nvars+1,n) do m=nvars+3, meqn ! skip dcflag q(m,i,j) = qex(m,n) enddo END DO RETURN END