fhvis3.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/.
!||====================================================================
!||    fhvis3    ../engine/source/elements/solid/solide/fhvis3.F
!||--- called by ------------------------------------------------------
!||    sforc3    ../engine/source/elements/solid/solide/sforc3.F
!||--- uses       -----------------------------------------------------
!||    ale_mod   ../common_source/modules/ale/ale_mod.f
!||====================================================================
      SUBROUTINE fhvis3(
     1   PM,      RHO,     OFF,     VX1,
     2   VX2,     VX3,     VX4,     VX5,
     3   VX6,     VX7,     VX8,     VY1,
     4   VY2,     VY3,     VY4,     VY5,
     5   VY6,     VY7,     VY8,     VZ1,
     6   VZ2,     VZ3,     VZ4,     VZ5,
     7   VZ6,     VZ7,     VZ8,     F11,
     8   F21,     F31,     F12,     F22,
     9   F32,     F13,     F23,     F33,
     A   F14,     F24,     F34,     F15,
     B   F25,     F35,     F16,     F26,
     C   F36,     F17,     F27,     F37,
     D   F18,     F28,     F38,     PX1H1,
     E   PX1H2,   PX1H3,   PX2H1,   PX2H2,
     F   PX2H3,   PX3H1,   PX3H2,   PX3H3,
     G   PX4H1,   PX4H2,   PX4H3,   VOL,
     H   MAT,     CXX,     VIS,     VD2,
     I   DELTAX,  EANI,    PID,     GEO,
     J   PARTSAV, IPARTS,  NEL,     NFT,
     K   JLAG,    JHBE)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE ale_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "comlock.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      "com08_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: NEL
      INTEGER, INTENT(IN) :: NFT
      INTEGER, INTENT(IN) :: JLAG
      INTEGER, INTENT(IN) :: JHBE
      INTEGER MAT(*),PID(*),IPARTS(*)
      my_real
     .   PM(NPROPM,*),GEO(NPROPG,*), RHO(*),OFF(*),
     .   VX1(*),VX2(*),VX3(*),VX4(*),VX5(*),VX6(*),VX7(*),VX8(*),
     .   VY1(*),VY2(*),VY3(*),VY4(*),VY5(*),VY6(*),VY7(*),VY8(*),
     .   VZ1(*),VZ2(*),VZ3(*),VZ4(*),VZ5(*),VZ6(*),VZ7(*),VZ8(*),
     .   F11(*),F21(*),F31(*),F12(*),F22(*),F32(*),
     .   F13(*),F23(*),F33(*),F14(*),F24(*),F34(*),
     .   F15(*),F25(*),F35(*),F16(*),F26(*),F36(*),
     .   F17(*),F27(*),F37(*),F18(*),F28(*),F38(*),
     .   PX1H1(*), PX1H2(*), PX1H3(*),  
     .   PX2H1(*), PX2H2(*), PX2H3(*),  
     .   PX3H1(*), PX3H2(*), PX3H3(*),  
     .   PX4H1(*), PX4H2(*), PX4H3(*),EANI(*),PARTSAV(NPSAV,*),
     .   VOL(*),CXX(*),VIS(*),VD2(*),DELTAX(*) 
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, FLUID,MX, J, II, IC, JST(MVSIZ+1)
C     REAL
      my_real
     .   caq(mvsiz), fcl(mvsiz), fcq(mvsiz),ehou(mvsiz),
     .   h11(mvsiz), h12(mvsiz), h13(mvsiz), h14(mvsiz),
     .   h15(mvsiz), h16(mvsiz), h17(mvsiz), h18(mvsiz),
     .   h21(mvsiz), h22(mvsiz), h23(mvsiz), h24(mvsiz),
     .   h25(mvsiz), h26(mvsiz), h27(mvsiz), h28(mvsiz),
     .   h31(mvsiz), h32(mvsiz), h33(mvsiz), h34(mvsiz),
     .   h35(mvsiz), h36(mvsiz), h37(mvsiz), h38(mvsiz),
     .   hx1(mvsiz), hx2(mvsiz), hx3(mvsiz), hx4(mvsiz),
     .   hy1(mvsiz), hy2(mvsiz), hy3(mvsiz), hy4(mvsiz),
     .   hz1(mvsiz), hz2(mvsiz), hz3(mvsiz), hz4(mvsiz),
     .   hgx1(mvsiz), hgx2(mvsiz), hgx3(mvsiz), hgx4(mvsiz),
     .   hgy1(mvsiz), hgy2(mvsiz), hgy3(mvsiz), hgy4(mvsiz),
     .   hgz1(mvsiz), hgz2(mvsiz), hgz3(mvsiz), hgz4(mvsiz),
     .   vx3478(mvsiz), vx2358(mvsiz), vx1467(mvsiz), vx1256(mvsiz), 
     .   vy3478(mvsiz), vy2358(mvsiz), vy1467(mvsiz), vy1256(mvsiz),
     .   vz3478(mvsiz), vz2358(mvsiz), vz1467(mvsiz), vz1256(mvsiz),
     .   g11(mvsiz),g21(mvsiz),g31(mvsiz),g41(mvsiz),
     .   g51(mvsiz),g61(mvsiz),g71(mvsiz),g81(mvsiz),
     .   g12(mvsiz),g22(mvsiz),g32(mvsiz),g42(mvsiz),
     .   g52(mvsiz),g62(mvsiz),g72(mvsiz),g82(mvsiz),
     .   g13(mvsiz),g23(mvsiz),g33(mvsiz),g43(mvsiz),
     .   g53(mvsiz),g63(mvsiz),g73(mvsiz),g83(mvsiz),
     .   len(mvsiz),
     .   ehourt     
