scoor431.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	scoor431 (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

scoor431()

subroutine scoor431	(		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 29 of file scoor431.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-----------------------------------------------
C     REAL
      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
     .   p1x,p2x,p3x, p4x,p1y,p2y,p3y,p4y,p1z,p2z,p3z, p4z,
     .   rx,ry,rz,sx,sy,sz, cc,c1,c2
C-----------------------------------------------
      p1x = x1+x5    
      p1y = y1+y5    
      p1z = z1+z5    
      p2x = x2+x6    
      p2y = y2+y6    
      p2z = z2+z6    
      p3x = x3+x7    
      p3y = y3+y7    
      p3z = z3+z7    
      p4x = x4+x8    
      p4y = y4+y8    
      p4z = z4+z8    
C
      rx  = p2x + p3x - p1x - p4x  
      ry  = p2y + p3y - p1y - p4y  
      rz  = p2z + p3z - p1z - p4z  
      sx  = p3x + p4x - p1x - p2x  
      sy  = p3y + p4y - p1y - p2y  
      sz  = p3z + p4z - p1z - p2z  
C
      e3x = ry * sz - rz * sy                 
      e3y = rz * sx - rx * sz                 
      e3z = rx * sy - ry * sx                 
      cc  = one / max(em20,sqrt(e3x*e3x + e3y*e3y + e3z*e3z))                      
      e3x = e3x * cc                          
      e3y = e3y * cc                          
      e3z = e3z * cc                          
C
      c1 = rx*rx + ry*ry + rz*rz            
      c2 = sx*sx + sy*sy + sz*sz            
      IF (c1 /= zero) THEN                      
        cc  = sqrt(c2/c1)                  
        e1x = rx*cc+(sy*e3z-sz*e3y)           
        e1y = ry*cc+(sz*e3x-sx*e3z)           
        e1z = rz*cc+(sx*e3y-sy*e3x)           
      ELSEIF (c2 /= zero) THEN                   
        cc  = sqrt(c1/c2)                  
        e1x = rx+(sy*e3z-sz*e3y)*cc           
        e1y = ry+(sz*e3x-sx*e3z)*cc           
        e1z = rz+(sx*e3y-sy*e3x)*cc           
      END IF                                  
C
      cc = sqrt(e1x*e1x + e1y*e1y + e1z*e1z)  
      IF (cc /= zero) cc = one / cc            
      e1x = e1x*cc                            
      e1y = e1y*cc                            
      e1z = e1z*cc                            
      e2x = e3y * e1z - e3z * e1y             
      e2y = e3z * e1x - e3x * e1z             
      e2z = e3x * e1y - e3y * e1x             
C-----------
      RETURN