r2r_clean_inter.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	r2r_clean_inter (ipari2, intbuf_tab, ipartc, ipartg, iparts, isolnod)

Function/Subroutine Documentation

r2r_clean_inter()

subroutine r2r_clean_inter	(	integer, dimension(npari,*)	ipari2,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer, dimension(*)	ipartc,
		integer, dimension(*)	ipartg,
		integer, dimension(*)	iparts,
		integer, dimension(*)	isolnod )

Definition at line 33 of file r2r_clean_inter.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE restmod
        USE r2r_mod
        USE intbufdef_mod
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      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER IPARI2(NPARI,*),IPARTC(*),IPARTG(*),IPARTS(*),ISOLNOD(*)
        TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER NI,J,NTYP,CUR_ID,NSN,NRTM,NRTS
        INTEGER ELTAG,FACE(4)
C-----------------------------------------------
 
        DO ni=1,ninter
          ntyp = ipari2(7,ni)
          IF ((ntyp==7).OR.(ntyp==18).OR.(ntyp==10).OR.(ntyp==24)) THEN
            nsn   =ipari2(5,ni)
            nrts  =ipari2(3,ni)
            nrtm  =ipari2(4,ni)
C------------------------>   check of secondary nodes  <----------C
            DO j=1,nsn
              cur_id = intbuf_tab(ni)%NSV(j)
              IF ((tagno(cur_id+npart)==2).AND.(tagno(cur_id+npart+numnod)==-1)) THEN
                intbuf_tab(ni)%STFNS(j) = zero
              ENDIF
            ENDDO
 
C------------------------>   check of main elements <--------------C
            DO j=1,nrtm
              face(1) = intbuf_tab(ni)%IRECTM(4*(j-1)+1)
              face(2) = intbuf_tab(ni)%IRECTM(4*(j-1)+2)
              face(3) = intbuf_tab(ni)%IRECTM(4*(j-1)+3)
              face(4) = intbuf_tab(ni)%IRECTM(4*(j-1)+4)
              IF (face(4)==0) face(4)=face(3)
              CALL r2r_check_seg(eltag,face,ipartc,ipartg,iparts,isolnod)
              IF (eltag==0) intbuf_tab(ni)%STFM(j) = zero
            ENDDO
 
          ENDIF
        END DO
 
C-----------
 
        RETURN