C ISUCC SOURCE PV 21/12/18 07:15:07 11240 C---------------------------------------------------------------------| C | INTEGER FUNCTION ISUCC(JF,JP) C | C CETTE FONCTION ENTIERE REVOIE LE SUCCESSEUR DU POINT JP | C DANS LA FACETTE JF | C | C---------------------------------------------------------------------| C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC TDEMAIT -INC PPARAM -INC CCOPTIO C DO 100 I=1,4 IF (NFC(I,JF).EQ.JP) GOTO 110 100 CONTINUE IF (IVERB.EQ.1) WRITE (6,*) ' ISUCC PAS DE SUCCESSEUR A ',JP, & ' DANS ',JF IF (IVERB.EQ.1) write (6,*) ' liste des facettes restantes ' DO 444 I=1,NFCMAX IF (IFAT(I).EQ.1) GOTO 444 IF (IVERB.EQ.1) WRITE(6,*) I,NFC(1,I),NFC(2,I),NFC(3,I),NFC(4,I) 444 CONTINUE i=100000000 nfc(1,i)=1 * CALL ERRTRA C isucc=0 return STOP 110 I=I+1 IF (I.EQ.5) I=1 IS=NFC(I,JF) IF (IS.EQ.0) IS=NFC(1,JF) ISUCC=IS RETURN C FIN DE LA FONCTION ISUCC END