section_skew.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/.
!||====================================================================
!||    section_skew   ../engine/source/tools/sect/section_skew.F
!||--- called by ------------------------------------------------------
!||    section        ../engine/source/tools/sect/section.F
!||    section_3n     ../engine/source/tools/sect/section_3n.F
!||    section_c      ../engine/source/tools/sect/section_c.F
!||    section_p      ../engine/source/tools/sect/section_p.F
!||    section_r      ../engine/source/tools/sect/section_r.F
!||    section_s      ../engine/source/tools/sect/section_s.F
!||    section_s4     ../engine/source/tools/sect/section_s4.F
!||    section_s6     ../engine/source/tools/sect/section_s6.F
!||    section_t      ../engine/source/tools/sect/section_t.F
!||====================================================================
      SUBROUTINE section_skew(
     1   N1 ,N2 ,N3 ,X , XXC, YYC, ZZC,
     2   XX4, YY4, ZZ4, XX5, YY5, ZZ5, XX6, YY6, ZZ6,
     3   XXN, YYN, ZZN,IFRAM,NNOD,NOD,MS)
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "comlock.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER N1, N2, N3, NNOD,IFRAM, NOD(*)
      my_real X(3,*),XXC, YYC, ZZC,
     .        XX4, YY4, ZZ4, XX5, YY5, ZZ5, XX6, YY6, ZZ6,
     .        xxn, yyn, zzn, ms(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, N
      my_real XX1, YY1, ZZ1, XX2, YY2, ZZ2, XX3, YY3, ZZ3, AL4, AL6, AL5, D13, MAS, X1N, Y1N, Z1N
C-----------------------------------------------
C   B o d y
C-----------------------------------------------
      IF(ifram<10)THEN
C      MOMENTUM (SKEW N1 N2 N3)
       xx1=x(1,n1)
       yy1=x(2,n1)
       zz1=x(3,n1)
       xx2=x(1,n2)
       yy2=x(2,n2)
       zz2=x(3,n2)
       xx3=x(1,n3)
       yy3=x(2,n3)
       zz3=x(3,n3)
       xx4=xx2-xx1
       yy4=yy2-yy1
       zz4=zz2-zz1
       al4=sqrt(xx4**2+yy4**2+zz4**2)
       xx4=xx4/max(al4,em20)
       yy4=yy4/max(al4,em20)
       zz4=zz4/max(al4,em20)
       xx5=xx3-xx1
       yy5=yy3-yy1
       zz5=zz3-zz1
       xx6=yy4*zz5-zz4*yy5
       yy6=zz4*xx5-xx4*zz5
       zz6=xx4*yy5-yy4*xx5
       al6=sqrt(xx6**2+yy6**2+zz6**2)
       xx6=xx6/max(al6,em20)
       yy6=yy6/max(al6,em20)
       zz6=zz6/max(al6,em20)
       xx5=yy6*zz4-zz6*yy4
       yy5=zz6*xx4-xx6*zz4
       zz5=xx6*yy4-yy6*xx4
       al5=sqrt(xx5**2+yy5**2+zz5**2)
       xx5=xx5/max(al5,em20)
       yy5=yy5/max(al5,em20)
       zz5=zz5/max(al5,em20)
C
       xxn=xx6
       yyn=yy6
       zzn=zz6
C
       ELSEIF (n1/=0) THEN
C      MOMENTUM / GLOBAL SYSTEM
       xx4=x(1,n2)-x(1,n1)
       yy4=x(2,n2)-x(2,n1)
       zz4=x(3,n2)-x(3,n1)
       xx5=x(1,n3)-x(1,n1)
       yy5=x(2,n3)-x(2,n1)
       zz5=x(3,n3)-x(3,n1)
       xxn=yy4*zz5-zz4*yy5
       yyn=zz4*xx5-xx4*zz5
       zzn=xx4*yy5-yy4*xx5
       al6=sqrt(xxn**2+yyn**2+zzn**2)
       xxn=xxn/max(al6,em20)
       yyn=yyn/max(al6,em20)
       zzn=zzn/max(al6,em20)
C
       xx4=one
       yy4=zero
       zz4=zero
       xx5=zero
       yy5=one
       zz5=zero
       xx6=zero
       yy6=zero
       zz6=one
       ELSE
       xxn=zero
       yyn=zero
       zzn=one
       xx4=one
       yy4=zero
       zz4=zero
       xx5=zero
       yy5=one
       zz5=zero
       xx6=zero
       yy6=zero
       zz6=one
C
      ENDIF
C
C     ORIGIN CALCULATION
C
      IF(ifram==0)THEN
        d13=(xx3-xx1)*xx4+(yy3-yy1)*yy4+(zz3-zz1)*zz4
        xxc=xx1+d13*xx4
        yyc=yy1+d13*yy4
        zzc=zz1+d13*zz4
      ELSEIF(ifram==10)THEN
        x1n=x(1,n2)-x(1,n1)
        y1n=x(2,n2)-x(2,n1)
        z1n=x(3,n2)-x(3,n1)
        al4=sqrt(x1n**2+y1n**2+z1n**2)
        x1n=x1n/max(al4,em20)
        y1n=y1n/max(al4,em20)
        z1n=z1n/max(al4,em20)
        d13=(x(1,n3)-x(1,n1))*x1n
     .     +(x(2,n3)-x(2,n1))*y1n
     .     +(x(3,n3)-x(3,n1))*z1n
        xxc=x(1,n1)+d13*x1n
        yyc=x(2,n1)+d13*y1n
        zzc=x(3,n1)+d13*z1n
      ELSEIF(mod(ifram,10)==1)THEN
        xxc=0.
        yyc=0.
        zzc=0.
C   attention : il faut penser a maj de X avant forint
        DO i=1,nnod
          n=nod(i)
          xxc=xxc+x(1,n)
          yyc=yyc+x(2,n)
          zzc=zzc+x(3,n)
        ENDDO
        xxc=xxc/nnod
        yyc=yyc/nnod
        zzc=zzc/nnod
      ELSEIF(mod(ifram,10)==2)THEN
        xxc=0.
        yyc=0.
        zzc=0.
        mas=1.e-30
C   attention : il faut penser a maj de X & M avant forint
        DO i=1,nnod
          n=nod(i)
          xxc=xxc+x(1,n)*ms(n)
          yyc=yyc+x(2,n)*ms(n)
          zzc=zzc+x(3,n)*ms(n)
          mas=mas+ms(n)
        ENDDO
        xxc=xxc/mas
        yyc=yyc/mas
        zzc=zzc/mas
      ELSEIF(mod(ifram,10)==3)THEN
        xxc=0.
        yyc=0.
        zzc=0.
      ENDIF
C
      RETURN
      END