smom43.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/.
!||====================================================================
!||    smom43    ../engine/source/elements/solid/sconnect/smom43.F
!||--- called by ------------------------------------------------------
!||    suser43   ../engine/source/elements/solid/sconnect/suser43.F
!||====================================================================
      SUBROUTINE smom43(NEL   ,
     .     F1X   ,F2X   ,F3X   ,F4X   ,F5X   ,F6X   ,F7X   ,F8X   ,
     .     F1Y   ,F2Y   ,F3Y   ,F4Y   ,F5Y   ,F6Y   ,F7Y   ,F8Y   ,
     .     F1Z   ,F2Z   ,F3Z   ,F4Z   ,F5Z   ,F6Z   ,F7Z   ,F8Z   ,
     .     R1X   ,R2X   ,R3X   ,R4X   ,R5X   ,R6X   ,R7X   ,R8X   ,
     .     R1Y   ,R2Y   ,R3Y   ,R4Y   ,R5Y   ,R6Y   ,R7Y   ,R8Y   ,
     .     R1Z   ,R2Z   ,R3Z   ,R4Z   ,R5Z   ,R6Z   ,R7Z   ,R8Z   ,
     .     RXX   ,RYY   ,RZZ   ,TTHICK)
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NEL
C     REAL
      my_real 
     .  TTHICK
      my_real 
     .  F1X(*),F2X(*),F3X(*),F4X(*),F5X(*),F6X(*),F7X(*),F8X(*),         
     .  F1Y(*),F2Y(*),F3Y(*),F4Y(*),F5Y(*),F6Y(*),F7Y(*),F8Y(*),         
     .  f1z(*),f2z(*),f3z(*),f4z(*),f5z(*),f6z(*),f7z(*),f8z(*),      
     .  r1x(nel),r2x(nel),r3x(nel),r4x(nel),                  
     .  r5x(nel),r6x(nel),r7x(nel),r8x(nel),                  
     .  r1y(nel),r2y(nel),r3y(nel),r4y(nel),                  
     .  r5y(nel),r6y(nel),r7y(nel),r8y(nel),                  
     .  r1z(nel),r2z(nel),r3z(nel),r4z(nel),                  
     .  r5z(nel),r6z(nel),r7z(nel),r8z(nel),rxx(nel),ryy(nel),rzz(nel) 
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
C     REAL
      my_real
     .  MXX(NEL),MYY(NEL),MZZ(NEL)
      my_real
     .  MYZ,MZY,MZX,MXZ,MXY,MYX,FXX,FYY,FZZ,FA,FB,RAX,RBX,RAY,RBY,
     .  D1,D2,DD
C=======================================================================
      DO i=1,nel
        mxy = r1x(i)*f1y(i)+r2x(i)*f2y(i)+r3x(i)*f3y(i)+r4x(i)*f4y(i)
     .       +r5x(i)*f5y(i)+r6x(i)*f6y(i)+r7x(i)*f7y(i)+r8x(i)*f8y(i)
        myx = r1y(i)*f1x(i)+r2y(i)*f2x(i)+r3y(i)*f3x(i)+r4y(i)*f4x(i)
     .       +r5y(i)*f5x(i)+r6y(i)*f6x(i)+r7y(i)*f7x(i)+r8y(i)*f8x(i)
        mzz(i) = mxy - myx
c
C---    Moment Z
c
        fyy = mxy/rxx(i)         
        fxx =-myx/ryy(i)         
c
        f1x(i) = f1x(i) - fxx    
        f2x(i) = f2x(i) - fxx    
        f3x(i) = f3x(i) + fxx    
        f4x(i) = f4x(i) + fxx    
        f5x(i) = f5x(i) - fxx    
        f6x(i) = f6x(i) - fxx    
        f7x(i) = f7x(i) + fxx    
        f8x(i) = f8x(i) + fxx    
