C J3FAFA    SOURCE    CHAT      05/01/13    00:46:41     5004
      SUBROUTINE J3FAFA(WWORK1,WWORK2,TOL,IRET,ICAS,VWORK1,VWORK2)
C----------------------------------------------------
C     TRAITEMENANT DU FACE A FACE (2D)
C
C     VWORK1: NOUVELLES FACES DEJA TRAITEES
C     VWORK2: NOUVELLES FACES A TRAITEES
C
C     CODE IST(1,I): 0 point non traite
C                    1 est sur le segment IST(2,I)
C                    2 est sur les segments IST(2,I) et IST(3,I)
C                   -1 est a l'interieur
C                   -2 est a l'exterieur
C
C     CODE CRO(J,I): 1 cote sur le segment
C                   -1 cote interieur
C                   -2 cote exterieur
C
C     PP 6/97
C     Pierre Pegon/JRC Ispra
C----------------------------------------------------
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC PPARAM
-INC CCOPTIO
      SEGMENT VWORK
        INTEGER FWWORK(NFACE)
      ENDSEGMENT
      POINTEUR VWORK1.VWORK,VWORK2.VWORK,VWDUMM.VWORK
C
      SEGMENT WWORK
        REAL*8 PORIG(3),VNORM(3),VI(3),VJ(3)
        INTEGER FWORK
        INTEGER TWORK(NTROU)
      ENDSEGMENT
      POINTEUR WWORK1.WWORK,WWORK2.WWORK
C
      SEGMENT WORK
        REAL*8 XYC(2,NPTO)
        INTEGER IST(3,NPTO)
        REAL*8 DENS(NPTO)
        INTEGER JUN
      ENDSEGMENT
      POINTEUR WORK1.WORK,WORK2.WORK,WORK3.WORK
C
      SEGMENT JUNC
        INTEGER CRO(2,NPTO)
      ENDSEGMENT
C
      LOGICAL LAINB,LAOUB,LAONB,LACUB,LBINA,LBOUA,LBONA
      LOGICAL LCAINB,LCAOUB,LCAONB,LCBINA,LCBOUA,LCBONA
      LOGICAL LPLAN
C
      IF (IIMPI.EQ.1789)THEN
        WRITE(IOIMP,*)'>>> On entre dans j3fafa <<<'
      ENDIF
C
      VWORK1=0
      VWORK2=0
      IRET=0
C
C     ON REGARDE SI LES FACES SONT DANS LE MEME PLAN
C       SI OUI, ON ALIGNE LES POINTS
C       SI NON, ON SORT AVEC UN CAS 1
C
      CALL J3COPL(WWORK1,WWORK2,LPLAN,TOL)
      IF (.NOT.LPLAN)THEN
        ICAS=1
        IF (IIMPI.EQ.1789)THEN
          WRITE(IOIMP,*)' >>> traitement de 2 faces non coplanaires <<<'
        ENDIF
        RETURN
      ENDIF
      IF (IIMPI.EQ.1789)THEN
          WRITE(IOIMP,*)' >>> face A <<<'
          CALL J3LIWW(WWORK1)
          WRITE(IOIMP,*)' >>> face B <<<'
          CALL J3LIWW(WWORK2)
      ENDIF
C
C     ON COMMENCE PAR TRAITER LES CONTOURS EXTERIEURS
C
      WORK1=WWORK1.FWORK
      WORK2=WWORK2.FWORK
      CALL J3COTO(WORK2,WORK1,TOL,IRET)
      IF (IRET.GT.0)THEN
        RETURN
      ENDIF
      CALL J3COTO(WORK1,WORK2,TOL,IRET)
      IF (IRET.GT.0)THEN
        RETURN
      ENDIF
C
C     ON REGARDE SI 1 POINT DE A EST STRICTEMENT DANS B OU HORS DE B
C        OU SUR B
C
      NPTO1=WORK1.XYC(/2)
      CALL J3TES1(WORK1.IST,NPTO1,LAINB,LAOUB,LAONB,NAONB)
