s6fraca3.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/.
!||====================================================================
!||    s6fraca   ../starter/source/elements/thickshell/solide6c/s6fraca3.F
!||--- called by ------------------------------------------------------
!||    s6mass3   ../starter/source/elements/thickshell/solide6c/s6mass3.F
!||====================================================================
      SUBROUTINE s6fraca(X,IX1 ,IX2,IX3 ,IX4 ,IX5 ,IX6 ,PTG   ,NEL ,IMAS_DS)
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   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ,INTENT(IN)  :: NEL,IMAS_DS
      INTEGER ,DIMENSION(MVSIZ) ,INTENT(IN)  :: 
     .                  IX1, IX2, IX3, IX4, IX5 ,IX6
      my_real, DIMENSION(MVSIZ,3) , INTENT(OUT)  :: ptg 
      my_real, DIMENSION(3,NUMNOD) , INTENT(IN)  :: x 
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J
      my_real, DIMENSION(MVSIZ)   :: x1,y1,z1,x2,y2,z2,x3,y3,z3 
      my_real
     .   p1, p2, p3, aa, bb, cc, a2, b2, c2,fac
C=======================================================================
      IF (imas_ds>0) THEN
        DO i=1,nel
          x1(i) = half*(x(1,ix1(i))+x(1,ix4(i)))
          y1(i) = half*(x(2,ix1(i))+x(2,ix4(i)))
          z1(i) = half*(x(3,ix1(i))+x(3,ix4(i)))
          x2(i) = half*(x(1,ix2(i))+x(1,ix5(i)))
          y2(i) = half*(x(2,ix2(i))+x(2,ix5(i)))
          z2(i) = half*(x(3,ix2(i))+x(3,ix5(i)))
          x3(i) = half*(x(1,ix3(i))+x(1,ix6(i)))
          y3(i) = half*(x(2,ix3(i))+x(2,ix6(i)))
          z3(i) = half*(x(3,ix3(i))+x(3,ix6(i)))
        END DO
        fac = three/pi        
        DO i=1,nel
          a2 = (x2(i)-x1(i))**2+(y2(i)-y1(i))**2+(z2(i)-z1(i))**2
          aa = sqrt(a2)
          b2 = (x2(i)-x3(i))**2+(y2(i)-y3(i))**2+(z2(i)-z3(i))**2
          bb = sqrt(b2)
          c2 = (x3(i)-x1(i))**2+(y3(i)-y1(i))**2+(z3(i)-z1(i))**2
          cc = sqrt(c2)
          p1 = acos((a2 + c2 - b2)/(two * aa * cc)) 
          p2 = acos((a2 + b2 - c2)/(two * aa * bb)) 
          p3 = acos((b2 + c2 - a2)/(two * bb * cc)) 
          ptg(i,1)=fac*p1
          ptg(i,2)=fac*p2
          ptg(i,3)=fac*p3
        END DO
      ELSE
        ptg(1:nel,1:3)=one
      END IF
C-----------
      RETURN
      END SUBROUTINE s6fraca