C ELFTR2    SOURCE    CHAT      05/01/12    23:32:48     5004
      SUBROUTINE ELFTR2(MATTAC,KNREFE)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C
C  ====================================================================
C  = APPELE PAR ELFE                                                  =
C  = REGROUPEMENT DES JONCTIONS RELIEES PAR DES ELEMENTS RIGIDES EN   =
C  = UNE SEULE                                                        =
C  = CREATION    : 22/07/87                                           =
C  = PROGRAMMEUR : GUILBAUD                                           =
C  ====================================================================
C

-INC PPARAM
-INC CCOPTIO
-INC SMATTAC
C
      SEGMENT MNREFE
        INTEGER NREFE(8,NSTR)
        INTEGER NTANBN
        INTEGER NIDNCN
        INTEGER NTVN
        POINTEUR NREPA.MPASS
        POINTEUR NRECA.MCARA
        POINTEUR NRENO.MNORM
        POINTEUR NRECPR.ICPR
        POINTEUR NREMEL.MELEME
        POINTEUR NREDEN.MDEN
      ENDSEGMENT
C
C   NSTR       : NOMBRE D'ELEMENTS
C   NREFE(1,I) : MELEME
C   NREFE(2,I) : MSOSTU
C   NREFE(3,I) : TYPE DE L'ELEMENT
C   NREFE(4,I) : NOMBRE DE POINTS DU MELEME
C   NREFE(5,I) : NOMBRE DE DDL PAR POINT
C   NREFE(6,I)=IVN :LE 1ER DDL DE L'ELEMENT EST LE IVN+1 IEME DE VN
C   NREFE(7,I)=IAN :LE 1ER TERME DE LA MATRICE A EST LE IAN IEME DE ANBN
C   NREFE(8,I)= 1 :LE IEME ELEMENT EST RIGIDE (OU PARTIELLEMENT) SINON 0
C   NTANBN : NOMBRE DE TERMES DES MATRICES A ET B POUR TOUS LES ELEMENTS
C   NIDNCN : NOMBRE TOTAL D'INCONNUES DE DNCN
C   NTVN   : LONGUEUR DU TABLEAU VN
C
      SEGMENT /JTRAI/(ITRAI(NN))
      SEGMENT /JTRAL/(ITRAL(NSOUMA))
      SEGMENT /JDEJL/(IDEJL(NSOUMA))
      SEGMENT /JDEJA/(IDEJA(NN))
      SEGMENT /JTRAV/(ITRAV(NN))
C
      WRITE(IOIMP,*) ' DEBUT DE ELFTR2 '
C
      MNREFE=KNREFE
      NSTR=NREFE(/2)
      NN=NSTR
      SEGINI JTRAV
      NN=0
      DO 10 N=1,NSTR
      IF(NREFE(8,N).EQ.1) THEN
        NN=NN+1
        ITRAV(NN)=NREFE(2,N)
      ENDIF
   10 CONTINUE
      IF(NN.EQ.0) THEN
        SEGSUP JTRAV
        RETURN
      ENDIF
      SEGADJ JTRAV
      SEGINI JDEJA
      SEGINI JTRAI
      DO 9 I=1,NN
      IDEJA(I)=0
    9 CONTINUE
      SEGACT MATTAC
      NSOUMA=LISATT(/1)
      SEGINI JDEJL,JTRAL
      DO 11 I=1,NSOUMA
      IDEJL(I)=0
   11 CONTINUE
      N=NSOUMA
      SEGINI MATTA1
C
C  BOUCLE SUR LES ELEMENTS RIGIDES
C
      NKK=0
      DO 130 NE=1,NN
      IF(IDEJA(NE).EQ.0) THEN
        WRITE(IOIMP,*) ' ELEMENT RIGIDE NE = ',NE
        NI1=1
        NI2=1
        ITRAI(NI1)=NE
        NLL=0
        NL1=1
        IDEJA(NE)=1
   15   CONTINUE
C
C   1 - RECHERCHE DE TOUTES LES NOUVELLES LIAISONS QUI S'APPUIENT SUR
C       LES DERNIERS ELEMENTS RIGIDES TROUVES
C
        DO 60 NI=NI1,NI2
        NK=ITRAI(NI)
        MSOST1=ITRAV(NK)
        IDEJA(NK)=1
        DO 40 NSOU=1,NSOUMA
        IF(IDEJL(NSOU).EQ.0) THEN
          MSOUMA=LISATT(NSOU)
          SEGACT MSOUMA
          NJON=IATREL(/1)
          DO 30 NJ=1,NJON
          MJONCT=IATREL(NJ)
          SEGACT MJONCT
          NTJ=ISTRJO(/1)
          DO 20 J=1,NTJ
          MSOSTU=ISTRJO(J)
          IF(MSOSTU.EQ.MSOST1) THEN
            NLL=NLL+1
            ITRAL(NLL)=NSOU
            SEGDES MJONCT,MSOUMA
        IDEJL(NSOU)=1
            GOTO 40
          ENDIF
   20     CONTINUE
          SEGDES MJONCT
   30     CONTINUE
          SEGDES MSOUMA
        ENDIF
   40   CONTINUE
   60   CONTINUE
        WRITE(IOIMP,*) ' NI1 NI2 ',NI1,NI2
        WRITE(IOIMP,*) ' ITRAL   ',(ITRAL(NLLL),NLLL=1,NLL)
        WRITE(IOIMP,*) ' IDEJA   ',(IDEJA(NLLL),NLLL=1,NN)