C
C     ON REGARDE SI 1 POINT DE B EST STRICTEMENT DANS A OU HORS DE A
C        OU SUR A
C
      NPTO2=WORK2.XYC(/2)
      CALL J3TES1(WORK2.IST,NPTO2,LBINA,LBOUA,LBONA,NBONA)
C
C     ON S'OCCUPE TOUT D'ABORD DU CAS OU A ET B SONT COMPLETEMENT DISJOINTS
C     ==> ON ELIMINE LA SEULE POSSIBILITE DE CAS 3 STRICT ET UNE DE CAS 1 ET 2
C
      LACUB=.FALSE.
      IF(LAOUB.AND.(.NOT.LAONB))THEN
        IF(LAINB)THEN
          IRAISO=1
          GOTO 9999
        ENDIF
        IF(LBINA)THEN
          IF(LBOUA)THEN
            IRAISO=2
            GOTO 9999
          ENDIF
          GOTO 3
        ELSE
          IF(.NOT.LBOUA)THEN
            IRAISO=3
            GOTO 9999
          ENDIF
          GOTO 1
        ENDIF
      ENDIF
C
      IF((.NOT.LAOUB).AND.(.NOT.LAONB))THEN
        IF((.NOT.LAINB).OR.(.NOT.LBOUA))THEN
          IRAISO=4
          GOTO 9999
        ENDIF
        GOTO 2
      ENDIF
C
C     POUR CONTINUER IL FAUT SAVOIR VRAIMENT SI ON COUPE
C
      CALL J3JUNC(WORK1,WORK2,TOL,IRET)
      IF (IRET.GT.0)THEN
        RETURN
      ENDIF
      JUNC=WORK1.JUN
      CALL J3TES2(CRO,NPTO1,LCAINB,LCAOUB,LCAONB)
      LACUB=LCAINB.AND.LCAOUB
C
C     ET SI ON RECOUPE!
C
      CALL J3JUNC(WORK2,WORK1,TOL,IRET)
      IF (IRET.GT.0)THEN
        RETURN
      ENDIF
      JUNC=WORK2.JUN
      CALL J3TES2(CRO,NPTO2,LCBINA,LCBOUA,LCBONA)
C
C     ON FINIT LE CAS 1
C
      IF((.NOT.LCAINB).AND.(.NOT.LCBINA).AND.LCAOUB.AND.LCBOUA)GOTO 1
C
C     ON FINIT LE CAS 2
C
      IF(.NOT.LCAOUB) GOTO 2
C
C     ON S'OCCUPE DU CAS 4
C
      IF(LACUB)GOTO 4
C
C     ON S'OCCUPE DU 4 "TANGENT" ET DU "FAUX" 3
C
      IF((.NOT.LCAINB).AND.(.NOT.LCBOUA).AND.LAONB)THEN
        IF(NAONB.EQ.1)THEN
          GOTO 3
        ELSE
          GOTO 4
        ENDIF
      ENDIF
C

      IRAISO=5
      GOTO 9999
C
C     CAS NO. 1: ON NE FAIT RIEN
C
 1    ICAS=1
C
      IF (IIMPI.EQ.1789)THEN
        WRITE(IOIMP,*)'    >>> traitement d"un cas no.1 <<<'
      ENDIF
C
      RETURN
C
C     CAS NO. 2: ON CONTROLE LES TROUS
C
 2    ICAS=2
C
      IF (IIMPI.EQ.1789)THEN
        WRITE(IOIMP,*)'    >>> traitement d"un cas no.2 <<<'
      ENDIF
C
      NTROU1=WWORK1.TWORK(/1)
      NTROU2=WWORK2.TWORK(/1)
      IF(NTROU1.NE.0)THEN
        WRITE(IOIMP,*)'CAS 2: face A avec trrrou'
        IRAISO=21
        GOTO 9999
      ENDIF
C
C      SI PAS DE TROU DANS B... ON VERIFIE SI A N'EST PAS EGAL A B
C      ET SI OUI ON LE REND IDENTIQUE
C
      IF(NTROU2.EQ.0)THEN
        IF(NTROU1.EQ.0)THEN
          CALL J3IDEN(WORK1,WORK2,TOL)
          WWORK1.FWORK=WORK1
          RETURN
        ELSE
          IRAISO=22
          GOTO 9999
        ENDIF
