sbilan.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/.
!||====================================================================
!||    sbilan                ../engine/source/elements/solid/solide/sbilan.f
!||--- called by ------------------------------------------------------
!||    s8cforc3              ../engine/source/elements/thickshell/solide8c/s8cforc3.F
!||    s8eforc3              ../engine/source/elements/solid/solide8e/s8eforc3.F
!||    s8sforc3              ../engine/source/elements/solid/solide8s/s8sforc3.F
!||    s8zforc3              ../engine/source/elements/solid/solide8z/s8zforc3.F
!||    sforc3                ../engine/source/elements/solid/solide/sforc3.F
!||--- calls      -----------------------------------------------------
!||    grelem_sav            ../engine/source/output/th/grelem_sav.f
!||    sensor_energy_bilan   ../engine/source/tools/sensor/sensor_energy_bilan.F
!||--- uses       -----------------------------------------------------
!||    sensor_mod            ../common_source/modules/sensor_mod.F90
!||====================================================================
      SUBROUTINE sbilan(PARTSAV,EINT,RHO,RK,VOL,
     .   VX1, VX2, VX3, VX4, VX5, VX6, VX7, VX8,
     .   VY1, VY2, VY3, VY4, VY5, VY6, VY7, VY8,
     .   VZ1, VZ2, VZ3, VZ4, VZ5, VZ6, VZ7, VZ8,
     .   VNEW,IPARTS,GRESAV,GRTH,IGRTH, OFF,
     .   IEXPAN,EINTTH,FILL,MOM,NEL,IFVM22,
     .   X1, X2, X3, X4, X5, X6, X7, X8,
     .   Y1, Y2, Y3, Y4, Y5, Y6, Y7, Y8,
     .   Z1, Z2, Z3, Z4, Z5, Z6, Z7, Z8,
     .   ITASK,IPARG,SENSORS,G_WPLA,WPLA)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE sensor_mod
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      "param_c.inc"
#include      "vect01_c.inc"
#include      "inter22.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      my_real,INTENT(IN) :: mom(nel,3)
      my_real
     .  partsav(npsav,*), eint(nel), rho(nel), rk(nel), vol(nel),
     .  vx1(*), vx2(*), vx3(*), vx4(*), vx5(*), vx6(*), vx7(*), vx8(*),
     .  vy1(*), vy2(*), vy3(*), vy4(*), vy5(*), vy6(*), vy7(*), vy8(*),
     .  vz1(*), vz2(*), vz3(*), vz4(*), vz5(*), vz6(*), vz7(*), vz8(*),
     .  vnew(nel), gresav(*), off(nel), eintth(nel), fill(nel),
     .  x1(*), x2(*), x3(*), x4(*), x5(*), x6(*), x7(*), x8(*),
     .  y1(*), y2(*), y3(*), y4(*), y5(*), y6(*), y7(*), y8(*),
     .  z1(*), z2(*), z3(*), z4(*), z5(*), z6(*), z7(*), z8(*)
      INTEGER, INTENT(IN) :: G_WPLA
      my_real,DIMENSION(NEL*G_WPLA), INTENT(IN) :: WPLA
      INTEGER IEXPAN,ITASK,
     .  IPARTS(*),GRTH(*),IGRTH(*),IPARG(*),NEL
      INTEGER,INTENT(IN) :: IFVM22
      type (sensors_),INTENT(INOUT) :: SENSORS
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, M, FLAG
C     REAL
      my_real
     .   vxa(mvsiz), vya(mvsiz) , vza(mvsiz), 
     .   va2(mvsiz), xmas(mvsiz), 
     .   ei(mvsiz) , ek(mvsiz),
     .   xm(mvsiz) , ym(mvsiz) , zm(mvsiz),
     .   xx(mvsiz) , yy(mvsiz) , zz(mvsiz),
     .   xy(mvsiz) , yz(mvsiz) , zx(mvsiz),
     .   xx2(mvsiz), yy2(mvsiz), zz2(mvsiz),
     .   xcg(mvsiz), ycg(mvsiz), zcg(mvsiz),
     .   xxm(mvsiz), yym(mvsiz), zzm(mvsiz),
     .   ixx(mvsiz), iyy(mvsiz), izz(mvsiz),
     .   ixy(mvsiz), iyz(mvsiz), izx(mvsiz),
     .   rei(mvsiz), rek(mvsiz), off_l(mvsiz)
