sgetdir3.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	sgetdir3 (nel, rx, ry, rz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, dir, dirb, irep)

Function/Subroutine Documentation

sgetdir3()

subroutine sgetdir3	(	integer	nel,
			rx,
			ry,
			rz,
			tx,
			ty,
			tz,
			e1x,
			e1y,
			e1z,
			e2x,
			e2y,
			e2z,
			dir,
			dirb,
		integer	irep )

Definition at line 29 of file sgetdir3.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-----------------------------------------------
      INTEGER :: NEL,IREP
C
      my_real
     .   rx(*),ry(*),rz(*),tx(*),ty(*),tz(*),dir(nel,6),dirb(mvsiz,2),
     .   e1x(*),e1y(*),e1z(*),e2x(*),e2y(*),e2z(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
C
      my_real 
     .   v1,v2,v3,vr,vs,aa,bb,suma
C-----------------------------------------------
      IF (irep == 0) THEN                   
        DO i=1,nel                        
          dirb(i,1) = dir(i,1)              
          dirb(i,2) = dir(i,2)              
        ENDDO                               
      ELSE                                  
        DO i=1,nel                        
          aa = dir(i,1)                     
          bb = dir(i,2)                     
          v1 = aa*tx(i) + bb*rx(i)          
          v2 = aa*ty(i) + bb*ry(i)          
          v3 = aa*tz(i) + bb*rz(i)          
          vr=v1*e1x(i)+v2*e1y(i)+v3*e1z(i)  
          vs=v1*e2x(i)+v2*e2y(i)+v3*e2z(i)  
          suma=sqrt(vr*vr + vs*vs)          
          suma=one/max(em20,suma)            
          dirb(i,1) = vr*suma               
          dirb(i,2) = vs*suma               
        ENDDO                               
      ENDIF                                 
C-----------
      RETURN