C
C      ... SINON ON REMPLACE B PAR LES TROUS DE B
C
      ELSE
        DO 20 IE1=1,NTROU2
          WORK2=WWORK2.TWORK(IE1)
          CALL J3COTO(WORK2,WORK1,TOL,IRET)
          IF (IRET.GT.0)THEN
            RETURN
          ENDIF
          CALL J3COTO(WORK1,WORK2,TOL,IRET)
          IF (IRET.GT.0)THEN
            RETURN
          ENDIF
C
C       2 SEULS CAS A VERIFIER: CAS 1 DISJOINT (A SANS TROU)
C                               CAS 2
C         SINON ERREUR
C
          NPTO1=WORK1.XYC(/2)
          CALL J3TES1(WORK1.IST,NPTO1,LAINB,LAOUB,LAONB,NAONB)
C
          NPTO2=WORK2.XYC(/2)
          CALL J3TES1(WORK2.IST,NPTO2,LBINA,LBOUA,LBONA,NBONA)
C
          IF(LAOUB.AND.(.NOT.LAONB))THEN
            IF(LAINB.OR.LBINA.OR.(.NOT.LBOUA).OR.(NTROU1.NE.0))THEN
              IRAISO=23
              GOTO 9999
            ENDIF
            GOTO 20
          ENDIF
C
          IF((.NOT.LAOUB).AND.(.NOT.LAONB))GOTO 20
C
          CALL J3JUNC(WORK1,WORK2,TOL,IRET)
          IF (IRET.GT.0)THEN
            RETURN
          ENDIF
          JUNC=WORK1.JUN
          CALL J3TES2(CRO,NPTO1,LCAINB,LCAOUB,LCAONB)
          LACUB=LCAINB.AND.LCAOUB
          IF(.NOT.LCAOUB) GOTO 20
          IRAISO=24
          GOTO 9999
 20     CONTINUE
      ENDIF
C
      RETURN
C
C     CAS NO. 3: D'ABORD ON VERIFIE QUE B N'A PAS DE TROU
C
 3    ICAS=3
C
      IF (IIMPI.EQ.1789)THEN
        WRITE(IOIMP,*)'    >>> traitement d"un cas no.3 <<<'
      ENDIF
C
      NTROU2=WWORK2.TWORK(/1)
      IF(NTROU2.NE.0)THEN
        IRAISO=31
        GOTO 9999
      ENDIF
C
C       ON CREE UNE NOUVELLE FACE (RECOPIE DE WORK2)
C
      NFACE=1
      SEGINI,VWORK1
      SEGINI,WWORK=WWORK2
      VWORK1.FWWORK(1)=WWORK
      SEGINI,WORK=WORK2
      JUN=0
      FWORK=WORK
C
C       ON AJOUTE ENSUITE UN TROU A A QUE L'ON MET EN PREMIERE
C       POSITION (ON INVERSE LA NUMEROTATION DE B)
C
      NTROU1=WWORK1.TWORK(/1)+1
      NTROU=NTROU1
      SEGADJ,WWORK1
      IF (NTROU1.GT.1)THEN
        DO IE1=NTROU1,2,-1
          WWORK1.TWORK(IE1)=WWORK1.TWORK(IE1-1)
        ENDDO
      ENDIF
C
      SEGINI,WORK1=WORK2
      WORK1.JUN=0
      NPTO1=NPTO2
      CALL J3ORIE(1,WORK1.XYC,WORK1.DENS,NPTO1,-1,TOL,IRET)
      IF(IRET.NE.0)THEN
        IRAISO=32
        GOTO 9999
      ENDIF
      WWORK1.TWORK(1)=WORK1
C
C       SI UN SEUL TROU ON SORT
C
      IF(NTROU1.EQ.1)RETURN
C
C       ON VERIFIE QUE CE NOUVEAU TROU EST UN CAS 1 VIS A VIS DES
C       AUTRES TROUS DE A (ATTENTION, ON COMPTE LE NB DE CAS AVEC
C                          CONTACT EN 1 SEUL POINT)
C
      DO 30 IE1=2,NTROU1
        WORK2=WWORK1.TWORK(IE1)
        IF(WORK2.EQ.0)GOTO 30
        CALL J3COTO(WORK2,WORK1,TOL,IRET)
        IF (IRET.GT.0)THEN
          RETURN
        ENDIF
        CALL J3COTO(WORK1,WORK2,TOL,IRET)
        IF (IRET.GT.0)THEN
          RETURN
        ENDIF