C-----------------------------------------------
       DO i=1,nel
          caq(i)=fourth*off(i)*geo(13,pid(i))
       ENDDO
C        
       IF(ale%UPWIND%UPWM > 1 .OR. jlag == 1)THEN
         DO i=1,nel
           IF(vis(i)>zero)THEN
             fcq(i)=zero
             fcl(i)=ten*caq(i)*vis(i)*deltax(i)
           ELSE
             fcq(i)=zero
             fcl(i)=caq(i)*rho(i)*cxx(i)*deltax(i)**2
           ENDIF
         ENDDO
       ELSEIF(ale%UPWIND%UPWM == 0)THEN
          DO i=1,nel
            fcl(i)=caq(i)*rho(i)*cxx(i)*vol(i)**two_third
            fcq(i)=zero
          ENDDO
       ELSEIF(ale%UPWIND%UPWM == 1)THEN
          DO i=1,nel
            fcl(i)=caq(i)*rho(i)*deltax(i)**2
            fcl(i)=min(fcl(i)*cxx(i),
     .       max(ten*caq(i)*vis(i)*deltax(i),fcl(i)*sqrt(vd2(i))))
            fcq(i)=zero
         ENDDO
       ENDIF
C
      IF(jhbe == 0)THEN
       DO i=1,nel
        vx3478(i)=vx3(i)-vx4(i)-vx7(i)+vx8(i)
        vx2358(i)=vx2(i)-vx3(i)-vx5(i)+vx8(i)
        vx1467(i)=vx1(i)-vx4(i)-vx6(i)+vx7(i)
        vx1256(i)=vx1(i)-vx2(i)-vx5(i)+vx6(i)
C
        vy3478(i)=vy3(i)-vy4(i)-vy7(i)+vy8(i)
        vy2358(i)=vy2(i)-vy3(i)-vy5(i)+vy8(i)
        vy1467(i)=vy1(i)-vy4(i)-vy6(i)+vy7(i)
        vy1256(i)=vy1(i)-vy2(i)-vy5(i)+vy6(i)
C
        vz3478(i)=vz3(i)-vz4(i)-vz7(i)+vz8(i)
        vz2358(i)=vz2(i)-vz3(i)-vz5(i)+vz8(i)
        vz1467(i)=vz1(i)-vz4(i)-vz6(i)+vz7(i)
        vz1256(i)=vz1(i)-vz2(i)-vz5(i)+vz6(i)
       ENDDO