C
C   2 - RECHERCHE DE TOUS LES NOUVEAUX ELEMENTS RIGIDES SUR LESQUELS
C       S'APPUIENT LES DERNIERES LIAISONS TROUVEES
C
        NI=NI2
        DO 100 NL=NL1,NLL
        NSOU=ITRAL(NL)
        MSOUMA=LISATT(NSOU)
        SEGACT MSOUMA
        NJON=IATREL(/1)
        DO 90 NJ=1,NJON
        MJONCT=IATREL(NJ)
        SEGACT MJONCT
        NTJ=ISTRJO(/1)
        DO 80 J=1,NTJ
        MSOSTU=ISTRJO(J)
        DO 70 KK=1,NN
        IF(IDEJA(KK).EQ.0.AND.MSOSTU.EQ.ITRAV(KK)) THEN
          NI=NI+1
          ITRAI(NI)=KK
          IDEJA(KK)=1
          GOTO 80
        ENDIF
   70   CONTINUE
   80   CONTINUE
        SEGDES MJONCT
   90   CONTINUE
        SEGDES MSOUMA
C       IDEJL(NSOU)=1
  100   CONTINUE
        WRITE(IOIMP,*) ' NL1 NLL ',NL1,NLL
        WRITE(IOIMP,*) ' ITRAI   ',(ITRAI(NLLL),NLLL=1,NI)
        WRITE(IOIMP,*) ' IDEJL   ',(IDEJL(NLLL),NLLL=1,NSOUMA)
        NL1=NLL+1
        NI1=NI2+1
        NI2=NI
        IF(NI2.GE.NI1) GOTO 15
        M=0
        N=0
        SEGINI MSOUM1
        MSOUM1.IGEOCH=0
        MSOUM1.IPHYCH=0
        MSOUM1.ITYATT='MECA'
        NJJ=0
        DO 120 NL=1,NLL
        NSOU=ITRAL(NL)
        MSOUMA=LISATT(NSOU)
        SEGACT MSOUMA
        NJON=IATREL(/1)
        N=NJJ+NJON
        SEGADJ MSOUM1
        DO 110 NJ=1,NJON
        NJJ=NJJ+1
        MSOUM1.IATREL(NJJ)=IATREL(NJ)
  110   CONTINUE
        SEGSUP MSOUMA
  120   CONTINUE
        SEGDES MSOUM1
        NKK=NKK+1
        MATTA1.LISATT(NKK)=MSOUM1
      ENDIF
  130 CONTINUE
      DO 140 NSOU=1,NSOUMA
      IF(IDEJL(NSOU).EQ.0) THEN
        NKK=NKK+1
        MATTA1.LISATT(NKK)=LISATT(NSOU)
      ENDIF
  140 CONTINUE
      N=NKK
      SEGADJ MATTA1
      SEGSUP MATTAC,JTRAL,JDEJL,JDEJA,JTRAV,JTRAI
      MATTAC=MATTA1
C
      IF(IIMPI.EQ.1) THEN
        WRITE(IOIMP,105) MATTAC
  105   FORMAT(/,10X,' CREATION DE L''OBJET ATTACHE ',I4///)
        NATTA=LISATT(/1)
        WRITE(IOIMP,101)
  101   FORMAT(10X,28('*'))
        WRITE(IOIMP,102)
  102   FORMAT(10X,'* MSOUMA * ITYATT * IATREL *')
        WRITE(IOIMP,101)
        DO 160 IL=1,NATTA
        MSOUMA=LISATT(IL)
        SEGACT MSOUMA
        WRITE(IOIMP,103) MSOUMA,ITYATT,IATREL(1)
  103   FORMAT(10X,'*  ',I4,'  *  ',A4,'  *  ',I4,'  *  ')
        NRELA=IATREL(/1)
        DO 150 IN=2,NRELA
        WRITE(IOIMP,104) IATREL(IN)
  104   FORMAT(10X,2('*        '),'*  ',I4,'  *')
  150   CONTINUE
        SEGDES MSOUMA
        WRITE(IOIMP,101)
  160   CONTINUE
      ENDIF
      SEGDES MATTAC
      WRITE(IOIMP,*) ' FIN DE ELFTR2 '
      RETURN
      END