scortho31.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	scortho31 (x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)

Function/Subroutine Documentation

scortho31()

subroutine scortho31	(		x1,
			x2,
			x3,
			x4,
			x5,
			x6,
			x7,
			x8,
			y1,
			y2,
			y3,
			y4,
			y5,
			y6,
			y7,
			y8,
			z1,
			z2,
			z3,
			z4,
			z5,
			z6,
			z7,
			z8,
			e1x,
			e2x,
			e3x,
			e1y,
			e2y,
			e3y,
			e1z,
			e2z,
			e3z )

Definition at line 28 of file scortho31.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-----------------------------------------------
      my_real
     .   x1, x2, x3, x4, x5, x6, x7, x8,
     .   y1, y2, y3, y4, y5, y6, y7, y8,  
     .   z1, z2, z3, z4, z5, z6, z7, z8,  
     .   e1x, e1y, e1z,
     .   e2x, e2y, e2z,
     .   e3x, e3y, e3z
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      my_real
     .   x17 , x28 , x35 , x46,
     .   y17 , y28 , y35 , y46,
     .   z17 , z28 , z35 , z46,
     .   a17 , a28 ,
     .   b17 , b28 ,
     .   c17 , c28 ,
     .   rx , ry , rz ,
     .   tx , ty , tz ,
     .   det,c1,c2, sign,
     .   sx , sy , sz ,
     .   rsx , rsy , rsz
C-----------------------------------------------
      x17=x7-x1
      x28=x8-x2
      x35=x5-x3
      x46=x6-x4
      y17=y7-y1
      y28=y8-y2
      y35=y5-y3
      y46=y6-y4
      z17=z7-z1
      z28=z8-z2
      z35=z5-z3
      z46=z6-z4
C
      rx=x17+x28-x35-x46
      ry=y17+y28-y35-y46
      rz=z17+z28-z35-z46
      a17=x17+x46
      a28=x28+x35
      b17=y17+y46
      b28=y28+y35
      c17=z17+z46
      c28=z28+z35
C
      tx=a17-a28
      ty=b17-b28
      tz=c17-c28
C
c~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
C
       e3x = ty * rz - tz * ry 
       e3y = tz * rx - tx * rz 
       e3z = tx * ry - ty * rx 
C
       det = sqrt(e3x*e3x + e3y*e3y + e3z*e3z)
       IF ( det/=zero) det = one / det
       e3x = e3x * det
       e3y = e3y * det
       e3z = e3z * det
C
       c1=sqrt(tx*tx+ty*ty+tz*tz)
       c2=sqrt(rx*rx+ry*ry+rz*rz)
       e1x=tx*c2 +(ry * e3z - rz * e3y)*c1  
       e1y=ty*c2 +(rz * e3x - rx * e3z)*c1  
       e1z=tz*c2 +(rx * e3y - ry * e3x)*c1
       det = sqrt(e1x*e1x + e1y*e1y + e1z*e1z)
       IF ( det/=zero) det = one / det
       e1x = e1x*det
       e1y = e1y*det
       e1z = e1z*det
C
       e2x = e3y * e1z - e3z * e1y
       e2y = e3z * e1x - e3x * e1z
       e2z = e3x * e1y - e3y * e1x
c~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      RETURN