f_nodloc2.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	f_nodloc2 (numnod, p, nodglob, nodlocal, igeo, iparg, ixs, ixq, ixc, ixtg, ixt, ixp, ixr, geo, numnod_l)

Function/Subroutine Documentation

f_nodloc2()

subroutine f_nodloc2	(	integer	numnod,
		integer	p,
		integer, dimension(*)	nodglob,
		integer, dimension(*)	nodlocal,
		integer, dimension(npropgi,*)	igeo,
		integer, dimension(nparg,*)	iparg,
		integer, dimension(nixs,*)	ixs,
		integer, dimension(nixq,*)	ixq,
		integer, dimension(nixc,*)	ixc,
		integer, dimension(nixtg,*)	ixtg,
		integer, dimension(nixt,*)	ixt,
		integer, dimension(nixp,*)	ixp,
		integer, dimension(nixr,*)	ixr,
			geo,
		integer	numnod_l )

Definition at line 32 of file f_nodloc2.F.

      use element_mod , only : nixs,nixq,nixc,nixp,nixt,nixr,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
C-----------------------------------------------
#include      "param_c.inc"
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NUMNOD,P,NUMNOD_L,
     +        NODGLOB(*), NODLOCAL(*), IGEO(NPROPGI,*),
     +        IPARG(NPARG,*), IXS(NIXS,*), IXQ(NIXQ,*), IXC(NIXC,*),
     +        IXTG(NIXTG,*), IXT(NIXT,*), IXP(NIXP,*), IXR(NIXR,*)
       my_real
     +        geo(npropg,*)
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 I, N_L, NG, NEL, ITY, NFT, K, N, IE
      INTEGER, DIMENSION(:), ALLOCATABLE :: ITAG
C
! ----------------------
!     allocate 1d array
      ALLOCATE( itag(numnod) )
! ----------------------
      DO n = 1, numnod
        itag(n) = 0
      END DO
C
      n_l = 0
      DO ng=1,ngroup
        IF(iparg(32,ng)==p-1) THEN
          nel = iparg(2,ng)
          nft = iparg(3,ng)
          ity = iparg(5,ng)
          IF(ity==1) THEN
C solid (remains to be solid 10, 16, 20)
            DO i = 1, nel
              ie = i+nft
              DO k = 1, 8
                n = ixs(k+1,ie)
                IF(itag(n)==0) THEN
                  n_l = n_l + 1
                  nodlocal(n) = n_l
                  nodglob(n_l) = n
                  itag(n) = 1
                END IF
              END DO
            END DO
C cas 2D
          ELSEIF(ity==2)THEN
            DO i = 1, nel
              ie = i+nft
              DO k = 1, 4
                n = ixq(k+1,ie)
                IF(itag(n)==0) THEN
                  n_l = n_l + 1
                  nodlocal(n) = n_l
                  nodglob(n_l) = n
                  itag(n) = 1
                END IF
              END DO
            END DO
          ELSEIF(ity==3)THEN
C coques
            DO i = 1, nel
              ie = i+nft
              DO k = 1, 4
                n = ixc(k+1,ie)
                IF(itag(n)==0) THEN
                  n_l = n_l + 1
                  nodlocal(n) = n_l
                  nodglob(n_l) = n
                  itag(n) = 1
                END IF
              END DO
            END DO
          ELSEIF(ity==4)THEN
C trusses
            DO i = 1, nel
              ie = i+nft
              DO k = 1, 2
                n = ixt(k+1,ie)
                IF(itag(n)==0) THEN
                  n_l = n_l + 1
                  nodlocal(n) = n_l
                  nodglob(n_l) = n
                  itag(n) = 1
                END IF
              END DO
            END DO
          ELSEIF(ity==5)THEN
C poutres
            DO i = 1, nel
              ie = i+nft
              DO k = 1, 2
                n = ixp(k+1,ie)
                IF(itag(n)==0) THEN
                  n_l = n_l + 1
                  nodlocal(n) = n_l
                  nodglob(n_l) = n
                  itag(n) = 1
                END IF
              END DO
            END DO
          ELSEIF(ity==6)THEN
C ressorts
            DO i = 1, nel
              ie = i+nft
              DO k = 1, 2
                n = ixr(k+1,ie)
                IF(itag(n)==0) THEN
                  n_l = n_l + 1
                  nodlocal(n) = n_l
                  nodglob(n_l) = n
                  itag(n) = 1
                END IF
              END DO
              IF(igeo(11,ixr(1,ie))==12)THEN
                n = ixr(4,ie)
                IF(itag(n)==0) THEN
                  n_l = n_l + 1
                  nodlocal(n) = n_l
                  nodglob(n_l) = n
                  itag(n) = 1
                END IF
              END IF
            END DO
          ELSEIF(ity==7)THEN
C   probably confusion between int_type and element       ELSEIF(ITY==7.OR.ITY==22)THEN
C triangles
            DO i = 1, nel
              ie = i+nft
              DO k = 1, 3
                n = ixtg(k+1,ie)
                IF(itag(n)==0) THEN
                  n_l = n_l + 1
                  nodlocal(n) = n_l
                  nodglob(n_l) = n
                  itag(n) = 1
                END IF
              END DO
            END DO
          ELSEIF(ity==50)THEN
C ur to do
          END IF
        END IF
      END DO
C
      DO i = 1, numnod
        IF(itag(i)==0) THEN
          IF(nlocal(i,p)==1)THEN
            n_l = n_l + 1
            nodlocal(i) = n_l
            nodglob(n_l)= i
          ELSE
            nodlocal(i) = 0
          ENDIF
        END IF
      ENDDO
C
! ----------------------
!     deallocate 1d array
      DEALLOCATE( itag )
! ----------------------
      RETURN