fxbelnum.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	fxbelnum (fxbnod, nsn, iparg, itag, fxbelm, ixs, ixc, ixtg, iparts, ipartc, iparttg, ixt, ixp, ipartt, ipartp)

Function/Subroutine Documentation

fxbelnum()

subroutine fxbelnum	(	integer, dimension(*)	fxbnod,
		integer	nsn,
		integer, dimension(nparg,*)	iparg,
		integer, dimension(*)	itag,
		integer, dimension(*)	fxbelm,
		integer, dimension(nixs,*)	ixs,
		integer, dimension(nixc,*)	ixc,
		integer, dimension(nixtg,*)	ixtg,
		integer, dimension(*)	iparts,
		integer, dimension(*)	ipartc,
		integer, dimension(*)	iparttg,
		integer, dimension(nixt,*)	ixt,
		integer, dimension(nixp,*)	ixp,
		integer, dimension(*)	ipartt,
		integer, dimension(*)	ipartp )

Definition at line 29 of file fxbelnum.F.

      use element_mod , only : nixs,nixc,nixtg,nixt,nixp
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      "com01_c.inc"
#include      "com04_c.inc"
#include      "scr01_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER FXBNOD(*), NSN, IPARG(NPARG,*), ITAG(*), FXBELM(*),
     .        IXS(NIXS,*), IXC(NIXC,*), IXTG(NIXTG,*), IPARTS(*),
     .        IPARTC(*), IPARTTG(*), IXT(NIXT,*), IXP(NIXP,*),
     .        IPARTT(*), IPARTP(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,NG,NEL,NFT,ITY,II,NALL,NEL2,J,IAD,MAT,JHBE,IT1,IT2,IT3,IT4,IT5,IT6,IT7,IT8
C=======================================================================
      DO i=1,numnod
         itag(i)=0
      ENDDO
      DO i=1,nsn
         itag(abs(fxbnod(i)))=i
      ENDDO
      nel2=0
C
      DO ng=1,ngroup
       nel=iparg(2,ng)
       nft=iparg(3,ng)
       iad=iparg(4,ng)
       ity=iparg(5,ng)
       jhbe=iparg(23,ng)
C     1. Solid elements
       IF(ity == 1)THEN
        DO i=1,nel
         ii=i+nft
         it1=min(1,itag(ixs(2,ii)))
         it2=min(1,itag(ixs(3,ii)))
         it3=min(1,itag(ixs(4,ii)))
         it4=min(1,itag(ixs(5,ii)))
         it5=min(1,itag(ixs(6,ii)))
         it6=min(1,itag(ixs(7,ii)))
         it7=min(1,itag(ixs(8,ii)))
         it8=min(1,itag(ixs(9,ii)))
         nall = it1 * it2 * it3 * it4 * it5 * it6 * it7 * it8 
         IF (nall>0) THEN
            mat=ixs(1,ii)
            fxbelm(nel2+1)=ng
            fxbelm(nel2+2)=i
            DO j=1,8
               fxbelm(nel2+2+j)=itag(ixs(1+j,ii))
            ENDDO
            fxbelm(nel2+13)=iparts(ii)
            nel2=nel2+13
         ENDIF
        ENDDO
C     3. 4-nodes shell elements
       ELSEIF(ity == 3)THEN
        DO i=1,nel
         ii=i+nft
         it1=min(1,itag(ixc(2,ii)))
         it2=min(1,itag(ixc(3,ii)))
         it3=min(1,itag(ixc(4,ii)))
         it4=min(1,itag(ixc(5,ii)))
         nall = it1 * it2 * it3 * it4
         IF (nall>0) THEN
            fxbelm(nel2+1)=ng
            fxbelm(nel2+2)=i
            DO j=1,4
               fxbelm(nel2+2+j)=itag(ixc(1+j,ii))
            ENDDO
            fxbelm(nel2+10)=ipartc(ii)
            nel2=nel2+10
         ENDIF
        ENDDO
C     4. Truss elements
       ELSEIF (ity == 4) THEN
        DO i=1,nel
         ii=i+nft
         it1=min(1,itag(ixt(2,ii)))
         it2=min(1,itag(ixt(3,ii)))
         nall = it1 * it2
         IF (nall>0) THEN
            nb1=iad
            nb2=nb1+nel
            fxbelm(nel2+1)=ng
            fxbelm(nel2+2)=i
            DO j=1,2
               fxbelm(nel2+2+j)=itag(ixt(1+j,ii))
            ENDDO
            fxbelm(nel2+5)=nb1+i-1
            fxbelm(nel2+6)=nb2+i-1
            fxbelm(nel2+7)=ipartt(ii)
            nel2=nel2+7
         ENDIF
        ENDDO
C     5. Beam elements
       ELSEIF (ity == 5) THEN
        DO i=1,nel
         ii=i+nft
         it1=min(1,itag(ixp(2,ii)))
         it2=min(1,itag(ixp(3,ii)))
         nall = it1 * it2
         IF (nall>0) THEN
            nb1=iad
            nb2=nb1+nel
            nb3=nb2+nel*3
            nb4=nb3+nel*3
            nb5=nb4+nel*2
            nb6=nb5+nel
            nb7=nb6+nel*3
            fxbelm(nel2+1)=ng
            fxbelm(nel2+2)=i
            DO j=1,3
               fxbelm(nel2+2+j)=itag(ixp(1+j,ii))
            ENDDO
            fxbelm(nel2+6)=nb2+3*(i-1)
            fxbelm(nel2+7)=nb3+3*(i-1)
            fxbelm(nel2+8)=nb4+2*(i-1)
            fxbelm(nel2+9)=ipartp(ii)
            nel2=nel2+9
         ENDIF
        ENDDO
C     7. 3-nodes shell elements
       ELSEIF(ity == 7)THEN
        DO i=1,nel
         ii=i+nft
         it1=min(1,itag(ixtg(2,ii)))
         it2=min(1,itag(ixtg(3,ii)))
         it3=min(1,itag(ixtg(4,ii)))
         nall = it1 * it2 * it3
         IF (nall>0) THEN
            fxbelm(nel2+1)=ng
            fxbelm(nel2+2)=i
            DO j=1,3
               fxbelm(nel2+2+j)=itag(ixtg(1+j,ii))
            ENDDO
            fxbelm(nel2+9)=iparttg(ii)
            nel2=nel2+9
         ENDIF
        ENDDO
       ENDIF
      ENDDO
C-----------
      RETURN