c_pon.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	c_pon (addcne, numnod_l, nodglob, lcne_l, i2nsnt, addcni2, lcni2_l, monvol, cep, proc, nnmv_l, nnmvc_l, addcne_pxfem, lcnepxfem_l, inodpxfem, addcne_crkxfem, lcnecrkxfem_l, inodcrkxfem, addcncnd, lcncnd_l, igrsurf)

Function/Subroutine Documentation

c_pon()

subroutine c_pon	(	integer, dimension(0:*)	addcne,
		integer	numnod_l,
		integer, dimension(*)	nodglob,
		integer	lcne_l,
		integer	i2nsnt,
		integer, dimension(0:*)	addcni2,
		integer	lcni2_l,
		integer, dimension(*)	monvol,
		integer, dimension(*)	cep,
		integer	proc,
		integer	nnmv_l,
		integer	nnmvc_l,
		integer, dimension(0:*)	addcne_pxfem,
		integer	lcnepxfem_l,
		integer, dimension(*)	inodpxfem,
		integer, dimension(0:*)	addcne_crkxfem,
		integer	lcnecrkxfem_l,
		integer, dimension(*)	inodcrkxfem,
		integer, dimension(0:*)	addcncnd,
		integer	lcncnd_l,
		type (surf_), dimension(nsurf)	igrsurf )

Definition at line 30 of file c_pon.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE groupdef_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      "com_xfem1.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER  NUMNOD_L, LCNE_L, LCNI2_L, I2NSNT, NNMV_L, PROC,NNMVC_L,
     .         ADDCNE(0:*), NODGLOB(*), ADDCNI2(0:*),
     .         MONVOL(*), CEP(*),
     .         ADDCNE_PXFEM(0:*),LCNEPXFEM_L,INODPXFEM(*),
     .         ADDCNE_CRKXFEM(0:*),LCNECRKXFEM_L,INODCRKXFEM(*),
     .         ADDCNCND(0:*),LCNCND_L
      TYPE (SURF_)   , DIMENSION(NSURF)   :: IGRSURF
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER N,I,K0,K1,K2,K6,IS,NN,IAD,J,ITY,OFFC,OFFTG,NN_L,N1,
     .        ITYP,NVENT,IV,IADHOL,KIBHOL,KIBJET,NNC,KAD,NAV,IPVENT
C-----------------------------------------------
C
C taille Matrice connectivite locale
C
      lcne_l = 0
      DO i = 1, numnod_l
        n = nodglob(i)
        lcne_l = lcne_l + addcne(n+1)-addcne(n)
      ENDDO
C
C taille Matrice connectivite locale (interface type 2)
C
      lcni2_l = 0
      IF(i2nsnt>0) THEN
        DO i = 1, numnod_l
          n = nodglob(i)
          lcni2_l = lcni2_l + addcni2(n+1)-addcni2(n)
        END DO
      END IF
C
      lcnepxfem_l = 0
      IF(iplyxfem > 0) THEN
        DO i = 1, numnod_l
          n = nodglob(i)
          n1 = inodpxfem(n)
          IF(n1 > 0) THEN
            lcnepxfem_l = lcnepxfem_l
     .                  + addcne_pxfem(n1+1)-addcne_pxfem(n1)
          ENDIF
        ENDDO
      ENDIF
C-----Itet2 S10      
      lcncnd_l = 0
      IF(ns10e>0) THEN
        DO i = 1, numnod_l
          n = nodglob(i)
          lcncnd_l = lcncnd_l + addcncnd(n+1)-addcncnd(n)
        END DO
      END IF
C
C crack xfem layered shell
C
      lcnecrkxfem_l = 0
      IF(icrack3d > 0) THEN
        DO i = 1, numnod_l
          n  = nodglob(i)
          n1 = inodcrkxfem(n)   ! Num noeud systeme xfem global 
          IF (n1 > 0) THEN
            lcnecrkxfem_l = lcnecrkxfem_l 
     .                    + addcne_crkxfem(n1+1) - addcne_crkxfem(n1)
          ENDIF  
        ENDDO
      ENDIF
C
C Taille connectivite airbag
C
      offc = numels+numelq
      offtg =numels+numelq+ numelc+numelt+numelp+numelr
      k0 = 0
      k1 = 1
      k2 = 1 + nimv*nvolu
      kibjet = k2  + licbag
      kibhol = kibjet + libagjet
      k6 = 0
      nn_l = 0
      DO n = 1, nvolu
        ityp  = monvol(k1+1)
        nav   = monvol(k1+2)
        is    = monvol(k1+3)
        nvent = monvol(k1+10)
        nn    = igrsurf(is)%NSEG
        iadhol= kibhol+monvol(k1+11)
        DO j = 1, nn
          ity = igrsurf(is)%ELTYP(j)
          i   = igrsurf(is)%ELEM(j)
          IF (ity==3) THEN
            IF(cep(offc+i)==proc) nn_l = nn_l + 1
          ELSEIF (ity==7) THEN
            IF(cep(offtg+i)==proc) nn_l = nn_l + 1
          ELSE
          ENDIF
        ENDDO
C
        IF(ityp==3.OR.ityp==4.OR.ityp==5.OR.ityp==7.OR.ityp==9) THEN
          DO iv = 1, nvent
            ipvent = monvol(iadhol+nibhol*(iv-1)+2-1)
            IF(ipvent/=0) THEN
              nnc=igrsurf(ipvent)%NSEG
              DO j = 1, nnc
                ity = igrsurf(ipvent)%ELTYP(j)
                i   = igrsurf(ipvent)%ELEM(j)
                IF (ity==3) THEN
                  IF(cep(i+offc)==proc) THEN
                    k0 = k0 + 1
                  END IF
                ELSEIF (ity==7) THEN
                  IF(cep(i+offtg)==proc) THEN
                    k0 = k0 + 1
                  END IF
                END IF
              END DO
            END IF
          END DO
        END IF
        IF(ityp==4.OR.ityp==5.OR.ityp==7.OR.ityp==9)THEN
          DO iv = 1, nav
            ipvent = monvol(k2+nicbag*(iv-1)+2-1)
            IF(ipvent/=0) THEN
              nnc=igrsurf(ipvent)%NSEG
              DO j = 1, nnc
                ity = igrsurf(ipvent)%ELTYP(j)
                i   = igrsurf(ipvent)%ELEM(j)
                IF (ity==3) THEN
                  IF(cep(i+offc)==proc) THEN
                    k0 = k0 + 1
                  END IF
                ELSEIF (ity==7) THEN
                  IF(cep(i+offtg)==proc) THEN
                    k0 = k0 + 1
                  END IF
                END IF
              END DO
            END IF
          END DO
        END IF
        k1 = k1 + nimv
        k2 = k2 + nicbag * nav
        k6 = k6 + nn
      ENDDO
      nnmv_l  = nn_l
      nnmvc_l = k0
C
      RETURN