amass3p.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/.
 
!||====================================================================
!||    amass3p          ../engine/source/elements/solid/solide/amass3p.f
!||--- called by ------------------------------------------------------
!||    multi_fvm2fem    ../engine/source/multifluid/multi_fvm2fem.F
!||    sforc3           ../engine/source/elements/solid/solide/sforc3.F
!||    szforc3          ../engine/source/elements/solid/solidez/szforc3.F
!||--- uses       -----------------------------------------------------
!||    i22bufbric_mod   ../common_source/modules/interfaces/cut-cell-search_mod.F
!||====================================================================
      SUBROUTINE amass3p(
     1   FSKYM,   RHO,     VOLGP,   TAG22,
     2   VOLU,    IADS,    OFF,     IXS,
     3   NEL,     NFT,     JEUL)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE i22bufbric_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"
#include      "param_c.inc"
#include      "inter22.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) :: JEUL
      my_real
     .   fskym(*), rho(*),volu(*),volgp(lveul,*), off(*),tag22(*)
      INTEGER IADS(8,*),IXS(NIXS,*)
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,IFLAG,II, K, NIN, NCELL, ICELL, IB, J,MCELL
      my_real TNOD(MVSIZ,8)      
      my_real DMASS(MVSIZ),FAC
C-----------------------------------------------
      iflag=integ8*jeul
      nin = 1
      fac = zero
 
      !--------------------------------------------------------------------------!
      ! COMPUTE ELEMENTARY MASS AND ITS DISTRIBUTION ON NODES.                   !
      ! FOR CUT CELL TNOD(1:8,I) ENABLE TO DISTRIBUTE MASS TO RELATED NODES ONLY !
      !--------------------------------------------------------------------------!
      IF(iflag/=1)THEN
        IF(int22==0)THEN  
        !DEFAULT FORMULATION    
         tnod(1:nel,1:8) = one
         DO  i=1,nel
          dmass(i)=one_over_8*rho(i)*volu(i)*off(i)
         ENDDO
         !INTERFACE 22 : CUT CELLS
        ELSE
         DO i=1,nel
          ib = nint(tag22(i))
          IF(ib>0)THEN
            ncell = brick_list(nin,ib)%NBCUT
            IF(ncell==0)THEN
              tnod(i,1:8) = one
              dmass(i)=one_over_8*rho(i)*volu(i)*off(i)
              cycle
            ENDIF
            tnod(i,1:8) = zero
            mcell = brick_list(nin,ib)%mainID
            IF(mcell==0)cycle ! next Main Cell            
            fac = brick_list(nin,ib)%POLY(mcell)%NumNOD
            IF(fac>0)THEN
              fac=one/fac
              DO j=1,8                                                                                        
                icell=brick_list(nin,ib)%NODE(j)%WhichCell                                                    
                IF(icell/=mcell)cycle                                                                         
                tnod(i,j) = one                                              !this node is used by polyhedron  
              ENDDO               
            ELSE
              fac = zero
            ENDIF                                                                                          
          ELSE
            fac = one_over_8 
            tnod(i,1:8) = one                                                !uncut cell distributes centroid mass to all 8 nodes
          ENDIF
          dmass(i)=fac*rho(i)*volu(i)*off(i)
         ENDDO
        ENDIF      
      endif!IFLAG=1
 
 
      
      !---------------------------------------------!
      ! NODAL MASS : ELEMENTARY MASS IS DISTRIBUTED !
      !---------------------------------------------!      
      IF(iflag==1)THEN
       tnod(1:nel,1:8) = one       
       DO  i=1,nel
        dmass(i)=rho(i)*volgp(1,i)*off(i)
       ENDDO
      ENDIF      
      DO i=1,nel
        ii = i +nft
        k = iads(1,ii)
        fskym(k)= tnod(i,1)*dmass(i)                                        !by default all nodes are tagged. For cut cells only nodes defining the polyhedron is tagged
      ENDDO
C
      IF(iflag==1)THEN
       DO  i=1,nel
        dmass(i)=rho(i)*volgp(2,i)*off(i)
       ENDDO
      ENDIF
      DO i=1,nel 
        ii = i +nft
        k = iads(2,ii)
        fskym(k)= tnod(i,2)*dmass(i)
      ENDDO
C
      IF(iflag==1)THEN
       DO  i=1,nel
        dmass(i)=rho(i)*volgp(3,i)*off(i)
       ENDDO
      ENDIF
      DO i=1,nel
        ii = i +nft
        k = iads(3,ii)
        fskym(k)= tnod(i,3)*dmass(i)
      ENDDO
C
      IF(iflag==1)THEN
       DO  i=1,nel
        dmass(i)=rho(i)*volgp(4,i)*off(i)
       ENDDO
      ENDIF
      DO i=1,nel
        ii = i +nft
        k = iads(4,ii)
        fskym(k)= tnod(i,4)*dmass(i)
      ENDDO
C
      IF(iflag==1)THEN
       DO  i=1,nel
        dmass(i)=rho(i)*volgp(5,i)*off(i)
       ENDDO
      ENDIF
      DO i=1,nel
        ii = i +nft
        k = iads(5,ii)
        fskym(k)= tnod(i,5)*dmass(i)
      ENDDO
C
      IF(iflag==1)THEN
       DO  i=1,nel
        dmass(i)=rho(i)*volgp(6,i)*off(i)
       ENDDO
      ENDIF
      DO i=1,nel
        ii = i +nft
        k = iads(6,ii)
        fskym(k)= tnod(i,6)*dmass(i)
      ENDDO
C
      IF(iflag==1)THEN
       DO  i=1,nel
        dmass(i)=rho(i)*volgp(7,i)*off(i)
       ENDDO
      ENDIF
      DO i=1,nel
        ii = i +nft
        k = iads(7,ii)
        fskym(k)= tnod(i,7)*dmass(i)
      ENDDO
C
      IF(iflag==1)THEN
       DO  i=1,nel
        dmass(i)=rho(i)*volgp(8,i)*off(i)
       ENDDO
      ENDIF
      DO i=1,nel
        ii = i +nft
        k = iads(8,ii)
        fskym(k)= tnod(i,8)*dmass(i)
      ENDDO
C
      RETURN
      END