fvventhole.F File Reference

#include "implicit_f.inc"
#include "param_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	fvventhole (ibuf, elem, ibaghol, nvent, igrsurf, itagel, nn, nel, id, tagvent, titr, eltg, nb_node)

Function/Subroutine Documentation

fvventhole()

subroutine fvventhole	(	integer, dimension(*)	ibuf,
		integer, dimension(3,nel)	elem,
		integer, dimension(nibhol,*)	ibaghol,
		integer	nvent,
		type (surf_), dimension(nsurf)	igrsurf,
		integer, dimension(nel), intent(inout)	itagel,
		integer	nn,
		integer	nel,
		integer	id,
		integer, dimension(nb_node)	tagvent,
		character(len=nchartitle)	titr,
		integer, dimension(nel), intent(in)	eltg,
		integer	nb_node )

Definition at line 32 of file fvventhole.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE groupdef_mod
      USE names_and_titles_mod , ONLY : nchartitle
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      "param_c.inc"
#include      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IBUF(*), ELEM(3,NEL), IBAGHOL(NIBHOL,*), 
     .        NVENT,
     .        NN, NEL, ID, TAGVENT(NB_NODE)
      INTEGER, DIMENSION(NEL), INTENT(INOUT) :: ITAGEL
      INTEGER NB_NODE
      INTEGER, DIMENSION(NEL), INTENT(IN) :: ELTG
      CHARACTER(len=nchartitle) :: TITR
      TYPE (SURF_)   , DIMENSION(NSURF)   :: IGRSURF
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, II, ITABINV(NB_NODE), ITAGVENT(NN),
     .        ISU, NELSU, IEL, NG1, NG2, NG3, NG4, N1, N2, N3, N4,
     .        IVENT, NALL, NN1, NN2, IERROR
      INTEGER K, ITY, KEL, IVENTYP, IERROR1
      CHARACTER*17, CVENTYP
C----------------------------------------------------
C  TAG Vent Holes and Porous Surfaces nodes : TAGVENT
C  Test if the nodes belong to the airbag
C----------------------------------------------------
      DO i=1,nb_node
         itabinv(i)=0
      ENDDO
C
      DO i=1,nn
         ii=ibuf(i)
         itabinv(ii)=i
         itagvent(i)=0
      ENDDO
C     
      DO ivent=1,nvent
         isu=ibaghol(2,ivent)
         IF(isu == 0) cycle
         iventyp=ibaghol(13,ivent)
         IF(iventyp == 0) cventyp='VENT HOLE SURFACE'
         IF(iventyp == 1) cventyp='POROUS SURFACE'
         nelsu=igrsurf(isu)%NSEG
         DO i=1,nelsu
            ng1 = igrsurf(isu)%NODES(i,1)
            ng2 = igrsurf(isu)%NODES(i,2)
            ng3 = igrsurf(isu)%NODES(i,3)
            ng4 = igrsurf(isu)%NODES(i,4)
            n1=itabinv(ng1)
            n2=itabinv(ng2)
            n3=itabinv(ng3)
            n4=itabinv(ng4)
            ierror = 0
            IF(n1==0.AND.tagvent(ng1)==0) THEN
              ierror = 1
            ELSE
              IF (n1 /= 0) itagvent(n1)=ivent
            END IF
            IF(n2==0.AND.tagvent(ng2)==0) THEN
              ierror = 1
            ELSE
              IF (n2 /= 0) itagvent(n2)=ivent
            END IF
            IF(n3==0.AND.tagvent(ng3)==0) THEN
              ierror = 1
            ELSE
              IF (n3 /= 0) itagvent(n3)=ivent
            END IF
            IF(n4==0.AND.tagvent(ng4)==0) THEN
              ierror = 1
            ELSE
              IF (n4 /= 0) itagvent(n4)=ivent
            END IF
         ENDDO
         IF(ierror==1)THEN
            CALL ancmsg(msgid=632,
     .                  msgtype=msgerror,
     .                  anmode=aninfo,
     .                  i1=id,
     .                  c1=titr,
     .                  c2=cventyp,
     .                  i2=igrsurf(isu)%ID)
         ENDIF
      ENDDO
C-----------------------------------------
C  TAG Vent hole and Porous Surface ITAGEL
C-----------------------------------------
      DO ivent=1,nvent
         isu=ibaghol(2,ivent)
         IF(isu == 0) cycle
         iventyp=ibaghol(13,ivent)
         IF(iventyp == 0) cventyp='VENT HOLE     '
         IF(iventyp == 1) cventyp='POROUS SURFACE'
         nelsu=igrsurf(isu)%NSEG
         ierror =0
         ierror1=0
         DO i=1,nelsu
            ity = igrsurf(isu)%ELTYP(i)
            kel = igrsurf(isu)%ELEM(i)
            IF(ity == 7) kel=kel+numelc
            IF(ity == 3 .OR. ity == 7) THEN
              DO iel=1,nel
                 k=eltg(iel)
                 IF(k == kel) THEN
                   IF(itagel(iel) == 0) THEN
C Element IEL belongs to the current vent hole
                     itagel(iel)=-ivent
                   ELSEIF(itagel(iel) > 0) THEN
C Element IEL is an injector
                     ierror=ierror+1
                   ELSEIF(itagel(iel) < 0) THEN
C Element IEL belongs to a previous vent hole
                     ierror1=ierror1+1
                   ENDIF                    
                 ENDIF                 
              ENDDO
            ELSE
              DO iel=1,nel
                 n1=elem(1,iel)
                 n2=elem(2,iel)
                 n3=elem(3,iel)
                 nall=itagvent(n1)*itagvent(n2)*itagvent(n3)
                 IF (nall/=0) THEN
                    nn1=itagvent(n2)-itagvent(n1)
                    nn2=itagvent(n3)-itagvent(n1)
                    IF (nn1 == 0.AND.nn2 == 0) THEN
                      IF(itagel(iel) == 0) THEN
C Element IEL belongs to the current vent hole
                        itagel(iel)=-ivent
                      ELSEIF(itagel(iel) > 0) THEN
C Element IEL is an injector
                        ierror=ierror+1
                      ELSEIF(itagel(iel) < 0) THEN
C Element IEL belongs to a previous vent hole
                        ierror1=ierror1+1
                      ENDIF
                    ENDIF
                 ENDIF 
              ENDDO
            ENDIF
         ENDDO
         IF(ierror  > 0)THEN
            CALL ancmsg(msgid=1045,msgtype=msgwarning,anmode=aninfo,
     .                  i1=id,i2=ierror,c1=titr,c2=cventyp,i3=ivent)
         ENDIF
         IF(ierror1 > 0)THEN
            CALL ancmsg(msgid=1180,msgtype=msgwarning,anmode=aninfo,
     .                  i1=id,i2=ierror1,c1=titr,c2=cventyp,i3=ivent)
         ENDIF
      ENDDO
C
      RETURN