Sources Esope | Cast3M

elftri
C ELFTRI    SOURCE    CB215821  20/11/25    13:27:21     10792          
      SUBROUTINE ELFTRI(MATTAC,KNREFE,MATTA1)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C
C  ====================================================================
C  = APPELE PAR ELFE                                                  =
C  = REGROUPEMENT DES LIAISONS ELEMENTAIRES CONSTITUANT UNE JONCTION  =
C  = CREATION    : 22/07/87                                           =
C  = PROGRAMMEUR : GUILBAUD                                           =
C  ====================================================================
C
-INC PPARAM
-INC CCOPTIO
-INC SMATTAC
-INC SMELEME
-INC SMCHPOI
-INC SMCOORD
C
      SEGMENT MNREFE
        INTEGER NREFE(7,NSTR)
        INTEGER NTANBN
        INTEGER NIDNCN
        INTEGER NTVN
        POINTEUR NREPA.MPASS
        POINTEUR NRECA.MCARA
        POINTEUR NRENO.MNORM
        POINTEUR NRECPR.ICPR
        POINTEUR NREMEL.MELEME
        POINTEUR NREMAT.MATGRE
      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   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 ICPR(nbpts)
      SEGMENT /JTRAK/(ITRAK(NJONT))
      SEGMENT /JTRAJ/(ITRAJ(NJONT))
      SEGMENT /JDEJA/(IDEJA(NBPTOT))
      SEGMENT /JTRAS/(ITRAS(NBPTOT))
C
      WRITE(IOIMP,*) ' DEBUT DE ELFTRI '
C
      SEGINI ICPR
      MNREFE=KNREFE
      MELEME=NREMEL
      SEGACT MELEME
      NBPTOT=NUM(/2)
      SEGINI JDEJA,JTRAS
      DO 5 NBP=1,NBPTOT
      ICPR(NUM(1,NBP))=NBP
      IDEJA(NBP)=0
      ITRAS(NBP)=0
    5 CONTINUE
C
      SEGACT MATTAC
      NSOUMA=LISATT(/1)
      NJONT=0
      NJONP=0
      SEGINI JTRAJ,JTRAK
      DO 20 NSOU=1,NSOUMA
      MSOUMA=LISATT(NSOU)
      SEGACT MSOUMA
      NJON=IATREL(/1)
      NJONT=NJONT+NJON
      SEGADJ JTRAJ
      SEGADJ JTRAK
      DO 10 NJ=1,NJON
      ITRAJ(NJONP+NJ)=IATREL(NJ)
      ITRAK(NJONP+NJ)=0
   10 CONTINUE
      SEGDES MSOUMA
      NJONP=NJONT
   20 CONTINUE
      SEGDES MATTAC
C
      N=NJONT
      M=0
      SEGINI MATTA1
      NSOU=0
      DO 70 NBP=1,NBPTOT
C  RECHERCHE SUR LES POINTS DONT L'APPARTENANCE AUX LIAISONS N'EST PAS
C  ENCORE ETABLIE
      IF(IDEJA(NBP).EQ.0) THEN
        NI=0
        NSOU=NSOU+1
        N=NJONT
        SEGINI MSOUMA
        MATTA1.LISATT(NSOU)=MSOUMA
        NV=1
        NVV=1
        ITRAS(1)=NUM(1,NBP)
        IDEJA(NBP)=1
C  RECHERCHE SUR LES POINTS DEJA CONNUS D'UNE JONCTION POUR TROUVER
C  TOUTES LES LIAISONS ELEMENTAIRES DE CETTE JONCTION
  100   CONTINUE
        IKI=ITRAS(NV)
C
        DO 60 NJ=1,NJONT
