c_sectio.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	c_sectio (nstrf, cep, proc, nstrf_l, lsecbuf_l, nnodt_l, nnodl_l)

Function/Subroutine Documentation

c_sectio()

subroutine c_sectio	(	integer, dimension(*)	nstrf,
		integer, dimension(*)	cep,
		integer	proc,
		integer	nstrf_l,
		integer	lsecbuf_l,
		integer	nnodt_l,
		integer	nnodl_l )

Definition at line 31 of file c_sectio.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------  
 
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"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
       INTEGER  PROC, NSTRF_L, LSECBUF_L, NNODT_L, NNODL_L,
     .          NSTRF(*), CEP(*)
C-----------------------------------------------
C   F u n c t i o n
C-----------------------------------------------
      INTEGER  NLOCAL
      EXTERNAL nlocal      
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NNOD_S, NSELS_S, NSELQ_S, NSELC_S, NSELT_S, NSELP_S,
     .        NSELR_S, NSELTG_S, NSINT_S, NSELS_S_L, NSELQ_S_L,
     .        NSELC_S_L, NSELT_S_L, NSELP_S_L, NSELR_S_L, NSELTG_S_L,
     .        N, IP, P, J, K, OFF, NNOD_S_L, TYP_S
C
      nstrf_l = 30
C      LSECBUF_L = 0
      lsecbuf_l = 10
      nnodt_l = 0
      nnodl_l = 0
      ip = 30
      DO n = 1, nsect
        typ_s   = nstrf(ip+1)
        nnod_s  = nstrf(ip+7)
        nsels_s = nstrf(ip+8)
        nselq_s = nstrf(ip+9)
        nselc_s = nstrf(ip+10)
        nselt_s = nstrf(ip+11)
        nselp_s = nstrf(ip+12)
        nselr_s = nstrf(ip+13)
        nseltg_s= nstrf(ip+14)
        nsint_s = nstrf(ip+15)
        nsels_s_l = 0
        nselq_s_l = 0
        nselc_s_l = 0
        nselt_s_l = 0
        nselp_s_l = 0
        nselr_s_l = 0
        nseltg_s_l= 0
c        IP = IP + 30 + NSINT_S + NNOD_S
c        NSTRF_L = NSTRF_L + 30 + NSINT_S + NNOD_S
        ip = ip + 30 + nsint_s
        nstrf_l = nstrf_l + 30 + nsint_s
C noeuds
        nnod_s_l = 0
        DO j = 1, nnod_s
          k = nstrf(ip + j)
          IF(nlocal(k,proc+1)==1)THEN
            nnod_s_l = nnod_s_l + 1
          END IF
        END DO
        IF(isecut==1) THEN
C section cut
          IF (typ_s>=1)THEN
            nnodl_l = nnodl_l + nnod_s_l
          ENDIF
C section cut type 1 et superieur sur p0
          IF(proc==0.AND.typ_s>=1) THEN
            nnodt_l = nnodt_l + nnod_s_l
            DO p = 2, nspmd
              DO j = 1, nnod_s
                k = nstrf(ip + j)
                IF(nlocal(k,p)==1)THEN
                  nnodt_l = nnodt_l + 1
                END IF
              END DO
            END DO
          END IF
        END IF
C
        ip = ip + nnod_s
        nstrf_l = nstrf_l + nnod_s_l
C
        off = 0
C solides
        DO j = 1, nsels_s
          k = nstrf(ip + j*2 - 1)
          IF(cep(k+off)==proc) nsels_s_l = nsels_s_l + 1
        END DO
        nstrf_l = nstrf_l + 2*nsels_s_l
        ip = ip + 2*nsels_s
        off = off + numels
C quad
        DO j = 1, nselq_s
          k = nstrf(ip + j*2 - 1)
          IF(cep(k+off)==proc) nselq_s_l = nselq_s_l + 1
        END DO
        nstrf_l = nstrf_l + 2*nselq_s_l
        ip = ip + 2*nselq_s
        off = off + numelq
C shell
        DO j = 1, nselc_s
          k = nstrf(ip + j*2 - 1)
          IF(cep(k+off)==proc) nselc_s_l = nselc_s_l + 1
        END DO
        nstrf_l = nstrf_l + 2*nselc_s_l
        ip = ip + 2*nselc_s
        off = off + numelc
C truss
        DO j = 1, nselt_s
          k = nstrf(ip + j*2 - 1)
          IF(cep(k+off)==proc) nselt_s_l = nselt_s_l + 1
        END DO
        nstrf_l = nstrf_l + 2*nselt_s_l
        ip = ip + 2*nselt_s
        off = off + numelt
C poutre
        DO j = 1, nselp_s
          k = nstrf(ip + j*2 - 1)
          IF(cep(k+off)==proc) nselp_s_l = nselp_s_l + 1
        END DO
        nstrf_l = nstrf_l + 2*nselp_s_l
        ip = ip + 2*nselp_s
        off = off + numelp
C ressort
        DO j = 1, nselr_s
          k = nstrf(ip + j*2 - 1)
          IF(cep(k+off)==proc) nselr_s_l = nselr_s_l + 1
        END DO
        nstrf_l = nstrf_l + 2*nselr_s_l
        ip = ip + 2*nselr_s
        off = off + numelr
C triangle
        DO j = 1, nseltg_s
          k = nstrf(ip + j*2 - 1)
          IF(cep(k+off)==proc) nseltg_s_l = nseltg_s_l + 1
        END DO
        nstrf_l = nstrf_l + 2*nseltg_s_l
        ip = ip + 2*nseltg_s
        off = off + numeltg
C cut
        lsecbuf_l=lsecbuf_l+10
        IF(typ_s>=100)lsecbuf_l=lsecbuf_l+12*nnod_s_l
        IF(typ_s>=101)lsecbuf_l=lsecbuf_l+12*nnod_s_l
        IF(typ_s>=102)lsecbuf_l=lsecbuf_l+6*nnod_s_l
C.
      ENDDO
C
      RETURN