C PRDIFF    SOURCE    MAUGIS    07/10/10    21:15:09     5889           
C    INTERFACE ENTRE LA DIRECTIVE "DIFF" (DIFFERENCE SYMETRIQUE) ET LE
C    SOUS PROGRAMME OUEXCL
C
      SUBROUTINE PRDIFF
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO
-INC SMELEME
      CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
      CALL LIROBJ('MAILLAGE',IPT2,1,IRETOU)
      IF (IERR.NE.0) RETURN
      SEGACT IPT1,IPT2
      IF (IPT1.LISOUS(/1).NE.0) GOTO 10
      IF (IPT2.LISOUS(/1).NE.0) GOTO 11

C     Deux maillages simples
      IF (IPT1.ITYPEL.NE.IPT2.ITYPEL) GOTO 1
C     Deux maillages simples de même type
      IF (IPT1.NUM(/1).NE.IPT2.NUM(/1)) GOTO 1

C---- Les deux maillages sont simples, de même type et même nombre de point par maille
C     1) Les deux maillages sont identiques : résultat vide

      IF (IPT1.EQ.IPT2) THEN
         NBELEM=0
         NBNN=0
         NBREF=0
         NBSOUS=0
         SEGINI IPT3
         IPT3.ITYPEL = 1
         GOTO 1000
      ENDIF

      CALL OUEXCL(IPT1,IPT2,IPT3)
      IF (IERR.NE.0) RETURN

C     2) le résultat est vide
      IF (IPT3.EQ.0) THEN
         NBELEM=0
         NBNN=0
         NBREF=0
         NBSOUS=0
         SEGINI IPT3
         IPT3.ITYPEL = 1
         GOTO 1000
      ENDIF

C     3) le résultat est non vide
      GOTO 1000


C     Adjonction directe des deux sous-maillages simples de structure différente
   1  CONTINUE
      NBELEM=0
      NBNN=0
      NBREF=0
      NBSOUS=2
      SEGINI IPT3
      IPT3.LISOUS(1)=IPT1
      IPT3.LISOUS(2)=IPT2
      GOTO 1000

  10  IF (IPT2.LISOUS(/1).NE.0) GOTO 20
      GOTO 12

C---- Un simple, l'autre complexe
C     On intervertit éventuellement pour que le premier soit le complexe
  11  IP=IPT2
      IPT2=IPT1
      IPT1=IP
  12  CONTINUE
C  IPT2 PAS DE SOUS-OBJETS  IPT1 EN A
      DO 13 IS=1,IPT1.LISOUS(/1)
         IPT4=IPT1.LISOUS(IS)
         SEGACT IPT4
         IF (IPT2.NUM(/1).EQ.IPT4.NUM(/1)) THEN
            IF (IPT2.ITYPEL.EQ.IPT4.ITYPEL) GOTO 14
         ENDIF
         SEGDES IPT4
  13  CONTINUE
      NBELEM=0
      NBNN=0
      NBREF=0
      NBSOU1=IPT1.LISOUS(/1)
      NBSOUS=NBSOU1+1
      SEGINI IPT3
      DO 15 IS=1,NBSOU1
         IPT3.LISOUS(IS)=IPT1.LISOUS(IS)
  15  CONTINUE
      IPT3.LISOUS(NBSOUS)=IPT2
      GOTO 1000
  14  IF (IPT2.EQ.IPT4) GOTO 17
      CALL OUEXCL(IPT2,IPT4,IPT5)
      if (ipt5.eq.0) goto 17
      SEGDES IPT4,IPT5
      IF (IERR.NE.0) RETURN

      NBSOUS=IPT1.LISOUS(/1)
      NBNN=0
      NBREF=0
      NBELEM=0
      SEGINI IPT3
      DO 16 IS2=1,NBSOUS
         IPT3.LISOUS(IS2)=IPT1.LISOUS(IS2)
         IF (IS.EQ.IS2) IPT3.LISOUS(IS2)=IPT5
  16  CONTINUE
      GOTO 1000

  17  SEGDES IPT4
      NBNN=0
      NBREF=0
      NBELEM=0
      NBSOUS=IPT1.LISOUS(/1)-1

C-------- Cas d'un maillage vide ---------------------------------

      IF (NBSOUS.EQ.0) THEN
         NBELEM=0
         NBNN=0
         NBREF=0
         NBSOUS=0
         SEGINI IPT3
         IPT3.ITYPEL = 1
         GOTO 1000
      ENDIF

      SEGINI IPT3
      IS3=0
      DO 18 IS2=1,(NBSOUS + 1)
         IF (IS2.EQ.IS) GOTO 18
         IS3=IS3+1
         IPT3.LISOUS(IS3)=IPT1.LISOUS(IS2)
  18  CONTINUE
      GOTO 1000

