sorthdir17.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	sorthdir17 (rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, gama, nel, jcvt)

Function/Subroutine Documentation

sorthdir17()

subroutine sorthdir17	(	intent(in)	rx,
		intent(in)	ry,
		intent(in)	rz,
		intent(in)	sx,
		intent(in)	sy,
		intent(in)	sz,
		intent(in)	tx,
		intent(in)	ty,
		intent(in)	tz,
		intent(in)	e1x,
		intent(in)	e2x,
		intent(in)	e3x,
		intent(in)	e1y,
		intent(in)	e2y,
		intent(in)	e3y,
		intent(in)	e1z,
		intent(in)	e2z,
		intent(in)	e3z,
		intent(inout)	gama,
		integer, intent(in)	nel,
		integer, intent(in)	jcvt )

Definition at line 28 of file sorthdir17.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) :: NEL
      INTEGER, INTENT(IN) :: JCVT
      my_real, DIMENSION(NEL), INTENT(IN)    ::
     .   rx, ry, rz, sx, sy, sz, tx, ty, tz,
     .   e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z
      my_real, 
     .  DIMENSION(MVSIZ,6), INTENT(INOUT) :: gama
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
     .  ux,uy,uz,vx,vy,vz,wx,wy,wz,d1,d2,d3,gx,gy,gz,suma,s2,s3
      my_real, 
     .  DIMENSION(6)  :: gama0
C=======================================================================
        IF (jcvt== 0) THEN
C------U,V,DW ->R,S,T orthogalized        
         DO i=1,nel                                            
          suma = one/sqrt(rx(i)**2+ry(i)**2+rz(i)**2)
          ux = rx(i)*suma
          uy = ry(i)*suma
          uz = rz(i)*suma             
          wx = uy*sz(i)-uz*sy(i)                 
          wy = uz*sx(i)-ux*sz(i)                 
          wz = ux*sy(i)-uy*sx(i)                 
          suma = one/sqrt(wx*wx + wy*wy + wz*wz)
          wx = wx*suma                 
          wy = wy*suma                 
          wz = wz*suma                 
          vx = wy*uz-wz*uy                 
          vy = wz*ux-wx*uz                 
          vz = wx*uy-wy*ux                 
          suma = one/sqrt(vx*vx + vy*vy + vz*vz)
          vx = vx*suma                 
          vy = vy*suma                 
          vz = vz*suma
C---------refind --_global ortho          
          gama0(1)= gama(i,1)*ux+gama(i,2)*vx+gama(i,3)*wx
          gama0(2)= gama(i,1)*uy+gama(i,2)*vy+gama(i,3)*wy
          gama0(3)= gama(i,1)*uz+gama(i,2)*vz+gama(i,3)*wz
C
          gama0(4)= gama(i,4)*ux+gama(i,5)*vx+gama(i,6)*wx
          gama0(5)= gama(i,4)*uy+gama(i,5)*vy+gama(i,6)*wy
          gama0(6)= gama(i,4)*uz+gama(i,5)*vz+gama(i,6)*wz
C         
          gama(i,1)=
     .      gama0(1)*e1x(i)+gama0(2)*e1y(i)+gama0(3)*e1z(i)
          gama(i,2)=
     .      gama0(1)*e2x(i)+gama0(2)*e2y(i)+gama0(3)*e2z(i)
          gama(i,3)=
     .      gama0(1)*e3x(i)+gama0(2)*e3y(i)+gama0(3)*e3z(i)
          gama(i,4)=
     .      gama0(4)*e1x(i)+gama0(5)*e1y(i)+gama0(6)*e1z(i)
          gama(i,5)=
     .      gama0(4)*e2x(i)+gama0(5)*e2y(i)+gama0(6)*e2z(i)
          gama(i,6)=
     .      gama0(4)*e3x(i)+gama0(5)*e3y(i)+gama0(6)*e3z(i)
         ENDDO                                     
C
        ELSE
          DO i=1,nel
            gama0(1)  = gama(i,1)   
            gama0(2)  = gama(i,2)   
            gama0(3)  = gama(i,3)   
            gama0(4)  = gama(i,4)   
            gama0(5)  = gama(i,5)   
            gama0(6)  = gama(i,6)   
!                                       
            gama(i,1) = gama0(3)                             
            gama(i,2) = gama0(1)                             
            gama(i,3) = gama0(2)
            gama(i,4) = gama0(6)                             
            gama(i,5) = gama0(4)                           
            gama(i,6) = gama0(5)
          ENDDO      
        ENDIF                                      
C-------------
      RETURN