Esope source files

   1 : C REPSUB    SOURCE    PV        07/10/05    21:16:30     5890           
   2 : C---------------------------------------------------------------------|         
   3 : C                                                                     |         
   4 :         SUBROUTINE REPSUB(JF)                                                   
   5 : C                                                                     |         
   6 : C      CETTE SUBROUTINE ENLEVE LA FACETTE JF DU MAILLAGE DE           |         
   7 : C      SURFACE (TABLEAU NPF) SI ELLE Y APPARTIENT ET L'Y AJOUTE       |         
   8 : C      DANS LE CAS CONTRAIRE                                          |         
   9 : C      ELLE MET EGALEMENT A JOUR LE TABLEAU IFUT DES FACETTES UTILES  |         
  10 : C                                                                     |         
  11 : C---------------------------------------------------------------------|         
  12 : C                                                                               
  13 :       IMPLICIT INTEGER(I-N)
  14 :       IMPLICIT REAL*8(A-H,O-Z)
  15 : -INC TDEMAIT                                                                    
  16 : -INC CCOPTIO                                                                    
  17 : C                                                                               
  18 :          I=IFAT(JF)
  19 :          IF (I.EQ.0) GOTO 190
  20 :   20     IFUT(I)=IFUT(NFACET)                                                   
  21 :          IFAT(IFUT(I))=I
  22 :          IFAT(JF)=0
  23 :          NFACET=NFACET-1                                                        
  24 : C                                                                               
  25 :         DO 30 I=1,4                                                             
  26 :                JP=NFC(I,JF)                                                     
  27 :                 IF (JP.EQ.0) GOTO 30                                            
  28 :                DO 40 J=1,40
  29 :                       IF (NPF(J,JP).EQ.JF) GOTO 50                              
  30 :   40           CONTINUE                                                         
  31 :            write (6,*) ' REPSUB ',' incoherente ',jf
  32 :            k=100000000
  33 :            nfc(1,k)=1
  34 :   50           DO 60 K=J,39
  35 :                       NPF(K,JP)=NPF(K+1,JP)                                     
  36 :   60           CONTINUE                                                         
  37 :                NPF(40,JP)=0
  38 :   30    CONTINUE                                                                
  39 : C                                                                               
  40 : *      WRITE(6,1000)JF,NFACET                                                   
  41 : 1000   FORMAT(' SUBF:',I3,'   NFACET=',I2)                                      
  42 : C                                                                               
  43 :         RETURN                                                                  
  44 : C      FIN DE LA PARTIE SUPPRESSION DE FACETTE                                  
  45 :  190   CONTINUE                                                                 
  46 : C  LA FACETTE N'ETAIT PAS LA ON LA REPERTORIE                                   
  47 : C                                                                               
  48 :        NFTOT=IFUT(/1)                                                           
  49 :        NFACET=NFACET+1                                                          
  50 :        IF (JF.GE.NFTOT) WRITE (6,*) '  REP  NOMBRE MAXI DE ',                   
  51 :      # 'FACETTES ATTEINT => JF,NFTOT ',JF,NFTOT                                 
  52 : C                                                                               
  53 : C                                                                               
  54 :        DO 200 I=1,4                                                             
  55 :            IP=NFC(I,JF)                                                         
  56 :             IF (IP.EQ.0) GOTO 200                                               
  57 :           DO 210 J=1,40
  58 :            if (NPF(J,IP).eq.jf) then
  59 :              write (6,*) ' REPSUB ',' incoherent-2 ',jf
  60 :        write (6,*) ' liste des facettes restantes '
  61 :        DO 444 k=1,NFCMAX
  62 :         IF (IFAT(k).EQ.1) GOTO 444
  63 :         WRITE (6,*)  k,NFC(1,k),NFC(2,k),NFC(3,k),NFC(4,k)
  64 :  444  CONTINUE                                                                  
  65 :        write (6,*) ' liste de NPF  '
  66 :        DO 445 k=1,Nptmax
  67 :         WRITE (6,*)  k,(npf(l,k),l=1,40)
  68 :  445  CONTINUE
  69 :        write (6,*) ' liste de ifat et ifut'
  70 :        DO 446 k=1,ifat(/1)
  71 :         WRITE (6,*)  k,ifat(k),ifut(k)
  72 :  446  CONTINUE
  73 :              k=100000000
  74 :              nfc(1,k)=1
  75 :            endif
  76 :              IF (NPF(J,IP).NE.0) GOTO 210                                       
  77 :              NPF(J,IP)=JF                                                       
  78 :              GOTO 200                                                           
  79 : 210       CONTINUE                                                              
  80 :        WRITE (6,*) ' REP NOMBRE  MAXIMUM DE FACETTES TOUCHANT UN ',             
  81 :      #   'POINT ATTEINT '                                                       
  82 : 200    CONTINUE                                                                 
  83 : C                                                                               
  84 :         IFUT(NFACET)=JF                                                         
  85 :         IFAT(JF)=NFACET
  86 : C                                                                               
  87 : C                                                                               
  88 : *      WRITE(6,1200)JF,(NFC(I,JF),I=1,4)                                        
  89 : 1200   FORMAT(' REP:',I3,' ::',4I4)                                             
  90 : C                                                                               
  91 :        RETURN                                                                   
  92 :        END                                                                      
  93 :  
  94 :