sta_c_get_q4lsys.F File Reference

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

Go to the source code of this file.

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

Function/Subroutine Documentation

get_q4lsys()

subroutine get_q4lsys	(	integer	jft,
		integer	jlt,
		integer, dimension(nixc,*)	ixc,
			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_q4lsys.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 IXC(NIXC,*),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 IXCTMP2,IXCTMP3,IXCTMP4,IXCTMP5
      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
          ixctmp2=ixc(2,i)
          ixctmp3=ixc(3,i)
          ixctmp4=ixc(4,i)
          ixctmp5=ixc(5,i)
 
          rx(i)=x(1,ixctmp3)+x(1,ixctmp4)-x(1,ixctmp2)-x(1,ixctmp5)
          sx(i)=x(1,ixctmp4)+x(1,ixctmp5)-x(1,ixctmp2)-x(1,ixctmp3)
          ry(i)=x(2,ixctmp3)+x(2,ixctmp4)-x(2,ixctmp2)-x(2,ixctmp5)
          sy(i)=x(2,ixctmp4)+x(2,ixctmp5)-x(2,ixctmp2)-x(2,ixctmp3)
          rz(i)=x(3,ixctmp3)+x(3,ixctmp4)-x(3,ixctmp2)-x(3,ixctmp5)
          sz(i)=x(3,ixctmp4)+x(3,ixctmp5)-x(3,ixctmp2)-x(3,ixctmp3)
        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