C---- Les deux maillages entrés sont complexes
  20  CONTINUE
      NBSOU1=IPT1.LISOUS(/1)
      NBSOU2=IPT2.LISOUS(/1)
      NBELEM=0
      NBNN=0
      NBREF=0
      NBSOUS=NBSOU1+NBSOU2
      SEGINI IPT4
      DO 21 I1=1,NBSOU1
         IPT4.LISOUS(I1)=IPT1.LISOUS(I1)
  21  CONTINUE
      ISUP=0
      DO 22 I2=1,NBSOU2
         IPT5=IPT2.LISOUS(I2)
         SEGACT IPT5
         ITYP=IPT5.ITYPEL
         DO 23 I1=1,NBSOU1
            IPT6=IPT4.LISOUS(I1)
            IF (IPT6.EQ.0) GOTO 23
            SEGACT IPT6
            IF (IPT6.ITYPEL.NE.ITYP) GOTO 24
            IF (IPT6.NUM(/1).NE.IPT5.NUM(/1)) GOTO 24
            IF (IPT5.EQ.IPT6) GOTO 25
            CALL OUEXCL(IPT5,IPT6,IPT7)
            IF (IPT7.EQ.0) GOTO 25
            SEGDES IPT5,IPT6
            IPT4.LISOUS(I1)=IPT7
            IPT4.LISOUS(NBSOU1+I2)=0
            ISUP=ISUP+1
            GOTO 22
  25        ISUP=ISUP+2
            IPT4.LISOUS(I1)=0
            IPT4.LISOUS(NBSOU1+I2)=0
            SEGDES IPT5,IPT6
            GOTO 22
  24        SEGDES IPT6
  23     CONTINUE
         IPT4.LISOUS(NBSOU1+I2)=IPT5
         SEGDES IPT5
  22  CONTINUE
      IF (ISUP.EQ.0) GOTO 30
      NBS=NBSOUS
      NBSOUS=NBSOUS-ISUP

C-------- Cas d'un maillage vide ---------------------------------

      IF (NBSOUS.EQ.0) THEN
         NBELEM=0
         NBNN=0
         NBREF=0
         NBSOUS=0
         SEGINI IPT3
         IPT3.ITYPEL = 1
         GOTO 1000
      ENDIF

      SEGINI IPT3
      JS=0
      DO 35 IS=1,NBSOUS
  36     JS=JS+1
         IF (IPT4.LISOUS(JS).EQ.0) GOTO 36
         IPT3.LISOUS(IS)=IPT4.LISOUS(JS)
  35  CONTINUE
      SEGSUP IPT4
      IF (NBSOUS.NE.1) GOTO 1000

      IPT4=IPT3.LISOUS(1)
      SEGSUP IPT3
  30  IPT3=IPT4
      SEGACT IPT3

c
c     Nettoyage du maillage dans le cas ou il contient des sous-parties vides
c
 1000 SEGDES IPT1,IPT2
      IF (IPT3.LISOUS(/1) .NE. 0) THEN
c       le maillage a plusieurs sous zones
        NBSOUS = IPT3.LISOUS(/1)
        DO 1010 I=1,IPT3.LISOUS(/1)
          MELEME = IPT3.LISOUS(I)
          SEGACT MELEME
          IF (NUM(/2) .EQ. 0) THEN
c
c          la sous partie est vide on va la supprimer
c          et tasser le tableau LISOUS
            DO 1020 J=I+1,IPT3.LISOUS(/1)
*              print *, 'on tasse'
              IPT3.LISOUS(J-1)=IPT3.LISOUS(J)
 1020       CONTINUE
c
            NBSOUS = NBSOUS - 1
           ENDIF
           SEGDES MELEME
 1010    CONTINUE
         IF (NBSOUS .NE. IPT3.LISOUS(/1)) THEN
           NBNN = 0
           NBELEM = 0
           NBREF = 0
           SEGADJ IPT3
*           print *, 'on ajuste'
         ENDIF
         IF ( NBSOUS .EQ. 1 )  IPT3 = IPT3.LISOUS(1)
       ENDIF
c
      SEGDES IPT3
      CALL ECROBJ('MAILLAGE',IPT3)
      RETURN

      END