sta_c_get_t3lsys.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	get_t3lsys (jft, jlt, ixtg, x, offg, irel, vq, nlay, irep, nel, dir_a, dir_b, elbuf_str)

Function/Subroutine Documentation

get_t3lsys()

subroutine get_t3lsys	(	integer	jft,
		integer	jlt,
		integer, dimension(nixtg,*)	ixtg,
			x,
			offg,
		integer	irel,
			vq,
		integer	nlay,
		integer	irep,
		integer	nel,
			dir_a,
			dir_b,
		type (elbuf_struct_), target	elbuf_str )

Definition at line 33 of file sta_c_get_t3lsys.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE elbufdef_mod
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
#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 IXTG(NIXTG,*),JFT,JLT,IREL,NLAY,IREP,NEL
      my_real 
     .   x(3,*), offg(*),vq(3,3,mvsiz),dir_a(*),dir_b(*)
      TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
C-----------------------------------------------
C   L O C A L   V A R I A B L E S
C-----------------------------------------------
      INTEGER I,J,K,L
      INTEGER I2,I3,I1
      my_real 
     .   rx(mvsiz),ry(mvsiz),rz(mvsiz),sx(mvsiz),sy(mvsiz),
     .   r11(mvsiz),r12(mvsiz),r13(mvsiz),r21(mvsiz),r22(mvsiz),
     .   r23(mvsiz),r31(mvsiz),r32(mvsiz),r33(mvsiz),
     .   sz(mvsiz),deta1(mvsiz)
C----------------------------------------------
        DO i=jft,jlt
          i1=ixtg(2,i)
          i2=ixtg(3,i)
          i3=ixtg(4,i)
 
          rx(i)=x(1,i2)-x(1,i1)
          ry(i)=x(2,i2)-x(2,i1)
          rz(i)=x(3,i2)-x(3,i1)
          sx(i)=x(1,i3)-x(1,i1)
          sy(i)=x(2,i3)-x(2,i1)
          sz(i)=x(3,i3)-x(3,i1)
        ENDDO 
C----------------------------
C     LOCAL SYSTEM
C----------------------------
      CALL clskew3(jft,jlt,irel,
     .   rx, ry, rz, 
     .   sx, sy, sz, 
     .   r11,r12,r13,r21,r22,r23,r31,r32,r33,deta1,offg )
      DO i=jft,jlt
        vq(1,1,i)=r11(i)
        vq(2,1,i)=r21(i)
        vq(3,1,i)=r31(i)
        vq(1,2,i)=r12(i)
        vq(2,2,i)=r22(i)
        vq(3,2,i)=r32(i)
        vq(1,3,i)=r13(i)
        vq(2,3,i)=r23(i)
        vq(3,3,i)=r33(i)
      ENDDO 
         CALL cortdir3(elbuf_str,dir_a  ,dir_b ,jft    ,jlt   ,
     .                nlay     ,irep   ,rx    ,ry     ,rz     , 
     .                sx       ,sy     ,sz    ,r11    ,r21    ,
     .                r31      ,r12    ,r22   ,r32    ,nel    )
C
      RETURN