sta_c_get_q4lsys.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    get_q4lsys      ../engine/source/output/sta/sta_c_get_q4lsys.F
!||--- called by ------------------------------------------------------
!||    stat_c_strsfg   ../engine/source/output/sta/stat_c_strsfg.F
!||--- calls      -----------------------------------------------------
!||    clskew3         ../engine/source/elements/sh3n/coquedk/cdkcoor3.F
!||    cortdir3        ../engine/source/elements/shell/coque/cortdir3.F
!||--- uses       -----------------------------------------------------
!||    elbufdef_mod    ../common_source/modules/mat_elem/elbufdef_mod.F90
!||====================================================================
        SUBROUTINE get_q4lsys(JFT    ,JLT    ,IXC    ,X    ,OFFG   ,
     .                        IREL   ,VQ     ,NLAY   ,IREP ,NEL    ,
     .                        DIR_A  ,DIR_B  ,ELBUF_STR)
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
      END