C
       DO i=1,nel
        hgx1(i)=vx1467(i)-vx2358(i)
        hgx2(i)=vx1467(i)+vx2358(i)
        hgx3(i)=vx1256(i)-vx3478(i)
        hgx4(i)=vx1256(i)+vx3478(i)
C
        hgy1(i)=vy1467(i)-vy2358(i)
        hgy2(i)=vy1467(i)+vy2358(i)
        hgy3(i)=vy1256(i)-vy3478(i)
        hgy4(i)=vy1256(i)+vy3478(i)
C
        hgz1(i)=vz1467(i)-vz2358(i)
        hgz2(i)=vz1467(i)+vz2358(i)
        hgz3(i)=vz1256(i)-vz3478(i)
        hgz4(i)=vz1256(i)+vz3478(i)
       ENDDO
C
       DO i=1,nel
        hx1(i)=hgx1(i)*(fcl(i)+abs(hgx1(i))*fcq(i))
        hx2(i)=hgx2(i)*(fcl(i)+abs(hgx2(i))*fcq(i))
        hx3(i)=hgx3(i)*(fcl(i)+abs(hgx3(i))*fcq(i))
        hx4(i)=hgx4(i)*(fcl(i)+abs(hgx4(i))*fcq(i))
C
        hy1(i)=hgy1(i)*(fcl(i)+abs(hgy1(i))*fcq(i))
        hy2(i)=hgy2(i)*(fcl(i)+abs(hgy2(i))*fcq(i))
        hy3(i)=hgy3(i)*(fcl(i)+abs(hgy3(i))*fcq(i))
        hy4(i)=hgy4(i)*(fcl(i)+abs(hgy4(i))*fcq(i))
C
        hz1(i)=hgz1(i)*(fcl(i)+abs(hgz1(i))*fcq(i))
        hz2(i)=hgz2(i)*(fcl(i)+abs(hgz2(i))*fcq(i))
        hz3(i)=hgz3(i)*(fcl(i)+abs(hgz3(i))*fcq(i))
        hz4(i)=hgz4(i)*(fcl(i)+abs(hgz4(i))*fcq(i))
       ENDDO
C
       DO  i=1,nel
        f11(i) =-hx1(i)-hx2(i)-hx3(i)-hx4(i)
        f12(i) = hx1(i)-hx2(i)+hx3(i)+hx4(i)
        f13(i) =-hx1(i)+hx2(i)+hx3(i)-hx4(i)
        f14(i) = hx1(i)+hx2(i)-hx3(i)+hx4(i)
        f15(i) =-hx1(i)+hx2(i)+hx3(i)+hx4(i)
        f16(i) = hx1(i)+hx2(i)-hx3(i)-hx4(i)
        f17(i) =-hx1(i)-hx2(i)-hx3(i)+hx4(i)
        f18(i) = hx1(i)-hx2(i)+hx3(i)-hx4(i)
C
        f21(i) =-hy1(i)-hy2(i)-hy3(i)-hy4(i)
        f22(i) = hy1(i)-hy2(i)+hy3(i)+hy4(i)
        f23(i) =-hy1(i)+hy2(i)+hy3(i)-hy4(i)
        f24(i) = hy1(i)+hy2(i)-hy3(i)+hy4(i)
        f25(i) =-hy1(i)+hy2(i)+hy3(i)+hy4(i)
        f26(i) = hy1(i)+hy2(i)-hy3(i)-hy4(i)
        f27(i) =-hy1(i)-hy2(i)-hy3(i)+hy4(i)
        f28(i) = hy1(i)-hy2(i)+hy3(i)-hy4(i)
C
        f31(i) =-hz1(i)-hz2(i)-hz3(i)-hz4(i)
        f32(i) = hz1(i)-hz2(i)+hz3(i)+hz4(i)
        f33(i) =-hz1(i)+hz2(i)+hz3(i)-hz4(i)
        f34(i) = hz1(i)+hz2(i)-hz3(i)+hz4(i)
        f35(i) =-hz1(i)+hz2(i)+hz3(i)+hz4(i)
        f36(i) = hz1(i)+hz2(i)-hz3(i)-hz4(i)
        f37(i) =-hz1(i)-hz2(i)-hz3(i)+hz4(i)
        f38(i) = hz1(i)-hz2(i)+hz3(i)-hz4(i)
       ENDDO
      ELSEIF(jhbe >= 1) THEN
       DO i=1,nel
