i8dis3.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	i8dis3 (igimp, nty, dist, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, xi, yi, zi, xp, yp, zp, n1, n2, n3, ans, ssc, ttc, h1, h2, h3, h4, xface, alp, lft, llt)

Function/Subroutine Documentation

i8dis3()

subroutine i8dis3	(	integer	igimp,
		integer	nty,
			dist,
			x1,
			y1,
			z1,
			x2,
			y2,
			z2,
			x3,
			y3,
			z3,
			x4,
			y4,
			z4,
			xi,
			yi,
			zi,
			xp,
			yp,
			zp,
			n1,
			n2,
			n3,
			ans,
			ssc,
			ttc,
			h1,
			h2,
			h3,
			h4,
			xface,
			alp,
		integer, intent(inout)	lft,
		integer, intent(inout)	llt )

Definition at line 28 of file i8dis3.F.

 
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(INOUT) :: LFT
      INTEGER, INTENT(INOUT) :: LLT
      INTEGER IGIMP,NTY
      my_real dist(*)
      my_real
     .   x1(*), x2(*), x3(*), x4(*), y1(*), y2(*), y3(*), y4(*),
     .   z1(*), z2(*), z3(*), z4(*), xi(*), yi(*), zi(*), xp(*), yp(*),
     .   zp(*), ans(*), alp(*), n1(*), n2(*), n3(*), ssc(*), ttc(*),
     .   xface(*), h1(*), h2(*), h3(*), h4(*)
 
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
C     REAL
C-----------------------------------------------
C=======================================================================
      DO i=lft,llt
        h1(i) = zero
        h2(i) = zero
        h3(i) = zero
        h4(i) = zero
        xp(i) = zero
        yp(i) = zero
        zp(i) = zero
        ans(i) = zero
        dist(i) = zero
 
 
        IF (xface(i) == zero) cycle
        IF (abs(ssc(i))>one+alp(i) .OR. abs(ttc(i))>one+alp(i)) THEN
          xface(i)=zero
        ELSE
          IF(abs(ssc(i)) > one) ssc(i)=ssc(i)/abs(ssc(i))
          IF(abs(ttc(i)) > one) ttc(i)=ttc(i)/abs(ttc(i))
        ENDIF
      END DO
C
      DO i=lft,llt
        h1(i) = fourth*(one-ttc(i))*(one-ssc(i))
        h2(i) = fourth*(one-ttc(i))*(one+ssc(i))
        h3(i) = fourth*(one+ttc(i))*(one+ssc(i))
        h4(i) = fourth*(one+ttc(i))*(one-ssc(i))
      END DO
C
      DO i=lft,llt
        xp(i)=h1(i)*x1(i)+h2(i)*x2(i)+h3(i)*x3(i)+h4(i)*x4(i)
        yp(i)=h1(i)*y1(i)+h2(i)*y2(i)+h3(i)*y3(i)+h4(i)*y4(i)
        zp(i)=h1(i)*z1(i)+h2(i)*z2(i)+h3(i)*z3(i)+h4(i)*z4(i)
      END DO
C
      DO i=lft,llt
        ans(i)= n1(i)*(xi(i)-xp(i))
     .         +n2(i)*(yi(i)-yp(i))
     .         +n3(i)*(zi(i)-zp(i))
      END DO
      IF (nty == 8) THEN
        DO i=lft,llt
          dist(i) = ans(i)
        ENDDO
      ENDIF
C-----------
      RETURN