Sources Esope | Cast3M

j3surf
C J3SURF    SOURCE    CHAT      05/01/13    00:47:33     5004
      SUBROUTINE J3SURF(VWORK1,TOL)
C----------------------------------------------------
C     ELIMINATION DES CAS TORDUS POUR SURF
C
C     PP 9/97
C     Pierre Pegon/JRC Ispra
C----------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION XY(2)
C
-INC PPARAM
-INC CCOPTIO
C
      SEGMENT VWORK
        INTEGER FWWORK(NFACE)
      ENDSEGMENT
      POINTEUR VWORK1.VWORK
C
      SEGMENT WWORK
        REAL*8 PORIG(3),VNORM(3),VI(3),VJ(3)
        INTEGER FWORK
        INTEGER TWORK(NTROU)
      ENDSEGMENT
C
      SEGMENT WORK
        REAL*8 XYC(2,NPTO)
        INTEGER IST(3,NPTO)
        REAL*8 DENS(NPTO)
        INTEGER JUN
      ENDSEGMENT
      POINTEUR WORK1.WORK, WORK2.WORK
C
C     ON RENTRE AVEC DES ENSEMBLE DE VWORK REPRESENTANT CHACUN
C     UN BLOCK COMPOSE DE FACE
C
      NBLOCK=VWORK1.FWWORK(/1)
C
C     ON BOUCLE SUR CHAQUE BLOCK
C
      DO IE1=1,NBLOCK
        VWORK=VWORK1.FWWORK(IE1)
        NFACE=FWWORK(/1)
C
C     ON BOUCLE SUR CHAQUE FACE
C
        DO IE2=1,NFACE
          WWORK=FWWORK(IE2)
          NTROU=TWORK(/1)
C
C     S'IL Y A DES TROUS, ON FAIT QUELQUE CHOSE ....
C
          IF(NTROU.GT.0)THEN
            IF(IIMPI.EQ.1790)THEN
              WRITE(IOIMP,*)'J3SURF: FACE A TRAITER'
              CALL J3LIWW(WWORK)
            ENDIF
C
C     S'IL Y A PLUSIEURS TROUS AVEC UN PT COMMUN, ON LES COHALESCE
C
            IF(NTROU.GT.1)THEN
C
C     A) SIMULATION DE "DO 10 IE3=1,NTROU-1" AVEC NTROU VARIABLE
C
              IE3=0
 1            IE3=IE3+1
              IF(IE3.GE.NTROU)GOTO 10
                WORK1=TWORK(IE3)
                NPTO1=WORK1.DENS(/1)
C
C     B) BOUCLE SUR LES POINTS DU TROU QUE L'ON CHARGE DANS XY
C
                DO IE4=1,NPTO1
                  IPO1=IE4
                  XY(1)=WORK1.XYC(1,IE4)
                  XY(2)=WORK1.XYC(2,IE4)
C
C     C) BOUCLE SUR LES TROUS RESTANTS
C
                  DO IE5=IE3+1,NTROU
                    IF5=IE5
                    WORK2=TWORK(IE5)
                    NPTO2=WORK2.DENS(/1)
                    CALL J3NOCO(XY,WORK2.XYC,NPTO2,TOL,IPO2)
                    IF(IPO2.NE.0)GOTO 2
                  ENDDO
C
                ENDDO
C
                GOTO 1
C
C     D) COHALESCENCE DES TROUS WORK1 ET WORK2
C
 2              NPTO=NPTO1+NPTO2
                SEGADJ,WORK1
                DO IE4=NPTO,IPO1+NPTO2,-1
                  WORK1.DENS(IE4)=WORK1.DENS(IE4-NPTO2)
                  WORK1.XYC(1,IE4)=WORK1.XYC(1,IE4-NPTO2)
                  WORK1.XYC(2,IE4)=WORK1.XYC(2,IE4-NPTO2)
                ENDDO
                DO IE4=IPO1,IPO1+NPTO2-1
                  JE4=IE4-IPO1+IPO2
                  IF(JE4.GT.NPTO2)JE4=JE4-NPTO2
                  WORK1.DENS(IE4)=WORK2.DENS(JE4)
                  WORK1.XYC(1,IE4)=WORK2.XYC(1,JE4)
                  WORK1.XYC(2,IE4)=WORK2.XYC(2,JE4)
                ENDDO