C 1 -1 1 -1 1 -1 1 -1
        g11(i)= one-px1h1(i)
        g21(i)=-one-px2h1(i)
        g31(i)= one-px3h1(i)
        g41(i)=-one-px4h1(i)
        g51(i)= one+px3h1(i)
        g61(i)=-one+px4h1(i)
        g71(i)= one+px1h1(i)
        g81(i)=-one+px2h1(i)
        hgx1(i)=
     &    g11(i)*vx1(i)+g21(i)*vx2(i)+g31(i)*vx3(i)+g41(i)*vx4(i)
     &   +g51(i)*vx5(i)+g61(i)*vx6(i)+g71(i)*vx7(i)+g81(i)*vx8(i)
        hgy1(i)=
     &    g11(i)*vy1(i)+g21(i)*vy2(i)+g31(i)*vy3(i)+g41(i)*vy4(i)
     &   +g51(i)*vy5(i)+g61(i)*vy6(i)+g71(i)*vy7(i)+g81(i)*vy8(i)
        hgz1(i)=
     &    g11(i)*vz1(i)+g21(i)*vz2(i)+g31(i)*vz3(i)+g41(i)*vz4(i)
     &   +g51(i)*vz5(i)+g61(i)*vz6(i)+g71(i)*vz7(i)+g81(i)*vz8(i)
       ENDDO
C
       DO i=1,nel
C 1 1 -1 -1 -1 -1 1 1
        g12(i)= one-px1h2(i)
        g22(i)= one-px2h2(i)
        g32(i)=-one-px3h2(i)
        g42(i)=-one-px4h2(i)
        g52(i)=-one+px3h2(i)
        g62(i)=-one+px4h2(i)
        g72(i)= one+px1h2(i)
        g82(i)= one+px2h2(i)
        hgx2(i)=
     &   g12(i)*vx1(i)+g22(i)*vx2(i)+g32(i)*vx3(i)+g42(i)*vx4(i)
     &  +g52(i)*vx5(i)+g62(i)*vx6(i)+g72(i)*vx7(i)+g82(i)*vx8(i)
        hgy2(i)=
     &   g12(i)*vy1(i)+g22(i)*vy2(i)+g32(i)*vy3(i)+g42(i)*vy4(i)
     &  +g52(i)*vy5(i)+g62(i)*vy6(i)+g72(i)*vy7(i)+g82(i)*vy8(i)
        hgz2(i)=
     &   g12(i)*vz1(i)+g22(i)*vz2(i)+g32(i)*vz3(i)+g42(i)*vz4(i)
     &  +g52(i)*vz5(i)+g62(i)*vz6(i)+g72(i)*vz7(i)+g82(i)*vz8(i)
       ENDDO
       DO i=1,nel
C 1 -1 -1 1 -1 1 1 -1
        g13(i)= one-px1h3(i)
        g23(i)=-one-px2h3(i)
        g33(i)=-one-px3h3(i)
        g43(i)= one-px4h3(i)
        g53(i)=-one+px3h3(i)
        g63(i)= one+px4h3(i)
        g73(i)= one+px1h3(i)
        g83(i)=-one+px2h3(i)
        hgx3(i)=
     &   g13(i)*vx1(i)+g23(i)*vx2(i)+g33(i)*vx3(i)+g43(i)*vx4(i)
     &  +g53(i)*vx5(i)+g63(i)*vx6(i)+g73(i)*vx7(i)+g83(i)*vx8(i)
        hgy3(i)=
     &   g13(i)*vy1(i)+g23(i)*vy2(i)+g33(i)*vy3(i)+g43(i)*vy4(i)
     &  +g53(i)*vy5(i)+g63(i)*vy6(i)+g73(i)*vy7(i)+g83(i)*vy8(i)
        hgz3(i)=
     &   g13(i)*vz1(i)+g23(i)*vz2(i)+g33(i)*vz3(i)+g43(i)*vz4(i)
     &  +g53(i)*vz5(i)+g63(i)*vz6(i)+g73(i)*vz7(i)+g83(i)*vz8(i)
       ENDDO