C
        NPTO1=WORK1.XYC(/2)
        CALL J3TES1(WORK1.IST,NPTO1,LAINB,LAOUB,LAONB,NAONB)
C
        NPTO2=WORK2.XYC(/2)
        CALL J3TES1(WORK2.IST,NPTO2,LBINA,LBOUA,LBONA,NBONA)
C
C       A-T-ON UN CAS 1 DISJOINT? (SI OUI ON PASSE AU TROU SUIVANT)
C
        IF(LAOUB.AND.(.NOT.LAONB))THEN
          IF(LAINB.OR.LBINA.OR.(.NOT.LBOUA))THEN
            IRAISO=33
            GOTO 9999
          ENDIF
          GOTO 30
        ENDIF
C
C       A-T-ON UN CAS 1 AVEC CONTACT ? (SI OUI ON COALESCE)
C       (ATTENTION, ON EXCLUT LE CONTACT PONCTUEL EN 1 SEUL POINT))
C       WARNING UN CAS 2 SEMBLE LICITE!!!!!!!!
C
        IF((.NOT.LAOUB).AND.(.NOT.LAONB))THEN
          IF((.NOT.LAINB).OR.(.NOT.LBOUA))THEN
            IRAISO=34
            GOTO 9999
          ENDIF
          SEGSUP,WORK,WWORK,VWORK1,WORK1
          WWORK1.TWORK(1)=0
          ICAS=1
          GOTO 31
        ENDIF
C
        CALL J3JUNC(WORK1,WORK2,TOL,IRET)
        IF (IRET.GT.0)THEN
          RETURN
        ENDIF
        JUNC=WORK1.JUN
        NPTO1=WORK1.XYC(/2)
        CALL J3TES2(CRO,NPTO1,LCAINB,LCAOUB,LCAONB)
        LACUB=LCAINB.AND.LCAOUB
C
        CALL J3JUNC(WORK2,WORK1,TOL,IRET)
        IF (IRET.GT.0)THEN
          RETURN
        ENDIF
        NPTO2=WORK2.XYC(/2)
        JUNC=WORK2.JUN
        CALL J3TES2(CRO,NPTO2,LCBINA,LCBOUA,LCBONA)
C
        IF((.NOT.LCAINB).AND.(.NOT.LCBINA).AND.LCAOUB.AND.LCBOUA)THEN
          IF(NAONB.EQ.1)GOTO 30
          CALL J3COAL(WORK1,WORK2,LCAONB,VWORK,NFACEA,TOL,IRET)
          IF(IRET.GT.0)THEN
            RETURN
          ELSE
            JUNC=WORK2.JUN
            IF(JUNC.NE.0)SEGSUP,JUNC
            SEGSUP,WORK2
            WWORK1.TWORK(1)=WORK1
            WWORK1.TWORK(IE1)=0
          ENDIF
C
C       ATTENTION UNE DES NFACEA FACES EVENTUELLEMENT CREES PEUT
C       CONTENIR STRICTEMENT UN DES TROU DE A QUI DEVIENT UN TROU DE LA
C       NOUVELLE FACE
C
          IF(NFACEA.GT.0)THEN
            CALL J3HEAD(WWORK1,VWORK)
            CALL J3COAK(WWORK1,VWORK,TOL,IRET)
            CALL J3VPLU(VWORK2,VWORK)
          ENDIF
        ELSE
C
C       ON EJECTE UN CAS 2 AVEC CONTACT QUI EST LICITE
C
          IF (.NOT.LCAOUB)THEN
            SEGSUP,WORK,WWORK,VWORK1,WORK1
            WWORK1.TWORK(1)=0
            ICAS=1
            GOTO 31
          ENDIF
          IRAISO=35
          GOTO 9999
        ENDIF
 30   CONTINUE
