vtf-logo

src/equations/ip2eustd.f

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
      

<