xcum3.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/.
!||====================================================================
!||    xcum3    ../engine/source/elements/xelem/xcum3.F
!||--- called by ------------------------------------------------------
!||    xforc3   ../engine/source/elements/xelem/xforc3.F
!||====================================================================
      SUBROUTINE xcum3(NX,KXX,IXX,UFORC,USTIFM,
     2                 UVISCM,MS,F,STIFN)
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      "scr23_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NX,KXX(NIXX),IXX(*)
C     REAL
      my_real
     .   uforc(3,*) ,ustifm(*) , uviscm(*),
     .   f(3,*) ,stifn(*),ms(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER K, I1, IADNOD
C     REAL
      my_real
     .       xm, xk, xc, a     
C-----------------------------------------------
      iadnod=kxx(4)
C-----
C     stiffnesses and viscosities applied to each node
C          were returned by user routine.
      DO k=1,nx
       i1=ixx(iadnod+k-1)
       xk=ustifm(k)
       IF (ms(i1)/=zero.AND.xk/=zero) THEN
        xm= ms(i1)
        xc= uviscm(k)
        a = xc/sqrt(four*xk*xm)
        xk= xk/(sqrt(a**2+ one)-a)**2  
       ELSEIF (xk/=zero) THEN
       ELSE
        xc= uviscm(k)
C       XK= 0.5 *XC**2/(2.*MS(I1))
        xk= fourth*xc**2/max(em15,ms(i1))
       ENDIF
       ustifm(k)=xk
      ENDDO
C-----
      DO k=1,nx
       i1=ixx(iadnod+k-1)
       f(1,i1)=f(1,i1)+uforc(1,k)
       f(2,i1)=f(2,i1)+uforc(2,k)
       f(3,i1)=f(3,i1)+uforc(3,k)
       stifn(i1)=stifn(i1)+ustifm(k)
      ENDDO
      RETURN
      END
!||====================================================================
!||    xcum3p   ../engine/source/elements/xelem/xcum3.F
!||--- called by ------------------------------------------------------
!||    xforc3   ../engine/source/elements/xelem/xforc3.F
!||====================================================================
      SUBROUTINE xcum3p(NX,KXX,IXX,UFORC,USTIFM,
     2                  UVISCM,MS,NISKYL,FSKYI,ISKY)
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      "parit_c.inc"
#include      "scr23_c.inc"
#include      "scr18_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NX,KXX(NIXX),IXX(*),NISKYL,ISKY(*)
C     REAL
      my_real
     .   uforc(3,*), ustifm(*), uviscm(*),
     .   ms(*),fskyi(lskyi,nfskyi)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER K, I1, IADNOD
C     REAL
      my_real
     .       xm, xk, xc, a      
C-----------------------------------------------
C     ASSEMBLE
C-------------------------
      iadnod=kxx(4)
      IF(kdtint==0)THEN
C-----
C     total of stiffnesses and viscosities applied to each node
C          were returned by user routine.
      DO k=1,nx
       i1=ixx(iadnod+k-1)
       xk=ustifm(k)
       IF (ms(i1)/=zero.AND.xk/=zero) THEN
        xm= ms(i1)
        xc= uviscm(k)
        a = xc/sqrt(four*xk*xm)
        xk= xk/(sqrt(a**2+ one)-a)**2  
       ELSEIF (xk/=zero) THEN
       ELSE
        xc= uviscm(k)
C       XK= 0.5 *XC**2/(2.*MS(I1))
        xk= fourth*xc**2/max(em15,ms(i1))
       ENDIF
       ustifm(k)=xk
      ENDDO
C-----
C     vecteur skyline necessaire pour rotations.
      DO k=1,nx
       i1=ixx(iadnod+k-1)
       niskyl=niskyl+1
       fskyi(niskyl,1)=uforc(1,k)
       fskyi(niskyl,2)=uforc(2,k)
       fskyi(niskyl,3)=uforc(3,k)
       fskyi(niskyl,4)=ustifm(k)
       isky(niskyl)   =i1
      ENDDO
      ELSE
C-----
C     total of stiffnesses and viscosities applied to each node
C          were returned by user routine.
C     vecteur skyline necessaire pour rotations.
      DO k=1,nx
       i1=ixx(iadnod+k-1)
       niskyl=niskyl+1
       fskyi(niskyl,1)=uforc(1,k)
       fskyi(niskyl,2)=uforc(2,k)
       fskyi(niskyl,3)=uforc(3,k)
C      A = XC/SQRT(2.*XK*XM), XK= XK/(SQRT(A**2+1)-A)**2  
C                          ou XK= 0.5*XC**2/MS(I1)
       fskyi(niskyl,4)=ustifm(k)
       fskyi(niskyl,5)=two*uviscm(k)
       isky(niskyl)   =i1
      ENDDO
      ENDIF
C
      RETURN
      END