tgrhead.F File Reference

#include "implicit_f.inc"
#include "vect01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "sms_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	tgrhead (ixt, pm, geo, inum, isel, itr1, eadd, index, itri, ipartt, nd, igrsurf, igrtruss, cep, xep, itruoff, tagprt_sms, itagprld_truss)

Function/Subroutine Documentation

tgrhead()

subroutine tgrhead	(	integer, dimension(5,*)	ixt,
			pm,
			geo,
		integer, dimension(7,*)	inum,
		integer, dimension(*)	isel,
		integer, dimension(*)	itr1,
		integer, dimension(*)	eadd,
		integer, dimension(*)	index,
		integer, dimension(5,*)	itri,
		integer, dimension(*)	ipartt,
		integer	nd,
		type (surf_), dimension(nsurf)	igrsurf,
		type (group_), dimension(ngrtrus)	igrtruss,
		integer, dimension(*)	cep,
		integer, dimension(*)	xep,
		integer, dimension(*)	itruoff,
		integer, dimension(*)	tagprt_sms,
		integer, dimension(numelt), intent(inout)	itagprld_truss )

Definition at line 30 of file tgrhead.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE groupdef_mod
C-----------------------------------------------
C            A R G U M E N T S
C-----------------------------------------------
C     IXT(5,NUMELT)     TABLEAU CONECS+MID+PID+NOS TRUSSES         E
C     GEO(NPROPG,NUMGEO)TABLEAU DES CARACS DES PID                 E
C     INUM(6,NUMELT)    TABLEAU DE TRAVAIL                         E/S
C     ISEL(NSELT)       TABLEAU DESPOUTRES CHOISIS POUR TH         E/S
C     ITR1(NSELT)       TABLEAU DE TRAVAIL                         E/S
C     EADD(NUMELT)      TABLEAU DES ADRESSES DANS IDAM CHGT DAMIER   S
C     INDEX(NUMELT)     TABLEAU DE TRAVAIL                         E/S
C     ITRI(5,NUMELT)    TABLEAU DE TRAVAIL                         E/S
C     IPARTT(NUMELT)    TABLEAU PART                               E/S
C     CEP(NUMELT)    TABLEAU PROC                               E/S
C     XEP(NUMELT)    TABLEAU PROC                               E/S
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      "vect01_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
#include      "sms_c.inc"
C-----------------------------------------------
C   D U M M Y   A R G U M E N T S
C-----------------------------------------------
      INTEGER IXT(5,*),ISEL(*),INUM(7,*),IPARTT(*),
     .        EADD(*),ITR1(*),INDEX(*),ITRI(5,*),
     .        ND, CEP(*), XEP(*),
     .        ITRUOFF(*), TAGPRT_SMS(*)
      INTEGER ,INTENT(INOUT), DIMENSION(NUMELT) ::ITAGPRLD_TRUSS
      my_real :: pm(npropm,*), geo(npropg,*)
C-----------------------------------------------
      TYPE (GROUP_)  , DIMENSION(NGRTRUS)  :: IGRTRUSS
      TYPE (SURF_)   , DIMENSION(NSURF)    :: IGRSURF
C-----------------------------------------------
C   L O C A L   V A R I A B L E S
C-----------------------------------------------
      INTEGER :: I,J,K,L,NG, ISSN, NN,N,MLN,MID,PID ,NGROU
      INTEGER :: II,JJ,II2,JJ2,II3,JJ3,II4,JJ4,II5,JJ5
      INTEGER :: MSKMLN,MSKISN,MSKPID, MSKMID, MODE
      INTEGER :: WORK(70000),IPRLD
      EXTERNAL my_shiftl,my_shiftr,my_and
      INTEGER MY_SHIFTL,MY_SHIFTR,MY_AND
 
      DATA mskmln /o'07770000000'/
      DATA mskisn /o'00000000700'/
      DATA mskmid /o'07777777777'/
      DATA mskpid /o'07777777777'/
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
 
