calcrhofacomp.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	calcrhofacomp (nface, vfa, shcon, ielmat, ntmat_, mi, ielfa, ipnei, vel, nef, flux, gradpel, gradtel, xxj, betam, xlet)

Function/Subroutine Documentation

calcrhofacomp()

subroutine calcrhofacomp	(	integer	nface,
		real*8, dimension(0:7,*)	vfa,
		real*8, dimension(0:3,ntmat_,*)	shcon,
		integer, dimension(mi(3),*)	ielmat,
		integer	ntmat_,
		integer, dimension(*)	mi,
		integer, dimension(4,*)	ielfa,
		integer, dimension(*)	ipnei,
		real*8, dimension(nef,0:7)	vel,
		integer	nef,
		real*8, dimension(*)	flux,
		real*8, dimension(3,*)	gradpel,
		real*8, dimension(3,*)	gradtel,
		real*8, dimension(3,*)	xxj,
		real*8	betam,
		real*8, dimension(*)	xlet
	)

!
!     calculation of the density at the face centers
!     (compressible fluids)
!
      implicit none
!
      integer nface,i,j,imat,ntmat_,mi(*),ipnei(*),nef,iel1,iel2,
     &  ielmat(mi(3),*),ielfa(4,*),indexf
!
      real*8 t1l,vfa(0:7,*),shcon(0:3,ntmat_,*),vel(nef,0:7),flux(*),
     &  r,gradpel(3,*),gradtel(3,*),xxj(3,*),gamma,betam,phic,vud,
     &  vcd,xlet(*)
!     
c$omp parallel default(none)
c$omp& shared(nface,vfa,ielmat,ielfa,shcon,ipnei,flux,gradpel,gradtel,
c$omp&        xxj,betam,xlet,vel)
c$omp& private(i,j,t1l,imat,iel1,iel2,indexf,vcd,vud,r,gamma,phic)
c$omp do
      do i=1,nface
         t1l=vfa(0,i)
!
!        take the material of the first adjacent element
!
         imat=ielmat(1,ielfa(1,i))
         r=shcon(3,1,imat)
!
!        specific gas constant
!
         vfa(5,i)=vfa(4,i)/(r*t1l)
!
!        calculate gamma
!
         iel2=ielfa(2,i)
!
!        faces with only one neighbor need not be treated
!
         if(iel2.le.0) cycle
         iel1=ielfa(1,i)
         j=ielfa(4,i)
         indexf=ipnei(iel1)+j
!
         vcd=vel(iel2,5)-vel(iel1,5)
         if(dabs(vcd).lt.1.d-3*dabs(vel(iel1,5))) vcd=0.d0
!
         if(flux(indexf).ge.0.d0) then
            vud=2.d0*xlet(indexf)*
     &           ((gradpel(1,iel1)-vel(iel1,5)*r*gradtel(1,iel1))
     &             *xxj(1,indexf)+
     &            (gradpel(2,iel1)-vel(iel1,5)*r*gradtel(2,iel1))
     &             *xxj(2,indexf)+
     &            (gradpel(3,iel1)-vel(iel1,5)*r*gradtel(3,iel1))
     &             *xxj(3,indexf))/(r*vel(iel1,0))
         else
            vud=2.d0*xlet(indexf)*
     &           ((gradpel(1,iel2)-vel(iel2,5)*r*gradtel(1,iel2))
     &             *xxj(1,indexf)+
     &            (gradpel(2,iel2)-vel(iel2,5)*r*gradtel(2,iel2))
     &             *xxj(2,indexf)+
     &            (gradpel(3,iel2)-vel(iel2,5)*r*gradtel(3,iel2))
     &             *xxj(3,indexf))/(r*vel(iel2,0))
         endif
!
         if(dabs(vud).lt.1.d-20) then
            gamma=0.d0
            cycle
         endif
!            
         phic=1.d0-vcd/vud
!
         if(phic.ge.1.d0) then
            gamma=0.d0
         elseif(phic.le.0.d0) then
            gamma=0.d0
         elseif(betam.le.phic) then
            gamma=1.d0
         else
            gamma=phic/betam
         endif
!
!        mixture of central difference and upwind difference
!
         if(flux(indexf).ge.0.d0) then
            vfa(5,i)=gamma*vfa(5,i)+(1.d0-gamma)*vel(iel1,5)
         else
            vfa(5,i)=gamma*vfa(5,i)+(1.d0-gamma)*vel(iel2,5)
         endif
!    
c         write(*,*) 'calcrhofacomp ',i,gamma
      enddo
c$omp end do
c$omp end parallel
!            
      return