C       
       DO i=1,nel
C 1 -1 1 -1 -1 1 -1 1
         hgx4(i)=vx1(i)-vx2(i)+vx3(i)-vx4(i)-vx5(i)+vx6(i)-vx7(i)+vx8(i)
         hgy4(i)=vy1(i)-vy2(i)+vy3(i)-vy4(i)-vy5(i)+vy6(i)-vy7(i)+vy8(i)
         hgz4(i)=vz1(i)-vz2(i)+vz3(i)-vz4(i)-vz5(i)+vz6(i)-vz7(i)+vz8(i)
       ENDDO
C
       DO i=1,nel
        hx1(i)=hgx1(i)*(fcl(i)+abs(hgx1(i))*fcq(i))
        hx2(i)=hgx2(i)*(fcl(i)+abs(hgx2(i))*fcq(i))
        hx3(i)=hgx3(i)*(fcl(i)+abs(hgx3(i))*fcq(i))
        hx4(i)=hgx4(i)*(fcl(i)+abs(hgx4(i))*fcq(i))
C
        hy1(i)=hgy1(i)*(fcl(i)+abs(hgy1(i))*fcq(i))
        hy2(i)=hgy2(i)*(fcl(i)+abs(hgy2(i))*fcq(i))
        hy3(i)=hgy3(i)*(fcl(i)+abs(hgy3(i))*fcq(i))
        hy4(i)=hgy4(i)*(fcl(i)+abs(hgy4(i))*fcq(i))
C
        hz1(i)=hgz1(i)*(fcl(i)+abs(hgz1(i))*fcq(i))
        hz2(i)=hgz2(i)*(fcl(i)+abs(hgz2(i))*fcq(i))
        hz3(i)=hgz3(i)*(fcl(i)+abs(hgz3(i))*fcq(i))
        hz4(i)=hgz4(i)*(fcl(i)+abs(hgz4(i))*fcq(i))
       ENDDO
C
       DO i=1,nel
        f11(i) =-g11(i)*hx1(i)-g12(i)*hx2(i)-g13(i)*hx3(i)-hx4(i)
        f12(i) =-g21(i)*hx1(i)-g22(i)*hx2(i)-g23(i)*hx3(i)+hx4(i)
        f13(i) =-g31(i)*hx1(i)-g32(i)*hx2(i)-g33(i)*hx3(i)-hx4(i)
        f14(i) =-g41(i)*hx1(i)-g42(i)*hx2(i)-g43(i)*hx3(i)+hx4(i)
        f15(i) =-g51(i)*hx1(i)-g52(i)*hx2(i)-g53(i)*hx3(i)+hx4(i)
        f16(i) =-g61(i)*hx1(i)-g62(i)*hx2(i)-g63(i)*hx3(i)-hx4(i)
        f17(i) =-g71(i)*hx1(i)-g72(i)*hx2(i)-g73(i)*hx3(i)+hx4(i)
        f18(i) =-g81(i)*hx1(i)-g82(i)*hx2(i)-g83(i)*hx3(i)-hx4(i)
C
        f21(i) =-g11(i)*hy1(i)-g12(i)*hy2(i)-g13(i)*hy3(i)-hy4(i)
        f22(i) =-g21(i)*hy1(i)-g22(i)*hy2(i)-g23(i)*hy3(i)+hy4(i)
        f23(i) =-g31(i)*hy1(i)-g32(i)*hy2(i)-g33(i)*hy3(i)-hy4(i)
        f24(i) =-g41(i)*hy1(i)-g42(i)*hy2(i)-g43(i)*hy3(i)+hy4(i)
        f25(i) =-g51(i)*hy1(i)-g52(i)*hy2(i)-g53(i)*hy3(i)+hy4(i)
        f26(i) =-g61(i)*hy1(i)-g62(i)*hy2(i)-g63(i)*hy3(i)-hy4(i)
        f27(i) =-g71(i)*hy1(i)-g72(i)*hy2(i)-g73(i)*hy3(i)+hy4(i)
        f28(i) =-g81(i)*hy1(i)-g82(i)*hy2(i)-g83(i)*hy3(i)-hy4(i)