C
C     E) SUPPRESSION DE WORK2
C
                SEGSUP,WORK2
C
C     F) ON REPASSE DANS LA MOULINETTE EN REORGANISANT TWORK
C
                IF(IF5.NE.NTROU)THEN
                  DO IE4=IF5,NTROU-1
                    TWORK(IE4)=TWORK(IE4+1)
                  ENDDO
                ENDIF
                NTROU=NTROU-1
                SEGADJ,WWORK
                IE3=IE3-1
                GOTO 1
C
 10           CONTINUE
C
C     FIN DU CAS A PLUSIEURS TROUS
C
            ENDIF
C
C     ON CONSIDERE MAINTENANT LE CONTOURS PRINCIPAL
C
            WORK1=FWORK
            NPTO1=WORK1.DENS(/1)
C
C     SI L'UN DES TROUS A UN POINT COMMUN, ON COHALESCE
C
C     A) SIMULATION DE "DO 20 IE3=1,NTROU" AVEC NTROU VARIABLE
C
            IE3=0
 11         IE3=IE3+1
            IF(IE3.GT.NTROU)GOTO 20
              WORK2=TWORK(IE3)
              NPTO2=WORK2.DENS(/1)
C
C     B) BOUCLE SUR LES POINTS DE WORK1 QUE L'ON CHARGE DANS XY
C
              DO IE4=1,NPTO1
                IPO1=IE4
                XY(1)=WORK1.XYC(1,IE4)
                XY(2)=WORK1.XYC(2,IE4)
                CALL J3NOCO(XY,WORK2.XYC,NPTO2,TOL,IPO2)
                IF(IPO2.NE.0)GOTO 12
              ENDDO
C
              GOTO 11
C
C     C) COHALESCENCE DU TROU WORK2 AVEC WORK1
C
 12           NPTO=NPTO1+NPTO2
              SEGADJ,WORK1
              DO IE4=NPTO,IPO1+NPTO2,-1
                WORK1.DENS(IE4)=WORK1.DENS(IE4-NPTO2)
                WORK1.XYC(1,IE4)=WORK1.XYC(1,IE4-NPTO2)
                WORK1.XYC(2,IE4)=WORK1.XYC(2,IE4-NPTO2)
              ENDDO
              DO IE4=IPO1,IPO1+NPTO2-1
                JE4=IE4-IPO1+IPO2
                IF(JE4.GT.NPTO2)JE4=JE4-NPTO2
                WORK1.DENS(IE4)=WORK2.DENS(JE4)
                WORK1.XYC(1,IE4)=WORK2.XYC(1,JE4)
                WORK1.XYC(2,IE4)=WORK2.XYC(2,JE4)
              ENDDO
C
C     D) SUPPRESSION DE WORK2
C
              SEGSUP,WORK2
C
C     E) ON REPASSE DANS LA MOULINETTE EN REORGANISANT TWORK
C
              IF(IE3.NE.NTROU)THEN
                DO IE4=IE3,NTROU-1
                  TWORK(IE4)=TWORK(IE4+1)
                ENDDO
              ENDIF
              NTROU=NTROU-1
              SEGADJ,WWORK
              IE3=IE3-1
              GOTO 11
C
 20         CONTINUE
C
C     FIN DU CAS A TROU
C
            IF(IIMPI.EQ.1790)THEN
              WRITE(IOIMP,*)'J3SURF: FACE APRES TRAITEMENT'
              CALL J3LIWW(WWORK)
            ENDIF
          ENDIF
C
C     FIN BOUCLE FACE
C
        ENDDO
C
C     FIN BOUCLE BLOCK
C
      ENDDO
C
      RETURN
      END