Sources Esope | Cast3M

repsub
C REPSUB    SOURCE    JC220346  16/11/29    21:15:33     9221           
C---------------------------------------------------------------------|
C                                                                     |
        SUBROUTINE REPSUB(JF)
C                                                                     |
C      CETTE SUBROUTINE ENLEVE LA FACETTE JF DU MAILLAGE DE           |
C      SURFACE (TABLEAU NPF) SI ELLE Y APPARTIENT ET L'Y AJOUTE       |
C      DANS LE CAS CONTRAIRE                                          |
C      ELLE MET EGALEMENT A JOUR LE TABLEAU IFUT DES FACETTES UTILES  |
C                                                                     |
C---------------------------------------------------------------------|
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC TDEMAIT
 
-INC PPARAM
-INC CCOPTIO
C
         I=IFAT(JF)
         IF (I.EQ.0) GOTO 190
  20     IFUT(I)=IFUT(NFACET)
         IFAT(IFUT(I))=I
         IFAT(JF)=0
         NFACET=NFACET-1
C
        DO 30 I=1,4
               JP=NFC(I,JF)
                IF (JP.EQ.0) GOTO 30
               DO 40 J=1,40
                      IF (NPF(J,JP).EQ.JF) GOTO 50
  40           CONTINUE
           IF (IVERB.EQ.1) write (6,*) ' REPSUB ',' incoherente ',jf
           k=100000000
           nfc(1,k)=1
  50           DO 60 K=J,39
                      NPF(K,JP)=NPF(K+1,JP)
  60           CONTINUE
               NPF(40,JP)=0
  30    CONTINUE
C
*      WRITE(6,1000)JF,NFACET
1000   FORMAT(' SUBF:',I3,'   NFACET=',I2)
C
        RETURN
C      FIN DE LA PARTIE SUPPRESSION DE FACETTE
 190   CONTINUE
C  LA FACETTE N'ETAIT PAS LA ON LA REPERTORIE
C
       NFTOT=IFUT(/1)
       NFACET=NFACET+1
       IF (JF.GE.NFTOT.AND.IVERB.EQ.1) 
     #  WRITE (6,*) '  REP  NOMBRE MAXI DE ',
     # 'FACETTES ATTEINT => JF,NFTOT ',JF,NFTOT
C
C
       DO 200 I=1,4
           IP=NFC(I,JF)
            IF (IP.EQ.0) GOTO 200
          DO 210 J=1,40
           if (NPF(J,IP).eq.jf) then
            IF (IVERB.EQ.1) THEN
             write (6,*) ' REPSUB ',' incoherent-2 ',jf
             write (6,*) ' liste des facettes restantes '
            ENDIF
       DO 444 k=1,NFCMAX
        IF (IFAT(k).EQ.1) GOTO 444
        IF (IVERB.EQ.1) 
     &        WRITE (6,*)  k,NFC(1,k),NFC(2,k),NFC(3,k),NFC(4,k)
 444  CONTINUE
       IF (IVERB.EQ.1) write (6,*) ' liste de NPF  '
       DO 445 k=1,Nptmax
        IF (IVERB.EQ.1) WRITE (6,*)  k,(npf(l,k),l=1,40)
 445  CONTINUE
       IF (IVERB.EQ.1) write (6,*) ' liste de ifat et ifut'
       DO 446 k=1,ifat(/1)
        IF (IVERB.EQ.1) WRITE (6,*)  k,ifat(k),ifut(k)
 446  CONTINUE
             k=100000000
             nfc(1,k)=1
           endif
             IF (NPF(J,IP).NE.0) GOTO 210
             NPF(J,IP)=JF
             GOTO 200
210       CONTINUE
          IF (IVERB.EQ.1) WRITE (6,*) ' REP NOMBRE  MAXIMUM DE ',
     #   'FACETTES TOUCHANT UN POINT ATTEINT '
200    CONTINUE
C
        IFUT(NFACET)=JF
        IFAT(JF)=NFACET
C
C
*      WRITE(6,1200)JF,(NFC(I,JF),I=1,4)
1200   FORMAT(' REP:',I3,' ::',4I4)
C
       RETURN
       END