sctorth3.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	sctorth3 (jft, jlt, icstr, nel, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, g1x, g1y, g1z, g2x, g2y, g2z, g3x, g3y, g3z, gama, irep)

Function/Subroutine Documentation

sctorth3()

subroutine sctorth3	(	integer	jft,
		integer	jlt,
		integer	icstr,
		integer	nel,
			rx,
			ry,
			rz,
			sx,
			sy,
			sz,
			tx,
			ty,
			tz,
			e1x,
			e1y,
			e1z,
			e2x,
			e2y,
			e2z,
			e3x,
			e3y,
			e3z,
			g1x,
			g1y,
			g1z,
			g2x,
			g2y,
			g2z,
			g3x,
			g3y,
			g3z,
			gama,
		integer, intent(in)	irep )

Definition at line 29 of file sctorth3.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, INTENT(IN) :: IREP
      INTEGER JFT, JLT,ICSTR,NEL
C     REAL
      my_real
     .   rx(*) ,ry(*) ,rz(*) ,sx(*) ,sy(*) ,sz(*) ,tx(*) ,ty(*) ,tz(*),
     .   e1x(*),e1y(*),e1z(*),e2x(*),e2y(*),e2z(*),e3x(*),e3y(*),e3z(*),
     .   g1x(*),g1y(*),g1z(*),
     .   g2x(*),g2y(*),g2z(*),g3x(*),g3y(*),g3z(*),gama(nel,6)
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
      my_real 
     .   v1,v2,v3,vr,vs,aa,bb,suma,cpn(mvsiz),spn(mvsiz)
C-----------------------------------------------
        IF(irep == 0) THEN
           cpn(jft:jlt) = gama(jft:jlt,1)
           spn(jft:jlt) = gama(jft:jlt,2)
        ELSE
         SELECT CASE (icstr)                                             
          CASE (1)                                                        
          DO i=jft,jlt
            aa = gama(i,1)
            bb = gama(i,2)
            v1 = aa*rx(i) + bb*sx(i)
            v2 = aa*ry(i) + bb*sy(i)
            v3 = aa*rz(i) + bb*sz(i)
            vr=v1*e2x(i)+v2*e2y(i)+v3*e2z(i)
            vs=v1*e3x(i)+v2*e3y(i)+v3*e3z(i)
            suma=sqrt(vr*vr + vs*vs)
            suma=one/max(em20,suma)
            cpn(i) = vr*suma
            spn(i) = vs*suma
          ENDDO
         CASE (100)                                                        
          DO i=jft,jlt
            aa = gama(i,1)
            bb = gama(i,2)
            v1 = aa*sx(i) + bb*tx(i)
            v2 = aa*sy(i) + bb*ty(i)
            v3 = aa*sz(i) + bb*tz(i)
            vr=v1*e3x(i)+v2*e3y(i)+v3*e3z(i)
            vs=v1*e1x(i)+v2*e1y(i)+v3*e1z(i)
            suma=sqrt(vr*vr + vs*vs)
            suma=one/max(em20,suma)
            cpn(i) = vr*suma
            spn(i) = vs*suma
          ENDDO
        CASE (10)                                                        
          DO i=jft,jlt
            aa = gama(i,1)
            bb = gama(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)
            cpn(i) = vr*suma
            spn(i) = vs*suma
          ENDDO
         END SELECT                                                      
        ENDIF
C
        SELECT CASE (icstr)                                             
        CASE (1)                                                        
            g1x(jft:jlt)=zero
            g1y(jft:jlt)=cpn(jft:jlt)
            g1z(jft:jlt)=spn(jft:jlt)
            g2x(jft:jlt)=zero                                                 
            g2y(jft:jlt)=-spn(jft:jlt)                                                 
            g2z(jft:jlt)=cpn(jft:jlt)                                               
            g3x(jft:jlt)=one
            g3y(jft:jlt)=zero
            g3z(jft:jlt)=zero
        CASE (100)                                                        
            g1x(jft:jlt)=spn(jft:jlt)
            g1y(jft:jlt)=zero
            g1z(jft:jlt)=cpn(jft:jlt)
            g2x(jft:jlt)=cpn(jft:jlt)                                                 
            g2y(jft:jlt)=zero                                                 
            g2z(jft:jlt)=-spn(jft:jlt)                                               
            g3x(jft:jlt)=zero
            g3y(jft:jlt)=one
            g3z(jft:jlt)=zero
        CASE (10)                                                        
            g1x(jft:jlt)=cpn(jft:jlt)
            g1y(jft:jlt)=spn(jft:jlt)
            g1z(jft:jlt)=zero
            g2x(jft:jlt)=-spn(jft:jlt)                                                 
            g2y(jft:jlt)=cpn(jft:jlt)                                                 
            g2z(jft:jlt)= zero                                               
            g3x(jft:jlt)= zero
            g3y(jft:jlt)= zero
            g3z(jft:jlt)= one
       END SELECT                                                      
C----------
      RETURN