C
C       ON REDUIT LE TWORK DE A DU NOMBRE DE COALESCENCE
C
 31   CALL J3REDU(WWORK1)
C
C
      RETURN
C
C     CAS NO. 4: ON CONTROLE LES TROU DE B
C
 4    ICAS=4
C
      IF (IIMPI.EQ.1789)THEN
        WRITE(IOIMP,*)'    >>> traitement d"un cas no.4 <<<'
      ENDIF
C
      NTROU2=WWORK2.TWORK(/1)
      IF(NTROU2.NE.0)THEN
        IRAISO=41
        GOTO 9999
      ENDIF
C
C     ON COUPE A PAR B ET ON GARDE LA PARTIE INTERIEURE (SANS
C     REDISTRIBUTION DES TROU) DANS VWORK1.
C
      CALL J3COUP(WWORK1,WORK2,VWORK1,VWORK,0,TOL,IRET)
      IF (IRET.GT.0)THEN
        IRAISO=42
        GOTO 9999
      ENDIF
      CALL J3HEAD(WWORK1,VWORK1)
C
C     S'IL N'Y A PAS DE TROU DANS A ON SAUTE DIRECTEMENT
C     APRES LA PHASE DE SECONDE COUPE
C
      NTROU1=WWORK1.TWORK(/1)
      IF(NTROU1.EQ.0)GOTO 45
      CALL J3DET1(VWORK)
C
C     S'IL Y A DES TROU DANS A, ILS DOIVENT ETRE DES CAS 1 VIS A VIS
C     DE B ET EVENTUELLEMENT COHALESCER AVEC B ET DONC ON COMMENCE PAR
C     INVERSER B DANS WORK1, ENSUITE ON CONTINUE COMME DANS CAS 3
C
      SEGINI,WORK1=WORK2
      WORK1.JUN=0
      NPTO1=NPTO2
      CALL J3ORIE(1,WORK1.XYC,WORK1.DENS,NPTO1,-1,TOL,IRET)
      IF(IRET.NE.0)THEN
        RETURN
      ENDIF
C
C     WARNING: ON PROCEDE "B PAR RAPPORT A A" POUR FINIR AVEC LE MEME NB DE
C       POINTS EN CAS DE COALESCENCE"
C
      DO 40 IE1=1,NTROU1
        WORK2=WWORK1.TWORK(IE1)
        IF(WORK2.EQ.0)GOTO 40
        CALL J3COTO(WORK2,WORK1,TOL,IRET)
        IF (IRET.GT.0)THEN
          RETURN
        ENDIF
        CALL J3COTO(WORK1,WORK2,TOL,IRET)
        IF (IRET.GT.0)THEN
          RETURN
        ENDIF
C
        NPTO1=WORK1.XYC(/2)
        CALL J3TES1(WORK1.IST,NPTO1,LAINB,LAOUB,LAONB,NAONB)
C
        NPTO2=WORK2.XYC(/2)
        CALL J3TES1(WORK2.IST,NPTO2,LBINA,LBOUA,LBONA,NBONA)
C
C       A-T-ON UN CAS 1 DISJOINT? (SI OUI ON PASSE AU TROU SUIVANT)
C
        IF(LAOUB.AND.(.NOT.LAONB))THEN
          IF(LAINB.OR.LBINA.OR.(.NOT.LBOUA))THEN
            IRAISO=43
            GOTO 9999
          ENDIF
          GOTO 40
        ENDIF
C
C       A-T-ON UN CAS 1 AVEC CONTACT? (SI OUI ON COALESCE)
C       (ATTENTION, ON EXCLUT LE CONTACT PONCTUEL EN 1 SEUL POINT)
C
        IF((.NOT.LAOUB).AND.(.NOT.LAONB))THEN
          IRAISO=43
          GOTO 9999
        ENDIF
C
        CALL J3JUNC(WORK1,WORK2,TOL,IRET)
        IF (IRET.GT.0)THEN
          RETURN
        ENDIF
        JUNC=WORK1.JUN
        NPTO1=WORK1.XYC(/2)
        CALL J3TES2(CRO,NPTO1,LCAINB,LCAOUB,LCAONB)
        LACUB=LCAINB.AND.LCAOUB
