fvbric2.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/.
!||====================================================================
!||    fvbric2_mod   ../starter/source/airbag/fvbric2.F
!||--- called by ------------------------------------------------------
!||    init_monvol   ../starter/source/airbag/init_monvol.F
!||====================================================================
      MODULE fvbric2_mod
      CONTAINS
!||====================================================================
!||    fvbric2       ../starter/source/airbag/fvbric2.F
!||--- called by ------------------------------------------------------
!||    init_monvol   ../starter/source/airbag/init_monvol.F
!||--- uses       -----------------------------------------------------
!||====================================================================
      SUBROUTINE fvbric2(ELEM  , IXS , NEL    , NBRIC,
     .                   TBRIC , TFAC, TAGELS , NELA ,
     .                   IBUFA , NNA , ELEMA  ,
     .                   TAGELA, BRNA, NB_NODE)
      use element_mod , only : nixs      
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ELEM(3,*), IXS(NIXS,*), NEL, NBRIC,NELA, NNA, ELEMA(3,*), TAGELA(*), BRNA(8,*), NB_NODE
      INTEGER, DIMENSION(NNA), INTENT(IN) :: IBUFA
      INTEGER, DIMENSION(NEL), INTENT(IN) :: TAGELS
      INTEGER, DIMENSION(2, NBRIC), INTENT(IN) :: TBRIC
      INTEGER, DIMENSION(12, NBRIC), INTENT(IN) :: TFAC
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, II, ITABINV(NB_NODE), NFAC, J, KK, JJ
      INTEGER FAC4(3,4), FAC8(4,6), FAC6(4,5), NOD6(5)
      INTEGER FAC5(4,5), NOD5(5), NFACE(4), NTYPE
      DATA fac4 /1,5,3,
     .           3,5,6,
     .           6,5,1,
     .           1,3,6/
      DATA fac8 /1,4,3,2,
     .           5,6,7,8,
     .           1,2,6,5,
     .           2,3,7,6,
     .           3,4,8,7,
     .           4,1,5,8/
      DATA fac6 /1,3,2,0,
     .           5,6,7,0,
     .           1,2,6,5,
     .           2,3,7,6,
     .           3,4,8,7/
      DATA nod6 /3,3,4,4,4/
      DATA fac5 /2,1,5,0,
     .           3,2,5,0,
     .           3,5,4,0,
     .           1,4,5,0,
     .           1,4,3,2/
      DATA nod5 /3,3,3,3,4/
      DATA nface/6,4,5,5/
C
      nela=0
      DO i=1,nel
         IF (tagels(i)==0) THEN
            nela=nela+1
            tagela(nela)=i
            elema(1,nela)=elem(1,i)
            elema(2,nela)=elem(2,i)
            elema(3,nela)=elem(3,i)
         ENDIF
      ENDDO 
      DO i=1,nna
         ii=ibufa(i)
         itabinv(ii)=i
      ENDDO
C
      DO i=1,nbric
         ii=tbric(1,i)
         ntype=tbric(2,i)
         nfac=nface(ntype)
         DO j=1,nfac
            IF (tfac(2*(j-1)+1,i)==3) THEN
C The solid facet is free inside the airbag
               IF (ntype==2) THEN
                  nela=nela+1
                  kk=fac4(1,j)
                  kk=itabinv(ixs(1+kk,ii))
                  elema(1,nela)=kk
                  kk=fac4(2,j)
                  kk=itabinv(ixs(1+kk,ii))
                  elema(3,nela)=kk
                  kk=fac4(3,j)
                  kk=itabinv(ixs(1+kk,ii))
                  elema(2,nela)=kk
                  tagela(nela)=-i
               ELSEIF (ntype==3) THEN
                  nela=nela+1
                  kk=fac6(1,j)
                  kk=itabinv(ixs(1+kk,ii))
                  elema(1,nela)=kk
                  kk=fac6(2,j)
                  kk=itabinv(ixs(1+kk,ii))
                  elema(3,nela)=kk
                  kk=fac6(3,j)
                  kk=itabinv(ixs(1+kk,ii))
                  elema(2,nela)=kk
                  tagela(nela)=-i
C
                  IF(nod6(j)==4) THEN
                     nela=nela+1
                     kk=fac6(1,j)
                     kk=itabinv(ixs(1+kk,ii))
                     elema(1,nela)=kk
                     kk=fac6(3,j)
                     kk=itabinv(ixs(1+kk,ii))
                     elema(3,nela)=kk
                     kk=fac6(4,j)
                     kk=itabinv(ixs(1+kk,ii))
                     elema(2,nela)=kk
                     tagela(nela)=-i
                  ENDIF
               ELSEIF (ntype==4) THEN
                  nela=nela+1
                  kk=fac5(1,j)
                  kk=itabinv(ixs(1+kk,ii))
                  elema(1,nela)=kk
                  kk=fac5(2,j)
                  kk=itabinv(ixs(1+kk,ii))
                  elema(3,nela)=kk
                  kk=fac5(3,j)
                  kk=itabinv(ixs(1+kk,ii))
                  elema(2,nela)=kk
                  tagela(nela)=-i
C
                  IF(nod5(j)==4) THEN
                     nela=nela+1
                     kk=fac5(1,j)
                     kk=itabinv(ixs(1+kk,ii))
                     elema(1,nela)=kk
                     kk=fac5(3,j)
                     kk=itabinv(ixs(1+kk,ii))
                     elema(3,nela)=kk
                     kk=fac5(4,j)
                     kk=itabinv(ixs(1+kk,ii))
                     elema(2,nela)=kk
                     tagela(nela)=-i
                  ENDIF
               ELSEIF (ntype==1) THEN
                  nela=nela+1
                  kk=fac8(1,j)
                  kk=itabinv(ixs(1+kk,ii))
                  elema(1,nela)=kk
                  kk=fac8(2,j)
                  kk=itabinv(ixs(1+kk,ii))
                  elema(3,nela)=kk
                  kk=fac8(3,j)
                  kk=itabinv(ixs(1+kk,ii))
                  elema(2,nela)=kk
                  tagela(nela)=-i
C
                  nela=nela+1
                  kk=fac8(1,j)
                  kk=itabinv(ixs(1+kk,ii))
                  elema(1,nela)=kk
                  kk=fac8(3,j)
                  kk=itabinv(ixs(1+kk,ii))
                  elema(3,nela)=kk
                  kk=fac8(4,j)
                  kk=itabinv(ixs(1+kk,ii))
                  elema(2,nela)=kk
                  tagela(nela)=-i
               ENDIF
            ENDIF
         ENDDO
C
         DO j=1,8
            jj=ixs(1+j,ii)
            brna(j,i)=itabinv(jj)
         ENDDO
      ENDDO
C
      RETURN
      END SUBROUTINE fvbric2
      END MODULE fvbric2_mod