delnumbc_ply.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	delnumbc_ply (iply, nel_ply, iparg, ixc, ixtg, invert, el2fa, nbf, inum, nelcut, dd_iad, iadd, nbf_l, nbpart, iadg, nodglob, idcmax, nbf_pxfemg)

Function/Subroutine Documentation

delnumbc_ply()

subroutine delnumbc_ply	(	integer	iply,
		integer	nel_ply,
		integer, dimension(nparg,*)	iparg,
		integer, dimension(nixc,*)	ixc,
		integer, dimension(nixtg,*)	ixtg,
		integer, dimension(*)	invert,
		integer, dimension(*)	el2fa,
		integer	nbf,
		integer, dimension(*)	inum,
		integer	nelcut,
		integer, dimension(nspmd+1,*)	dd_iad,
		integer, dimension(*)	iadd,
		integer	nbf_l,
		integer	nbpart,
		integer, dimension(nspmd,*)	iadg,
		integer, dimension(*)	nodglob,
		integer	idcmax,
		integer	nbf_pxfemg )

Definition at line 35 of file delnumbc_ply.F.

      USE plyxfem_mod
      use element_mod , only : nixc,nixtg
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
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
#include      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IXC(NIXC,*),IXTG(NIXTG,*),IPARG(NPARG,*),
     .         EL2FA(*),INUM(*),
     .        INVERT(*), NBF,NELCUT,NBPART,IADG(NSPMD,*)
      INTEGER DD_IAD(NSPMD+1,*), IADD(*), NBF_L,IPLY,
     .        NEL_PLY,NBF_PXFEMG,NODGLOB(*)
C-----------------------------------------------
C     REAL
      INTEGER II, NG, ITY, LFT, LLT, N, I, 
     . NEL, IAD, NFT,
     . IDCMAX,ISHPLYXFEM,IDPLY,
     .        IPT,ELC,PLYELEMS(NUMELC),PLYS,RBUF,NELCOUNT,ELEM
      INTEGER GET_PLY_ELEM
      EXTERNAL get_ply_elem
C-----------------------------------------------
      nelcount = 0
      DO plys = 1,nplypart
         iply = indx_ply(plys)
 
         plyelems=0
         DO i=1,plyshell(iply)%PLYNUMSHELL
           ipt = plyshell(iply)%SHELLIPT(i)
           elc = plyshell(iply)%SHID(i)
           plyelems(elc)=ipt
         ENDDO
C
        idply  = idcmax + nel_ply
        ii = 0
        DO 490 ng=1,ngroup
          nel   =iparg(2,ng)
          nft   =iparg(3,ng)
          iad   =iparg(4,ng)
          ity   =iparg(5,ng)
          ishplyxfem  = iparg(50,ng)
          lft=1
          llt=nel
C-----------------------------------------------
C       QUAD
C-----------------------------------------------
          IF(ishplyxfem > 0) THEN
C-----------------------------------------------
C       SHELLS
C-----------------------------------------------
            IF(ity==3)THEN
              DO i=lft,llt
                n = i + nft
                IF(plyelems(n) > 0) THEN
                  ii = ii + 1
                    elem = get_ply_elem(iply,n)
                    inum(el2fa(nel_ply + ii)) =
     *                             plyshell(iply)%SHELLID(elem)
                ENDIF
              ENDDO
C-----------------------------------------------
C       3-NODE SHELLS
C-----------------------------------------------
            ELSEIF(ity==7)THEN
              DO i=lft,llt
cc             N = I + NFT
cc             INUM(EL2FA(NN5+N)) = IXTG(NIXTG,N)
              ENDDO
C-----------------------------------------------
C       RNUR
C-----------------------------------------------
            ENDIF
          ENDIF
 490    CONTINUE
C-----------------------------------------------
        nel_ply = nel_ply + plyshell(iply)%PLYNUMSHELL
      ENDDO
 
      IF (nspmd == 1) THEN
        DO i=1,nbf
          inum(i) = inum(i) + idcmax
        ENDDO
        CALL write_i_c(inum,nbf)
 
        idcmax=0
        DO i=1,nbf
           idcmax=max(idcmax,inum(i))
        ENDDO
 
      ELSE
C
        IF (ispmd==0) THEN
          rbuf = nbf_pxfemg
          CALL spmd_iget_partn_ply(1,nbf_l,inum,nplypart,iadg,rbuf,1,
     *                             idcmax)
        ELSE
          rbuf = 1
          CALL spmd_iget_partn_ply(1,nbf_l,inum,nplypart,iadg,rbuf,1,
     *                             idcmax)
        END IF
      ENDIF
 
C-----------------------------------------------
C
      RETURN