C-----------------------------------------------
      flag = iparg(80) ! flag for additional outputs
C-----------------------------------------------
C     CALCUL BILAN SORTIES DEF 
C-----------------------------------------------
      !ELEM VELOCITIES
      IF(int22==0 .OR. ifvm22==0)THEN
        !FEM : from nodes
        DO i=1,nel
         vxa(i)=vx1(i)+vx2(i)+vx3(i)+vx4(i)+vx5(i)+vx6(i)+vx7(i)+vx8(i)
         vya(i)=vy1(i)+vy2(i)+vy3(i)+vy4(i)+vy5(i)+vy6(i)+vy7(i)+vy8(i)
         vza(i)=vz1(i)+vz2(i)+vz3(i)+vz4(i)+vz5(i)+vz6(i)+vz7(i)+vz8(i)
         va2(i)=vx1(i)**2+vx2(i)**2+vx3(i)**2+vx4(i)**2
     1         +vx5(i)**2+vx6(i)**2+vx7(i)**2+vx8(i)**2
     2         +vy1(i)**2+vy2(i)**2+vy3(i)**2+vy4(i)**2
     3         +vy5(i)**2+vy6(i)**2+vy7(i)**2+vy8(i)**2
     4         +vz1(i)**2+vz2(i)**2+vz3(i)**2+vz4(i)**2
     5         +vz5(i)**2+vz6(i)**2+vz7(i)**2+vz8(i)**2
        ENDDO
        DO i=1,nel
          vxa(i)=vxa(i)*one_over_8
          vya(i)=vya(i)*one_over_8
          vza(i)=vza(i)*one_over_8
          va2(i)=va2(i)*one_over_8
        ENDDO
      ELSE
        !FVM - from centroid
        DO i=1,nel
          vxa(i)  = mom(i,1)/rho(i)/vol(i)
          vya(i)  = mom(i,2)/rho(i)/vol(i)
          vza(i)  = mom(i,3)/rho(i)/vol(i)
          va2(i)  = (vxa(i)**2 + vya(i)**2 + vza(i)**2)
        ENDDO
      ENDIF
C
      DO i=1,nel
        xmas(i)= fill(i)*rho(i)*vnew(i)
        ei(i)  = fill(i)*eint(i)*vol(i)
        ek(i)  = xmas(i)*va2(i)*half     
        xm(i)  = xmas(i)*vxa(i)
        ym(i)  = xmas(i)*vya(i)
        zm(i)  = xmas(i)*vza(i)
      ENDDO
C
      m=iparts(1)
      IF(ipartsph==0)THEN
        DO i=1,nel
          partsav(1,m)=partsav(1,m) + ei(i)
          partsav(2,m)=partsav(2,m) + ek(i)
          partsav(3,m)=partsav(3,m) + xm(i)
          partsav(4,m)=partsav(4,m) + ym(i)
          partsav(5,m)=partsav(5,m) + zm(i)
          IF (off(i) >= one) partsav(6,m)=partsav(6,m) + xmas(i)
          IF (g_wpla > 0)  partsav(29,m)=partsav(29,m) + wpla(i)
        ENDDO
      ELSE
        DO i=1,nel
          IF(off(i) < one)cycle
            partsav(1,m)=partsav(1,m) + ei(i)
            partsav(2,m)=partsav(2,m) + ek(i)
            partsav(3,m)=partsav(3,m) + xm(i)
            partsav(4,m)=partsav(4,m) + ym(i)
            partsav(5,m)=partsav(5,m) + zm(i)
            partsav(6,m)=partsav(6,m) + xmas(i)
            IF (g_wpla > 0)  partsav(29,m)=partsav(29,m) + wpla(i)
        ENDDO
      END IF
