Sources Esope | Cast3M

j3fac1
C J3FAC1    SOURCE    CHAT      05/01/13    00:46:38     5004
      SUBROUTINE J3FAC1(VWORK,TOL,IRET)
C----------------------------------------------------
C     TEST POUR LES FACES
C     PP 6/97
C     Pierre Pegon/JRC Ispra
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,VWORK3.VWORK,VWORK4.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 FUSE
        INTEGER BLFA(2,NFAMA)
      ENDSEGMENT
C
      NFAMA=50
      SEGINI,FUSE
C
C     ON RENTRE AVEC DES ENSEMBLE DE VWORK REPRESENTANT CHACUN
C     UN BLOCK COMPOSE DE FACE
C
      NBLOCK=FWWORK(/1)
C
C     ON BOUCLE SUR CHAQUE BLOCK ET SUR CHAQUE FACE ...
C
      DO IE1=1,NBLOCK
        VWORK1=FWWORK(IE1)
        NFACE1=VWORK1.FWWORK(/1)
C
C     INITIALISATION DES VALEURS DE DEBUT DE BOUCLE POUR LES
C     FACES DE TRAVAIL (BLFA(1,.)=DEBUT BLOCK, BLFA(2,.)=DEBUT FACE)
C
        IF(NFACE1.GT.NFAMA)THEN
          NFAMA=NFAMA+50
          SEGADJ,FUSE
        ENDIF
        DO KE1=1,NFACE1
          BLFA(1,KE1)=1
          BLFA(2,KE1)=1
        ENDDO
C
C      "DO 1 JE1=1,NFACE1"
C
        JE1=0
 1      JE1=JE1+1
        IF(JE1.GT.NFACE1)GOTO 2
C
          WWORK1=VWORK1.FWWORK(JE1)
C
C     ... QUE L'ON COMPARE AU AUTRES BLOCKS ET FACES
C
          DO 11 IE2=BLFA(1,JE1),NBLOCK
            IF(IE1.EQ.IE2)GOTO 11
            VWORK2=FWWORK(IE2)
            NFACE2=VWORK2.FWWORK(/1)
            DO 10 JE2=BLFA(2,JE1),NFACE2
              WWORK2=VWORK2.FWWORK(JE2)
C
C     ON APPEL FAFA
C
              CALL J3FAFA(WWORK1,WWORK2,TOL,IRET,ICAS,VWORK3,VWORK4)
              IF(IRET.NE.0)THEN
                RETURN
              ENDIF
C
C     ON OPERE DIFFERENTS TRAITEMENTS SELON LES CAS
C
              IF(ICAS.EQ.1)GOTO 10
C
              IF(ICAS.EQ.2)GOTO 1
C
              IF(ICAS.EQ.3)THEN
C
C        DANS LE CAS 3 ON AJOUTE 1(le trou)+N(les coalescences) FACES
C             LA FACE DE TRAVAIL SE RETOUVE EN JE1+1 ET DOIT CONTINUER
C             L'INSPECTION DES FACES A PARTIR DE LA AINSI QUE LES NOUVELLES
C             FACES
C
C        CONCATENATION DES FACES
                NFACE10=NFACE1
                CALL J3VPLU(VWORK3,VWORK1)
                VWORK1=VWORK3
                CALL J3VPLU(VWORK1,VWORK4)
                NFACE1=VWORK1.FWWORK(/1)
                FWWORK(IE1)=VWORK1
C
                IF(NFACE1.GT.NFAMA)THEN
                  NFAMA=NFAMA+50
                  SEGADJ,FUSE
                ENDIF
C        LES N FACES DE COALESCENCE AJOUTEE A LA FIN DOIVENT ETRE TRAITEES
C             A PARTIR DE LA FACE DE TEST COURRANTE
                IF(NFACE10+1.LT.NFACE1)THEN
                  DO KE1=NFACE10+2,NFACE1
                    BLFA(1,KE1)=IE2
                    BLFA(2,KE1)=JE2+1
                  ENDDO
                ENDIF
C        ON SHIFTE LES INDICES A PARTIR DE LA FACE COURANTE (JE1)
C
                DO KE1=NFACE10,JE1,-1
                  BLFA(1,KE1+1)=BLFA(1,KE1)
                  BLFA(2,KE1+1)=BLFA(2,KE1)
                ENDDO
C        ON MODIFIE LES INDICES DE LA FUTURE FACE COURRANTE (JE1+1)
C
                BLFA(1,JE1+1)=IE2
                BLFA(2,JE1+1)=JE2+1
                GOTO 1
              ENDIF
C
              IF(ICAS.EQ.4)THEN
C
C        DANS LE CAS 4 ON SUBSTITUE A LA FACE COURRANTE NFACE3 FACES
C        (intersection interne) ET ON AJOUTE NFACE4 FACES (intersection
C        externe et coalescence de trou). LES NFACE3 DOIVENT ETRE SAUTEES
C        LES NFACE4 NOUVELLES DOIVENT ETRE TRAITEES A PARTIR DES INDICES
C        COURRANTS.
C
C        AJOUT DES NFACE3 FACES: SHIFT D'INDICES
                NFACE3=VWORK3.FWWORK(/1)
                NFACE=NFACE1+NFACE3-1
                SEGADJ,VWORK1
                IF(NFACE.GE.JE1+NFACE3)THEN
                  DO KE1=NFACE,JE1+NFACE3,-1
                    VWORK1.FWWORK(KE1)=VWORK1.FWWORK(KE1-NFACE3+1)
                  ENDDO
                ENDIF
C        AJOUT DES NFACE3 FACES: AJOUT EFFECTIFS
                DO KE1=1,NFACE3
                  VWORK1.FWWORK(JE1-1+KE1)=VWORK3.FWWORK(KE1)
                ENDDO
                SEGSUP,VWORK3
C        AJOUT DES NFACE3 FACES A LA FIN
                NFACE4=VWORK4.FWWORK(/1)
                CALL J3VPLU(VWORK1,VWORK4)
                NFACE1=VWORK1.FWWORK(/1)
                FWWORK(IE1)=VWORK1
C        GESTION DES LIMITES
                IF(NFACE1.GT.NFAMA)THEN
                  NFAMA=NFAMA+50
                  SEGADJ,FUSE
                ENDIF
                IF(NFACE.GE.JE1+NFACE3)THEN
                  DO KE1=NFACE,JE1+NFACE3,-1
                    BLFA(1,KE1)=BLFA(1,KE1-NFACE3+1)
                    BLFA(2,KE1)=BLFA(2,KE1-NFACE3+1)
                  ENDDO
                ENDIF
                DO KE1=NFACE1-NFACE4+1,NFACE1
                  BLFA(1,KE1)=IE2
                  BLFA(2,KE1)=JE2+1
                ENDDO
C
                JE1=JE1+NFACE3-1
                GOTO 1
              ENDIF
C
 10         CONTINUE
          BLFA(2,JE1)=1
 11       CONTINUE
C
        GOTO 1
 2    CONTINUE
C
      ENDDO
C
      SEGSUP,FUSE
C
      RETURN
      END