C
        f31(i) =-g11(i)*hz1(i)-g12(i)*hz2(i)-g13(i)*hz3(i)-hz4(i)
        f32(i) =-g21(i)*hz1(i)-g22(i)*hz2(i)-g23(i)*hz3(i)+hz4(i)
        f33(i) =-g31(i)*hz1(i)-g32(i)*hz2(i)-g33(i)*hz3(i)-hz4(i)
        f34(i) =-g41(i)*hz1(i)-g42(i)*hz2(i)-g43(i)*hz3(i)+hz4(i)
        f35(i) =-g51(i)*hz1(i)-g52(i)*hz2(i)-g53(i)*hz3(i)+hz4(i)
        f36(i) =-g61(i)*hz1(i)-g62(i)*hz2(i)-g63(i)*hz3(i)-hz4(i)
        f37(i) =-g71(i)*hz1(i)-g72(i)*hz2(i)-g73(i)*hz3(i)+hz4(i)
        f38(i) =-g81(i)*hz1(i)-g82(i)*hz2(i)-g83(i)*hz3(i)-hz4(i)
       ENDDO
      ENDIF
C
      ehourt = zero
c 
      DO i=1,nel
        ehou(i)= dt1*(
     &   hz1(i)*hgz1(i) + hz2(i)*hgz2(i) + 
     &   hz3(i)*hgz3(i) + hz4(i)*hgz4(i) + 
     &   hx1(i)*hgx1(i) + hx2(i)*hgx2(i) + 
     &   hx3(i)*hgx3(i) + hx4(i)*hgx4(i) + 
     &   hy1(i)*hgy1(i) + hy2(i)*hgy2(i) + 
     &   hy3(i)*hgy3(i) + hy4(i)*hgy4(i) ) 
        ehourt= ehourt+ehou(i)
      ENDDO   
C a voir plus tard 
C FP 12/97
C DANS LE CAS ALE ET EULERIEN, LE TRANSPORT DE l'ENERGIE d'HOURGLAS
C N'EST PAS CALCULE, L'ENERGIE d'HOURGLASS CUMULE N'A PAS DE SENS
C
c      IF(JLAG==1)THEN
C
c        IF (IVECTOR==0) THEN
c          DO I=1,NEL
c            MX = IPARTS(I)
c            PARTSAV(8,MX)=PARTSAV(8,MX) + EHOU(I)
c          ENDDO
c        ELSE
c          IC=1
c          JST(IC)=1
c          DO J=1+1,NEL
c            IF (IPARTS(J)/=IPARTS(J-1)) THEN
c              IC=IC+1
c              JST(IC)=J
c            ENDIF
c          ENDDO
c          JST(IC+1)=NEL+1                 
c          DO II=1,IC
c            MX=IPARTS(JST(II))
c            IF (JST(II+1)-JST(II)>15) THEN
c              DO J=JST(II),JST(II+1)-1
c                PARTSAV(8,MX)=PARTSAV(8,MX) + EHOU(J)
c              ENDDO
c            ELSE
c#include "vectorize.inc"
c              DO J=JST(II),JST(II+1)-1
c                PARTSAV(8,MX)=PARTSAV(8,MX) + EHOU(J)
c              ENDDO
c            ENDIF
c          ENDDO
c        ENDIF
C !$OMP ATOMIC
c          EHOUR = EHOUR + EHOURT
c      ENDIF
cC
c       IF((ANIM_E(25)==1).OR.(OUTP_CS(25)==1))THEN
c        DO I=1,NEL
c          EANI(NFT+I) = EANI(NFT+I)+EHOU(I)/MAX(EM30,RHO(I)*VOL(I))
c        ENDDO
c      ENDIF
C
      RETURN
      END