s6cortho3.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "vect01_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	s6cortho3 (x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6, z1, z2, z3, z4, z5, z6, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z)

Function/Subroutine Documentation

s6cortho3()

subroutine s6cortho3	(		x1,
			x2,
			x3,
			x4,
			x5,
			x6,
			y1,
			y2,
			y3,
			y4,
			y5,
			y6,
			z1,
			z2,
			z3,
			z4,
			z5,
			z6,
			rx,
			ry,
			rz,
			sx,
			sy,
			sz,
			tx,
			ty,
			tz,
			e1x,
			e1y,
			e1z,
			e2x,
			e2y,
			e2z,
			e3x,
			e3y,
			e3z )

Definition at line 28 of file s6cortho3.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
C     REAL
      my_real
     .   x1(*), x2(*), x3(*), x4(*), x5(*), x6(*), 
     .   y1(*), y2(*), y3(*), y4(*), y5(*), y6(*),   
     .   z1(*), z2(*), z3(*), z4(*), z5(*), z6(*),   
     .   rx(*) ,ry(*) ,rz(*) ,sx(*) ,sy(*) ,sz(*) ,tx(*) ,ty(*) ,tz(*),
     .   e1x(*),e1y(*),e1z(*),e2x(*),e2y(*),e2z(*),e3x(*),e3y(*),e3z(*)
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "vect01_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
C     REAL
      my_real
     .   x14(mvsiz) ,y14(mvsiz) , z14(mvsiz) ,
     .   det,c1,c2 
C-----------------------------------------------
      DO 10 i=lft,llt
       x14(i)=x1(i)+x4(i)
       y14(i)=y1(i)+y4(i)
       z14(i)=z1(i)+z4(i)
 10   CONTINUE
      DO 20 i=lft,llt
       tx(i)=x2(i)+x5(i)-x14(i)
       ty(i)=y2(i)+y5(i)-y14(i)
       tz(i)=z2(i)+z5(i)-z14(i)
 20   CONTINUE
      DO 30 i=lft,llt
       rx(i)=x3(i)+x6(i)-x14(i)
       ry(i)=y3(i)+y6(i)-y14(i)
       rz(i)=z3(i)+z6(i)-z14(i)
 30   CONTINUE
      DO i=lft,llt
        sx(i)= (x4(i)+x5(i)+x6(i)-x1(i)-x2(i)-x3(i))*third
        sy(i)= (y4(i)+y5(i)+y6(i)-y1(i)-y2(i)-y3(i))*third
        sz(i)= (z4(i)+z5(i)+z6(i)-z1(i)-z2(i)-z3(i))*third
      ENDDO
c~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      DO 100 i=lft,llt
C
       e3x(i) = ty(i) * rz(i) - tz(i) * ry(i) 
       e3y(i) = tz(i) * rx(i) - tx(i) * rz(i) 
       e3z(i) = tx(i) * ry(i) - ty(i) * rx(i) 
C
       det = sqrt(e3x(i)*e3x(i) + e3y(i)*e3y(i) + e3z(i)*e3z(i))
       IF ( det/=zero) det = one / det
       e3x(i) = e3x(i) * det
       e3y(i) = e3y(i) * det
       e3z(i) = e3z(i) * det
C
       c1=sqrt(tx(i)*tx(i)+ty(i)*ty(i)+tz(i)*tz(i))
       c2=sqrt(rx(i)*rx(i)+ry(i)*ry(i)+rz(i)*rz(i))
       e1x(i)=tx(i)*c2 +(ry(i) * e3z(i) - rz(i) * e3y(i))*c1  
       e1y(i)=ty(i)*c2 +(rz(i) * e3x(i) - rx(i) * e3z(i))*c1  
       e1z(i)=tz(i)*c2 +(rx(i) * e3y(i) - ry(i) * e3x(i))*c1
       det = sqrt(e1x(i)*e1x(i) + e1y(i)*e1y(i) + e1z(i)*e1z(i))
       IF ( det/=zero) det = one / det
       e1x(i) = e1x(i)*det
       e1y(i) = e1y(i)*det
       e1z(i) = e1z(i)*det
C
       e2x(i) = e3y(i) * e1z(i) - e3z(i) * e1y(i)
       e2y(i) = e3z(i) * e1x(i) - e3x(i) * e1z(i)
       e2z(i) = e3x(i) * e1y(i) - e3y(i) * e1x(i)
 100  CONTINUE
c~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      RETURN