parsor_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	parsor_ply (nel_ply, x, d, xnorm, cdg, iparg, ixc, ixtg, invert, el2fa, mater, ipartc, nodglob, idply, iadply, iadplyg, plynumc, nbf_pxfemg)

Function/Subroutine Documentation

parsor_ply()

subroutine parsor_ply	(	integer	nel_ply,
			x,
			d,
			xnorm,
			cdg,
		integer, dimension(nparg,*)	iparg,
		integer, dimension(nixc,*)	ixc,
		integer, dimension(nixtg,*)	ixtg,
		integer, dimension(*)	invert,
		integer, dimension(*)	el2fa,
		integer, dimension(*)	mater,
		integer, dimension(*)	ipartc,
		integer, dimension(*)	nodglob,
		integer	idply,
		integer, dimension(*)	iadply,
		integer, dimension(*)	iadplyg,
		integer	plynumc,
		integer	nbf_pxfemg )

Definition at line 37 of file parsor_ply.F.

      USE plyxfem_mod
      USE my_alloc_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      "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-----------------------------------------------
C     REAL
      my_real
     .   x(*),d(*),xnorm(3,*),cdg(*)
      INTEGER IXC(NIXC,*),IXTG(NIXTG,*),IPARG(NPARG,*),
     .        INVERT(*), EL2FA(*),MATER(*),
     .        IPARTC(*),NODGLOB(*),
     .        NEL_PLY,IDPLY,IADPLY(*),IADPLYG(*),PLYNUMC,
     .        NBF_PXFEMG
C-----------------------------------------------
      INTEGER GET_PLY_NODID
      EXTERNAL get_ply_nodid
      INTEGER GET_PLY_NOD
      EXTERNAL get_ply_nod
C-----------------------------------------------
C     REAL
      my_real off
      INTEGER II(4),IE,NG, ITY, LFT, LLT, N, I, J, 
     .        IPRT, NEL, IAD, NPAR, NFT, IMID,IALEL,MTN,
     .        NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10,
     .        JJ, K, SH_IH,BUF,ISHPLYXFEM,
     .        IPT,ELC,PLYS,IPLY,IE_EL2FA,
     .        NPCC,IDPLYN
      INTEGER EMPL
      INTEGER,DIMENSION(:),ALLOCATABLE::NP
      INTEGER,DIMENSION(:),ALLOCATABLE::PLYELEMS
C-----------------------------------------------
C     PLY ELEMS INIT
C-----------------------------------------------
      CALL my_alloc(plyelems, numelc)
      CALL my_alloc(np, plynumc*4)
      npcc = 0
      DO plys = 1,nplypart
        iply = indx_ply(plys)
        npcc = npcc + plyshell(iply)%PLYNUMSHELL
      ENDDO
 
      jj = 0
      nel_ply = 0
      ie=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-----------------------------------------------
        ie_el2fa=0
        npar = 0
C
C en spmd il faut envoyer l'info meme qd on a 0 elem local
         DO 490 ng=1,ngroup
          mtn   =iparg(1,ng)
          nel   =iparg(2,ng)
          nft   =iparg(3,ng)
          iad   =iparg(4,ng)
          ity   =iparg(5,ng)
          ishplyxfem = iparg(50,ng)
          lft=1
          llt=nel
cccc        KPT    =IPARG(6,NG)    
C-----------------------------------------------
C       COQUES
C-----------------------------------------------
          IF(ishplyxfem > 0) THEN
             IF(ity==3)THEN
c               KPT   =IPARG(6,NG)
c               IHBE = IPARG(23,NG)
c               ISTRAIN=IPARG(44,NG)
c               IEXPAN=IPARG(49,NG)
c               CALL CBUFAD (IAD-1,NEL,ISTRAIN,KPT,IHBE,0,0,0,IEXPAN,
c     .                      IPARG(1,NG))
                DO 130 i=lft,llt
                n = i + nft
                IF(plyelems(n) == 0)GOTO 130
cc                OFF = BUFEL(IAD+I+SH_IH*NEL-1)
                   ii(1) = ixc(2,n)
                   ii(2) = ixc(3,n)
                   ii(3) = ixc(4,n)
                   ii(4) = ixc(5,n)
                   ie = ie + 1
                   ie_el2fa = ie_el2fa + 1
c                  CALL FACNOR(X,D,II,XNORM,CDG,INVERT(IE))
                   IF (nspmd == 1) THEN
                     ii(1) = get_ply_nodid(iply,ii(1),idply)- 1
                     ii(2) = get_ply_nodid(iply,ii(2),idply)- 1
                     ii(3) = get_ply_nodid(iply,ii(3),idply)- 1
                     ii(4) = get_ply_nodid(iply,ii(4),idply)- 1
                     CALL write_i_c(ii,4)
                   ELSE
                     empl = get_ply_nod(iply,ii(1))
                     np(jj+1) = plynod(iply)%PLYNODID(empl)
 
                     empl = get_ply_nod(iply,ii(2))
                     np(jj+2) = plynod(iply)%PLYNODID(empl)
 
                     empl = get_ply_nod(iply,ii(3))
                     np(jj+3) = plynod(iply)%PLYNODID(empl)
 
                     empl = get_ply_nod(iply,ii(4))
                     np(jj+4) = plynod(iply)%PLYNODID(empl)
 
                   END IF
                   el2fa(nel_ply+ie_el2fa) = ie 
                   jj = jj + 4
 130           CONTINUE
C-----------------------------------------------
C             COQUES 3 NOEUDS
C-----------------------------------------------
              ELSEIF(ity==7)THEN
              ENDIF
          ENDIF
 490   CONTINUE
C
 
        iadply(plys) = ie
        nel_ply = nel_ply + plyshell(iply)%PLYNUMSHELL
      ENDDO
 
      IF (nspmd > 1) THEN
C   construction tableau global des parts sur p0
 
        IF (ispmd==0) THEN
         CALL spmd_iglob_partn(iadply,nplypart,iadplyg,nplypart)
         buf = nbf_pxfemg*4
         idplyn = idply - 1
         CALL spmd_iget_partn_ply(4,jj,np,nplypart,iadplyg,buf,1,idplyn)
        ELSE
         CALL spmd_iglob_partn(iadply,nplypart,iadplyg,nplypart)
         buf=1
         idplyn = idply - 1
         CALL spmd_iget_partn_ply(4,jj,np,nplypart,iadplyg,buf,1,idplyn)
        ENDIF
 
      ENDIF
      DEALLOCATE(plyelems)
      DEALLOCATE(np)
C-----------------------------------------------
      RETURN