c
        f1y(i) = f1y(i) + fyy    
        f2y(i) = f2y(i) - fyy    
        f3y(i) = f3y(i) - fyy    
        f4y(i) = f4y(i) + fyy    
        f5y(i) = f5y(i) + fyy    
        f6y(i) = f6y(i) - fyy    
        f7y(i) = f7y(i) - fyy    
        f8y(i) = f8y(i) + fyy    
c
c---    Moments Mx, MY
c
        
        IF(tthick >zero)THEN
        myz = r1y(i)*f1z(i)+r2y(i)*f2z(i)+r3y(i)*f3z(i)+r4y(i)*f4z(i)
     .       +r5y(i)*f5z(i)+r6y(i)*f6z(i)+r7y(i)*f7z(i)+r8y(i)*f8z(i)
        mzy = tthick*half*(-f1y(i)-f2y(i)-f3y(i)-f4y(i) !car R1Z,R2Z,R3Z,R4Z <0 
     .                      +f5y(i)+f6y(i)+f7y(i)+f8y(i))
        mxx(i) = myz - mzy
 
        mzx = tthick*half*(-f1x(i)-f2x(i)-f3x(i)-f4x(i)!car R1Z,R2Z,R3Z,R4Z <0
     .                       +f5x(i)+f6x(i)+f7x(i)+f8x(i))
        mxz = r1x(i)*f1z(i)+r2x(i)*f2z(i)+r3x(i)*f3z(i)+r4x(i)*f4z(i)
     .       +r5x(i)*f5z(i)+r6x(i)*f6z(i)+r7x(i)*f7z(i)+r8x(i)*f8z(i)
        myy(i) = mzx - mxz
        ELSE
        myz = r1y(i)*f1z(i)+r2y(i)*f2z(i)+r3y(i)*f3z(i)+r4y(i)*f4z(i)
     .       +r5y(i)*f5z(i)+r6y(i)*f6z(i)+r7y(i)*f7z(i)+r8y(i)*f8z(i)
        mzy = r1z(i)*f1y(i)+r2z(i)*f2y(i)+r3z(i)*f3y(i)+r4z(i)*f4y(i)
     .       +r5z(i)*f5y(i)+r6z(i)*f6y(i)+r7z(i)*f7y(i)+r8z(i)*f8y(i)
        mxx(i) = myz - mzy
        mzx = r1z(i)*f1x(i)+r2z(i)*f2x(i)+r3z(i)*f3x(i)+r4z(i)*f4x(i)
     .       +r5z(i)*f5x(i)+r6z(i)*f6x(i)+r7z(i)*f7x(i)+r8z(i)*f8x(i)
        mxz = r1x(i)*f1z(i)+r2x(i)*f2z(i)+r3x(i)*f3z(i)+r4x(i)*f4z(i)
     .       +r5x(i)*f5z(i)+r6x(i)*f6z(i)+r7x(i)*f7z(i)+r8x(i)*f8z(i)
        myy(i) = mzx - mxz
        ENDIF
c
        rax = r1x(i) + r5x(i) - r3x(i) - r7x(i)       
        rbx = r4x(i) + r8x(i) - r2x(i) - r6x(i)       
        ray = r1y(i) + r5y(i) - r3y(i) - r7y(i)       
        rby = r4y(i) + r8y(i) - r2y(i) - r6y(i)       
        d1 = -mxx(i)*rbx - myy(i)*rby            
        d2 =  mxx(i)*rax + myy(i)*ray            
        dd =  ray*rbx - rax*rby                   
        fa = d1 / dd                             
        fb = d2 / dd                             
C
        f1z(i) = f1z(i) + fa                     
        f2z(i) = f2z(i) - fb                     
        f3z(i) = f3z(i) - fa                     
        f4z(i) = f4z(i) + fb                     
        f5z(i) = f5z(i) + fa                     
        f6z(i) = f6z(i) - fb                     
        f7z(i) = f7z(i) - fa                     
        f8z(i) = f8z(i) + fb                     
C---
      ENDDO
C-----------
      RETURN
      END