xbilan3.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/.
!||====================================================================
!||    xbilan3   ../engine/source/elements/xelem/xbilan3.F
!||--- called by ------------------------------------------------------
!||    xforc3    ../engine/source/elements/xelem/xforc3.F
!||====================================================================
      SUBROUTINE xbilan3(
     1   NX,      KXX,     IXX,     X,
     2   V,       VR,      UMASS,   UINER,
     3   FORC,    TORQ,    KEUSR,   EUSR,
     4   EINT,    PARTSAV, IPART,   GRESAV,
     5   GRTH,    IGRTH,   IGRE)
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      "com08_c.inc"
#include      "param_c.inc"
#include      "scr23_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: IGRE
      INTEGER KXX(NIXX),IXX(*),NX,KEUSR,IPART,GRTH(*),IGRTH(*)
C     REAL
      my_real
     .   X(3,*),V(3,*),VR(3,*),UMASS(*), UINER(*),FORC(3,*),
     .   torq(3,*),eusr,eint,partsav(npsav,*),gresav(npsav,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, K, IP, I1, IADNOD,J
C     REAL
      my_real
     .   EMS, XI
C--------------------------------------------
      iadnod=kxx(4)
      IF (keusr==0) THEN
       DO k=1,nx
        i1 = ixx(iadnod+k-1)
        ems=umass(k)
        xi =uiner(k)
C       ENERGY has not been provided by user routine.
C       Integration en rectangle ..
        eint = eint
     .   -dt1*(v(1,i1)*forc(1,k)+v(2,i1)*forc(2,k)+v(3,i1)*forc(3,k)
     .     +vr(1,i1)*torq(1,k)+vr(2,i1)*torq(2,k)+vr(3,i1)*torq(3,k))
        ip=ipart
        partsav(2,ip)=partsav(2,ip) + half * ems *
     .     (v(1,i1)*v(1,i1)+v(2,i1)*v(2,i1)+v(3,i1)*v(3,i1))
        partsav(3,ip)=partsav(3,ip) + ems*v(1,i1)
        partsav(4,ip)=partsav(4,ip) + ems*v(2,i1)
        partsav(5,ip)=partsav(5,ip) + ems*v(3,i1)
        partsav(6,ip)=partsav(6,ip) + ems
        partsav(7,ip)=partsav(7,ip) + half * xi *
     .     (vr(1,i1)*vr(1,i1)+vr(2,i1)*vr(2,i1)+vr(3,i1)*vr(3,i1))
       ENDDO
       IF (igre /= 0) THEN
         IF (igrth(1) /= igrth(2)) THEN
           DO j = igrth(1),igrth(2)-1
             gresav(1,grth(j)) = gresav(1,grth(j)) + eint
             gresav(2,grth(j)) = gresav(2,grth(j)) + half * ems *
     .     (v(1,i1)*v(1,i1)+v(2,i1)*v(2,i1)+v(3,i1)*v(3,i1))
             gresav(3,grth(j)) = gresav(3,grth(j)) + ems*v(1,i1)
             gresav(4,grth(j)) = gresav(4,grth(j)) + ems*v(2,i1)
             gresav(5,grth(j)) = gresav(5,grth(j)) + ems*v(3,i1)
             gresav(6,grth(j)) = gresav(6,grth(j)) + ems
           ENDDO
         ENDIF
       ENDIF
      ELSE
       DO k=1,nx
        i1 = ixx(iadnod+k-1)
        ems=umass(k)
        xi =uiner(k)
        ip=ipart
        partsav(2,ip)=partsav(2,ip) + half * ems *
     .     (v(1,i1)*v(1,i1)+v(2,i1)*v(2,i1)+v(3,i1)*v(3,i1))
        partsav(3,ip)=partsav(3,ip) + ems*v(1,i1)
        partsav(4,ip)=partsav(4,ip) + ems*v(2,i1)
        partsav(5,ip)=partsav(5,ip) + ems*v(3,i1)
        partsav(6,ip)=partsav(6,ip) + ems
        partsav(7,ip)=partsav(7,ip) + half * xi *
     .     (vr(1,i1)*vr(1,i1)+vr(2,i1)*vr(2,i1)+vr(3,i1)*vr(3,i1))
       ENDDO
       IF (igre /= 0) THEN
         IF (igrth(1) /= igrth(2)) THEN
           DO j = igrth(1),igrth(2)-1
             gresav(1,grth(j)) = gresav(1,grth(j)) + eint
             gresav(2,grth(j)) = gresav(2,grth(j)) + half * ems *
     .     (v(1,i1)*v(1,i1)+v(2,i1)*v(2,i1)+v(3,i1)*v(3,i1))
             gresav(3,grth(j)) = gresav(3,grth(j)) + ems*v(1,i1)
             gresav(4,grth(j)) = gresav(4,grth(j)) + ems*v(2,i1)
             gresav(5,grth(j)) = gresav(5,grth(j)) + ems*v(3,i1)
             gresav(6,grth(j)) = gresav(6,grth(j)) + ems
           ENDDO
         ENDIF
       ENDIF
       eint=eusr
      ENDIF
      partsav(1,ip)=partsav(1,ip) + eint
C
      RETURN
      END