C----------------------------------------------------------
C   TRI GLOBAL SUR TOUS LES CRITERES POUR TOUS LES ELEMENTS
C----------------------------------------------------------
C
      DO i=1,numelt
        eadd(i)=1
        index(i)=i
        inum(1,i)=ipartt(i)
        inum(2,i)=itruoff(i)
        inum(3,i)=ixt(1,i)
        inum(4,i)=ixt(2,i)
        inum(5,i)=ixt(3,i)
        inum(6,i)=ixt(4,i)
        inum(7,i)=ixt(5,i)
      ENDDO
 
      DO i=1,numelt
        xep(i)=cep(i)
      ENDDO
C
C
      DO i = 1, numelt
        ii = i
        mid= ixt(1,ii)
        mln= pm(19,mid)
        pid= ixt(4,ii)
        issn = 0
        IF(geo(5,pid)/=0.) issn=1
        iprld = itagprld_truss(ii)
        IF (iprld>0) mln = mln+iprld
C
        issn=my_shiftl(issn,6)
        mln=my_shiftl(mln,21)
C
        itri(1,i)=mln+issn
        itri(2,i)=itruoff(i)
C
        jsms = 0
        IF(isms/=0)THEN
          IF(idtgrs/=0)THEN
            IF(tagprt_sms(ipartt(ii))/=0)jsms=1
          ELSE
            jsms=1
          END IF
        END IF
C       JSMS=MY_SHIFTL(JSMS,0)
        itri(3,i) = jsms
C       NEXT=MY_SHIFTL(NEXT,1)
c
C       key4
        itri(4,i) = mid
C       key5
        itri(5,i) = pid
 
      ENDDO
C
      mode=0
      CALL my_orders( mode, work, itri, index, numelt , 4)
C
      DO i=1,numelt
        ipartt(i) =inum(1,index(i))
        itruoff(i) =inum(2,index(i))
      ENDDO
      DO  k=1,5
        DO  i=1,numelt
          ixt(k,i)=inum(k+2,index(i))
        ENDDO
      ENDDO
 
      DO i=1,numelt
        cep(i)=xep(index(i))
      ENDDO
C
C INVERSION DE INDEX (DANS ITR1)
C
      DO i=1,numelt
        itr1(index(i))=i
      ENDDO
C
C RENUMEROTATION POUR TH
C
C
C RENUMEROTATION POUR SURFACES
C
      DO i=1,nsurf
        nn=igrsurf(i)%NSEG
        DO j=1,nn
          IF(igrsurf(i)%ELTYP(j) == 4)
     .       igrsurf(i)%ELEM(j) = itr1(igrsurf(i)%ELEM(j))
        ENDDO
      ENDDO
C
C RENUMEROTATION POUR GROUPES DE TRUSSES
C
      DO i=1,ngrtrus
        nn=igrtruss(i)%NENTITY
        DO j=1,nn
          igrtruss(i)%ENTITY(j) = itr1(igrtruss(i)%ENTITY(j))
        ENDDO
      ENDDO
C REORDERING FOR ITAGPRLD_TRUSS
      inum(2,1:numelt)=itagprld_truss(1:numelt)
      DO i=1,numelt
        itagprld_truss(i) =inum(2,index(i))
      ENDDO
C
C--------------------------------------------------------------
C         DETERMINATION DES SUPER_GROUPES
C--------------------------------------------------------------
      nd=1
      DO i=2,numelt
        ii=itri(1,index(i))
        jj=itri(1,index(i-1))
        ii2=itri(2,index(i))
        jj2=itri(2,index(i-1))
        ii3=itri(3,index(i))
        jj3=itri(3,index(i-1))
        ii4=itri(4,index(i))
        jj4=itri(4,index(i-1))
        ii5=itri(5,index(i))
        jj5=itri(5,index(i-1))
        
        IF (ii/=jj   .OR. ii2/=jj2 .OR. ii3/=jj3  .OR.
     .      ii4/=jj4 .OR. ii5/=jj5) THEN
          nd=nd+1
          eadd(nd)=i
        ENDIF
      ENDDO
      eadd(nd+1) = numelt+1
c-----------
      RETURN