C  RECHERCHE SUR LES LIAISONS ELEMENTAIRES NON DEJA TROUVEES
        IF(ITRAK(NJ).EQ.0) THEN
          MJONCT=ITRAJ(NJ)
          SEGACT MJONCT
          NCHP=IPCHJO(/1)
          DO 55 NFOIS=1,2
          DO 50 NST=1,NCHP
          MCHPOI=IPCHJO(NST)
          SEGACT MCHPOI
          NSOUPO=IPCHP(/1)
          DO 40 NS=1,NSOUPO
          MSOUPO=IPCHP(NS)
          SEGACT MSOUPO
          IPT1=IGEOC
          SEGACT IPT1
          NBELEM=IPT1.NUM(/2)
          IF(NFOIS.EQ.1) THEN
C  NFOIS=1 ON RECHERCHE SI LA LIAISON ELEMENTAIRE PORTE SUR LE POINT
            DO 30 NB=1,NBELEM
            IKI1=IPT1.NUM(1,NB)
            IF(IKI1.EQ.IKI) GOTO 55
  30        CONTINUE
          ELSE
C  NFOIS=2 ON RASSEMBLE TOUS LES POINTS CONCERNES PAR CETTE LIAISON
            DO 35 NBB=1,NBELEM
            IKI2=IPT1.NUM(1,NBB)
            IPP=ICPR(IKI2)
            IF(IDEJA(IPP).EQ.0) THEN
              NVV=NVV+1
              ITRAS(NVV)=IKI2
              IDEJA(IPP)=1
            ENDIF
  35        CONTINUE
          ENDIF
          SEGDES MSOUPO,IPT1
  40      CONTINUE
          SEGDES MCHPOI
  50      CONTINUE
          IF(NFOIS.EQ.1) GOTO 57
          ITRAK(NJ)=NSOU
          NI=NI+1
          IATREL(NI)=ITRAJ(NJ)
  55      CONTINUE
  57      CONTINUE
          SEGDES MJONCT
        ENDIF
  60    CONTINUE
C
        NV=NV+1
        IF(NV.LE.NVV) GOTO 100
C
        IF(NI.EQ.0) THEN
C  *** LE POINT N'APPARTIENT PAS AUX LIAISONS
          INTERR(1)=NUM(1,NBP)
          CALL ERREUR(383)
          SEGSUP JTRAK,JTRAJ,JDEJA,JTRAS,ICPR
          NSOU1=NSOU-1
          DO 65 NS=1,NSOU1
          MSOUMA=MATTA1.LISATT(NS)
          IF(MSOUMA.NE.0) SEGSUP MSOUMA
   65     CONTINUE
          SEGSUP MATTA1
          MATTA1=0
          RETURN
        ELSE
          N=NI
          SEGADJ MSOUMA
          IGEOCH=0
          IPHYCH=0
          ITYATT='MECA'
          SEGDES MSOUMA
        ENDIF
      ENDIF
  70  CONTINUE
C
      N=NSOU
      SEGADJ MATTA1
C
      IF(IIMPI.EQ.1) THEN
      WRITE(IOIMP,105) MATTA1
  105 FORMAT(/,10X,' CREATION DE L''OBJET ATTACHE ',I4///)
      NATTA=MATTA1.LISATT(/1)
      WRITE(IOIMP,101)
  101 FORMAT(10X,28('*'))
      WRITE(IOIMP,102)
  102 FORMAT(10X,'* MSOUMA * ITYATT * IATREL *')
      WRITE(IOIMP,101)
      DO 90 IL=1,NATTA
      MSOUMA=MATTA1.LISATT(IL)
      SEGACT MSOUMA
      WRITE(IOIMP,103) MSOUMA,ITYATT,IATREL(1)
  103 FORMAT(10X,'*  ',I4,'  *  ',A4,'  *  ',I4,'  *  ')
      NRELA=IATREL(/1)
      DO 80 IN=2,NRELA
      WRITE(IOIMP,104) IATREL(IN)
  104 FORMAT(10X,2('*        '),'*  ',I4,'  *')
   80 CONTINUE
      SEGDES MSOUMA
      WRITE(IOIMP,101)
   90 CONTINUE
      ENDIF
      SEGDES MATTA1
      SEGSUP JTRAJ,JDEJA,ICPR,JTRAS,JTRAK
      WRITE(IOIMP,*) ' FIN DE ELFTRI '
      RETURN
      END