Sources Esope | Cast3M

ouexcl
C OUEXCL    SOURCE    PV        20/03/30    21:21:53     10567          
      SUBROUTINE OUEXCL(IPT1,IPT2,MELEME)
*=============================================================
*
*  CE SOUS PROGRAMME REALISE L'OPERATION "OU EXCLUSIF" SUR DEUX LIGNES
*  IL INTERVIENT DANS LA FUSION DES CONTOURS DE DEUX OBJETS SURFACIQUE
*
*=============================================================
*
*  Création      : ???
*  Modifications : PM 05/10/2007
*                  gère les éléments dégénérés (à noeuds doubles)
*
*=============================================================
*
*  REMARQUES:
*
*=============================================================
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
-INC SMELEME
-INC SMCOORD
      SEGMENT INV(NBT)
      SEGMENT NINV(NBNO)
      SEGMENT NPOS(NBNO)
      SEGMENT ICPR(nbpts)
      SEGMENT IVU(NBVU)
 
      SEGACT IPT1,IPT2
 
*     Type d'élément incorrect ?
      IF (IPT1.ITYPEL .NE.IPT2.ITYPEL ) CALL ERREUR(16)
      IF (IPT1.NUM(/1).NE.IPT2.NUM(/1)) CALL ERREUR(16)
      IF (IERR.NE.0) RETURN
 
      NBREF  = 0
      NBNN   = IPT1.NUM(/1)
      NBELE1 = IPT1.NUM(/2)
      NBELE2 = IPT2.NUM(/2)
 
*     DETERMINATION DU NOMBRE DE NOEUDS
      SEGINI ICPR
      NBNO=0
      DO I=1,NBELE1
         DO 15 J=1,NBNN
            IPT=IPT1.NUM(J,I)
            IF (ICPR(IPT).NE.0) GOTO 15
            NBNO=NBNO+1
            ICPR(IPT)=NBNO
 15      CONTINUE
      ENDDO
 
*     NB MAX ELEMENTS TOUCHANT UN NOEUD
      SEGINI NINV,NPOS
      DO I=1,NBELE1
         DO J=1,NBNN
            NINV(ICPR(IPT1.NUM(J,I)))=NINV(ICPR(IPT1.NUM(J,I)))+1
         ENDDO
      ENDDO
      NBC=0
      NBT=0
      DO I=1,NBNO
         NBC=MAX(NBC,NINV(I))
         NPOS(I)=NBT
         NBT=NBT+NINV(I)
         NINV(I)=0
      ENDDO
      SEGINI INV
      DO I=1,NBELE1
         DO J=1,NBNN
            IPP=ICPR(IPT1.NUM(J,I))
            NINV(IPP)=NINV(IPP)+1
            INV(NPOS(IPP)+NINV(IPP))=I
         ENDDO
      ENDDO
 
*     Création table d'indicateur de noeud déjà trouvé
      NBVU=NBNN
      SEGINI, IVU
 
*     CREATION DE LA DIFFERENCE SYMETRIQUE
      NBSOUS=0
      NBELEM=NBELE1+NBELE2
      SEGINI MELEME
      DO I=1,NBELE1
         ICOLOR(I)=IPT1.ICOLOR(I)
         DO J=1,NBNN
            NUM(J,I)=IPT1.NUM(J,I)
         ENDDO
      ENDDO
 
      DO I=1,NBELE2
         ICOLOR(I+NBELE1)=IPT2.ICOLOR(I)
         DO J=1,NBNN
            NUM(J,I+NBELE1)=IPT2.NUM(J,I)
         ENDDO
      ENDDO
 
      DO 2 I=1,NBELE2
         DO J=1,NBNN
            IPP=ICPR(NUM(J,I+NBELE1))
            IF (IPP.EQ.0) GOTO 2
            DO 23 K=1,NINV(IPP)
               IEL=INV(NPOS(IPP)+K)
*              Comparaison des numéros de noeud de l'élément
*              ICOIN=nb de noeuds qui conviennent
               ICOIN=0
               DO M=1,NBNN
                  IVU(M)=0
               ENDDO
               DO 24 L=1,NBNN
                  DO M=1,NBNN
*PM                  On ne teste que les noeuds non encore identifiés.
                     IF (NUM(M,IEL).EQ.NUM(L,I+NBELE1) .AND.
     &                   IVU(M).EQ.0) THEN
                        ICOIN  = ICOIN + 1
                        IVU(M) = 1
                        GOTO 24
                     ENDIF
                  ENDDO
 24            CONTINUE
 
               IF (ICOIN.NE.NBNN) GOTO 23
*              Les deux élements coincident
               NUM(1,I+NBELE1)=-NUM(1,I+NBELE1)
               NUM(1,IEL)=-NUM(1,IEL)
               NBELEM=NBELEM-2
*              WRITE (6,*) ' COINCIDE ',I,IEL,NBELEM,NBELE1,NBELE2,NBNN
               GOTO 2
 23         CONTINUE
         ENDDO
 2    CONTINUE
 
      SEGSUP,ICPR,NINV,NPOS
 
*     RETASSER LE MELEME RÉSULTAT
      IPT3=MELEME
      MELEME=0
      IF(NBELEM.EQ.0) SEGSUP IPT3
      IF(NBELEM.EQ.0) RETURN
 
      SEGINI MELEME
      ITYPEL=IPT1.ITYPEL
C      SEGDES IPT1,IPT2
 
      J=1
      DO I=1,NBELEM
 51      IF (IPT3.NUM(1,J).GT.0) GOTO 52
         J=J+1
         GOTO 51
 52      DO K=1,NBNN
            NUM(K,I)=IPT3.NUM(K,J)
         ENDDO
         ICOLOR(I)=IPT3.ICOLOR(J)
         J=J+1
      ENDDO
 
      SEGSUP IPT3,INV,IVU
      RETURN
      END