C
        CALL J3JUNC(WORK2,WORK1,TOL,IRET)
        IF (IRET.GT.0)THEN
          RETURN
        ENDIF
        NPTO2=WORK2.XYC(/2)
        JUNC=WORK2.JUN
        CALL J3TES2(CRO,NPTO2,LCBINA,LCBOUA,LCBONA)
C
        IF((.NOT.LCAINB).AND.(.NOT.LCBINA).AND.LCAOUB.AND.LCBOUA)THEN
          IF(NAONB.EQ.1)GOTO 40
          CALL J3JUNC(WORK2,WORK1,TOL,IRET)
          CALL J3COAL(WORK1,WORK2,LCAONB,VWORK,NFACEA,TOL,IRET)
          IF(IRET.GT.0)THEN
            RETURN
          ELSE
            JUNC=WORK2.JUN
            IF(JUNC.NE.0)SEGSUP,JUNC
            SEGSUP,WORK2
            WWORK1.TWORK(IE1)=0
          ENDIF

C       ATTENTION UNE DES NFACEA FACES EVENTUELLEMENT CREES PEUT
C       CONTENIR STRICTEMENT UN DES TROU DE A QUI DEVIENT UN TROU DE LA
C       NOUVELLE FACE
C
          IF(NFACEA.GT.0)THEN
            CALL J3HEAD(WWORK1,VWORK)
            CALL J3COAK(WWORK1,VWORK,TOL,IRET)
            CALL J3VPLU(VWORK2,VWORK)
          ENDIF
        ELSE
          IRAISO=44
          GOTO 9999
        ENDIF
 40   CONTINUE
C
C       ON REDUIT LE TWORK DE A DU NOMBRE DE COALESCENCE
C
      CALL J3REDU(WWORK1)
C
C     ON INVERSE MAINTENANT LA NUMEROTATION DE WORK1 DANS WORK2
C
      WORK2=WORK1
      NPTO2=WORK2.XYC(/2)
      CALL J3ORIE(1,WORK2.XYC,WORK2.DENS,NPTO2,1,TOL,IRET)
C PP?  CALL J3ORIE(1,WORK2.XYC,WORK2.DENS,NPTO2,-1,TOL,IRET)
      IF(IRET.NE.0)THEN
        IRAISO=45
        GOTO 9999
      ENDIF
C
C     ON REMET A DANS WORK1 ET ON REFAIT LES TESTS
C
      WORK1=WWORK1.FWORK
      CALL J3COTO(WORK2,WORK1,TOL,IRET)
      IF(IRET.NE.0)THEN
        IRAISO=46
        GOTO 9999
      ENDIF
      CALL J3COTO(WORK1,WORK2,TOL,IRET)
      IF(IRET.NE.0)THEN
        IRAISO=47
        GOTO 9999
      ENDIF
      CALL J3JUNC(WORK1,WORK2,TOL,IRET)
      IF(IRET.NE.0)THEN
        IRAISO=48
        GOTO 9999
      ENDIF
C
C     C'EST ICI QUE L'ON RE-COUPE (A EST DANS WORK1 ET B COHALESCE
C     DANS WORK2)
C
C     ON REGARDE D'ABORD EGALEMENT COMMENT B COUPE A
C
      CALL J3JUNC(WORK2,WORK1,TOL,IRET)
      IF(IRET.NE.0)THEN
        IRAISO=49
        GOTO 9999
      ENDIF
C
C     PUIS ON COUPE (ON NE S'INTERESSE QUE A LA PARTIE
C     EXTERIEURE VWORK)
C
      WWORK1.FWORK=WORK1
      CALL J3COUP(WWORK1,WORK2,VWDUMM,VWORK,1,TOL,IRET)
      CALL J3DET1(VWDUMM)
C
 45   CALL J3HEAD(WWORK1,VWORK)
      CALL J3VPLU(VWORK2,VWORK)
C
      RETURN
C
C     CONFIGURATION IMPOSSIBLE
C
 9999 CONTINUE
      WRITE(IOIMP,*)' J3FAFA: CONFIGURATION IMPOSSIBLE NO.',IRAISO
      IRET=IRET+1
      RETURN
C
      END