Esope source files

   1 : C ISUCC     SOURCE    PV        07/10/05    21:16:08     5890           
   2 : C---------------------------------------------------------------------|         
   3 : C                                                                     |         
   4 :        INTEGER FUNCTION ISUCC(JF,JP)                                            
   5 : C                                                                     |         
   6 : C      CETTE FONCTION ENTIERE REVOIE LE SUCCESSEUR DU POINT JP        |         
   7 : C      DANS LA FACETTE JF                                             |         
   8 : C                                                                     |         
   9 : C---------------------------------------------------------------------|         
  10 : C                                                                               
  11 :       IMPLICIT INTEGER(I-N)
  12 :       IMPLICIT REAL*8(A-H,O-Z)
  13 : -INC TDEMAIT                                                                    
  14 : -INC CCOPTIO                                                                    
  15 : C                                                                               
  16 :        DO 100 I=1,4                                                             
  17 :               IF (NFC(I,JF).EQ.JP) GOTO 110                                     
  18 : 100    CONTINUE                                                                 
  19 :        WRITE (6,*) ' ISUCC PAS DE SUCCESSEUR A ',JP,' DANS ',JF                 
  20 :        write (6,*) ' liste des facettes restantes '
  21 :        DO 444 I=1,NFCMAX                                                        
  22 :         IF (IFAT(I).EQ.1) GOTO 444                                              
  23 :         WRITE (6,*)  I,NFC(1,I),NFC(2,I),NFC(3,I),NFC(4,I)
  24 :  444  CONTINUE                                                                  
  25 :        i=100000000
  26 :        nfc(1,i)=1
  26 : *      CALL ERRTRA                                                              
  27 : C                                                                               
  28 :        return
  29 :        STOP                                                                     
  30 : 110    I=I+1                                                                    
  31 :        IF (I.EQ.5) I=1                                                          
  32 :        IS=NFC(I,JF)                                                             
  33 :        IF (IS.EQ.0) IS=NFC(1,JF)                                                
  34 :       ISUCC=IS                                                                  
  35 :        RETURN                                                                   
  36 : C      FIN DE LA FONCTION ISUCC                                                 
  37 :        END                                                                      
  38 :  
  39 :