Numérotation des lignes :

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 CCOPTIOC         I=IFAT(JF)         IF (I.EQ.0) GOTO 190  20     IFUT(I)=IFUT(NFACET)         IFAT(IFUT(I))=I         IFAT(JF)=0         NFACET=NFACET-1C        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    CONTINUEC*      WRITE(6,1000)JF,NFACET1000   FORMAT(' SUBF:',I3,'   NFACET=',I2)C        RETURNC      FIN DE LA PARTIE SUPPRESSION DE FACETTE 190   CONTINUEC  LA FACETTE N'ETAIT PAS LA ON LA REPERTORIEC       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,NFTOTCC       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 200210       CONTINUE          IF (IVERB.EQ.1) WRITE (6,*) ' REP NOMBRE  MAXIMUM DE ',     #   'FACETTES TOUCHANT UN POINT ATTEINT '200    CONTINUEC        IFUT(NFACET)=JF        IFAT(JF)=NFACETCC*      WRITE(6,1200)JF,(NFC(I,JF),I=1,4)1200   FORMAT(' REP:',I3,' ::',4I4)C       RETURN       END    

© Cast3M 2003 - Tous droits réservés.
Mentions légales