C
C-----------------------------------------------
C     CALCUL BILAN SORTIES ADDITIONNELLES 
C-----------------------------------------------
      IF(flag==1) THEN
        IF(int22==0 .OR. ifvm22==0)THEN
          !FEM : from nodes
          DO i=1,nel
           xx(i)=x1(i)+x2(i)+x3(i)+x4(i)+x5(i)+x6(i)+x7(i)+x8(i)
           yy(i)=y1(i)+y2(i)+y3(i)+y4(i)+y5(i)+y6(i)+y7(i)+y8(i)
           zz(i)=z1(i)+z2(i)+z3(i)+z4(i)+z5(i)+z6(i)+z7(i)+z8(i)
           xx2(i)=x1(i)**2+x2(i)**2+x3(i)**2+x4(i)**2
     .           +x5(i)**2+x6(i)**2+x7(i)**2+x8(i)**2
           yy2(i)=y1(i)**2+y2(i)**2+y3(i)**2+y4(i)**2
     .           +y5(i)**2+y6(i)**2+y7(i)**2+y8(i)**2
           zz2(i)=z1(i)**2+z2(i)**2+z3(i)**2+z4(i)**2
     .           +z5(i)**2+z6(i)**2+z7(i)**2+z8(i)**2
           xy(i)=x1(i)*y1(i)+x2(i)*y2(i)+x3(i)*y3(i)+x4(i)*y4(i)
     .          +x5(i)*y5(i)+x6(i)*y6(i)+x7(i)*y7(i)+x8(i)*y8(i)
           yz(i)=y1(i)*z1(i)+y2(i)*z2(i)+y3(i)*z3(i)+y4(i)*z4(i)
     .          +y5(i)*z5(i)+y6(i)*z6(i)+y7(i)*z7(i)+y8(i)*z8(i)
           zx(i)=z1(i)*x1(i)+z2(i)*x2(i)+z3(i)*x3(i)+z4(i)*x4(i)
     .          +z5(i)*x5(i)+z6(i)*x6(i)+z7(i)*x7(i)+z8(i)*x8(i)
          ENDDO
          DO i=1,nel
            xx(i)=xx(i)*one_over_8
            yy(i)=yy(i)*one_over_8
            zz(i)=zz(i)*one_over_8
            xy(i)=xy(i)*one_over_8
            yz(i)=yz(i)*one_over_8
            zx(i)=zx(i)*one_over_8
            xx2(i)=xx2(i)*one_over_8
            yy2(i)=yy2(i)*one_over_8
            zz2(i)=zz2(i)*one_over_8
          ENDDO
        ELSE
          !FVM - from centroid
          DO i=1,nel
            xx(i)   = x1(i)+x2(i)+x3(i)+x4(i)+x5(i)+x6(i)+x7(i)+x8(i)
            yy(i)   = y1(i)+y2(i)+y3(i)+y4(i)+y5(i)+y6(i)+y7(i)+y8(i)
            zz(i)   = z1(i)+z2(i)+z3(i)+z4(i)+z5(i)+z6(i)+z7(i)+z8(i)
            xx2(i)=x1(i)**2+x2(i)**2+x3(i)**2+x4(i)**2
     .            +x5(i)**2+x6(i)**2+x7(i)**2+x8(i)**2
            yy2(i)=y1(i)**2+y2(i)**2+y3(i)**2+y4(i)**2
     .            +y5(i)**2+y6(i)**2+y7(i)**2+y8(i)**2
            zz2(i)=z1(i)**2+z2(i)**2+z3(i)**2+z4(i)**2
     .            +z5(i)**2+z6(i)**2+z7(i)**2+z8(i)**2
            xy(i)=x1(i)*y1(i)+x2(i)*y2(i)+x3(i)*y3(i)+x4(i)*y4(i)
     .           +x5(i)*y5(i)+x6(i)*y6(i)+x7(i)*y7(i)+x8(i)*y8(i)
            yz(i)=y1(i)*z1(i)+y2(i)*z2(i)+y3(i)*z3(i)+y4(i)*z4(i)
     .           +y5(i)*z5(i)+y6(i)*z6(i)+y7(i)*z7(i)+y8(i)*z8(i)
            zx(i)=z1(i)*x1(i)+z2(i)*x2(i)+z3(i)*x3(i)+z4(i)*x4(i)
     .           +z5(i)*x5(i)+z6(i)*x6(i)+z7(i)*x7(i)+z8(i)*x8(i)
          ENDDO
          DO i=1,nel
            xx(i)=xx(i)*one_over_8
            yy(i)=yy(i)*one_over_8
            zz(i)=zz(i)*one_over_8
            xy(i)=xy(i)*one_over_8
            yz(i)=yz(i)*one_over_8
            zx(i)=zx(i)*one_over_8
            xx2(i)=xx2(i)*one_over_8
            yy2(i)=yy2(i)*one_over_8
            zz2(i)=zz2(i)*one_over_8
          ENDDO
        ENDIF
C
        DO i=1,nel
          xcg(i)= xmas(i)*xx(i)
          ycg(i)= xmas(i)*yy(i)
          zcg(i)= xmas(i)*zz(i)
          ixy(i)= -xmas(i)*xy(i)
          iyz(i)= -xmas(i)*yz(i)
          izx(i)= -xmas(i)*zx(i)
          ixx(i)= xmas(i)*(yy2(i) + zz2(i))
          iyy(i)= xmas(i)*(zz2(i) + xx2(i))
          izz(i)= xmas(i)*(xx2(i) + yy2(i))
          xxm(i)= vza(i)*ycg(i)-vya(i)*zcg(i)
          yym(i)= vxa(i)*zcg(i)-vza(i)*xcg(i)
          zzm(i)= vya(i)*xcg(i)-vxa(i)*ycg(i)
          rei(i)= zero
          rek(i)= zero
        ENDDO
C
        m=iparts(1)
        IF(ipartsph==0)THEN
          DO i=1,nel
            partsav(9,m) =partsav(9,m)  + xcg(i)
            partsav(10,m)=partsav(10,m) + ycg(i)
            partsav(11,m)=partsav(11,m) + zcg(i)
            partsav(12,m)=partsav(12,m) + xxm(i)
            partsav(13,m)=partsav(13,m) + yym(i)
            partsav(14,m)=partsav(14,m) + zzm(i)
            partsav(15,m)=partsav(15,m) + ixx(i)
            partsav(16,m)=partsav(16,m) + iyy(i)
            partsav(17,m)=partsav(17,m) + izz(i)
            partsav(18,m)=partsav(18,m) + ixy(i)
            partsav(19,m)=partsav(19,m) + iyz(i)
            partsav(20,m)=partsav(20,m) + izx(i)
            partsav(21,m)=partsav(21,m) + rei(i)
            partsav(22,m)=partsav(22,m) + rek(i) 
          ENDDO
        ELSE
          DO i=1,nel
            IF(off(i) < one)cycle
              partsav(9,m) =partsav(9,m)  + xcg(i)
              partsav(10,m)=partsav(10,m) + ycg(i)
              partsav(11,m)=partsav(11,m) + zcg(i)
              partsav(12,m)=partsav(12,m) + xxm(i)
              partsav(13,m)=partsav(13,m) + yym(i)
              partsav(14,m)=partsav(14,m) + zzm(i)
              partsav(15,m)=partsav(15,m) + ixx(i)
              partsav(16,m)=partsav(16,m) + iyy(i)
              partsav(17,m)=partsav(17,m) + izz(i)
              partsav(18,m)=partsav(18,m) + ixy(i)
              partsav(19,m)=partsav(19,m) + iyz(i)
              partsav(20,m)=partsav(20,m) + izx(i)
              partsav(21,m)=partsav(21,m) + rei(i)
              partsav(22,m)=partsav(22,m) + rek(i)
          ENDDO
        END IF
      ENDIF
C
C-----------------------------------------------
      IF (igre /= 0) THEN
          CALL grelem_sav(1   ,nel   ,gresav,igrth ,grth  ,
     2                    off   ,ei    ,ek    ,xm    ,ym    ,
     3                    zm    ,xmas  ,xcg   ,ycg   ,zcg   ,
     4                    xxm   ,yym   ,zzm   ,ixx   ,iyy   ,
     5                    izz   ,ixy   ,iyz   ,izx   ,rei   ,
     6                    rek   ,flag  )
      ENDIF
C-----------------------------------------------
C
      IF (jtur /= 0) THEN
        DO i=1,nel
          m=iparts(i)
          partsav(7,m)=partsav(7,m) + rk(i)*vol(i)
        ENDDO
      ENDIF
C
      IF(iexpan/=0)THEN
        DO i=1,nel
         m=iparts(i)
         partsav(27,m)=partsav(27,m) + eintth(i)*vol(i)
        ENDDO
      ENDIF
      DO i=1,nel
          IF(off(i) < one) THEN
            off_l(i) = zero
          ELSE
            off_l(i) = one
          ENDIF
      ENDDO
C
      DO i = 1,nel
        m=iparts(i)
        IF (off(i) < one) THEN 
          partsav(25,m) = partsav(25,m) + one
        ENDIF
      ENDDO
C
      CALL sensor_energy_bilan(1,nel,ei,ek,off_l,iparts,itask,sensors)      
C
C-----------
      RETURN
      END