Télécharger isucc.eso

Retour à la liste

Numérotation des lignes :

  1. C ISUCC SOURCE JC220346 16/11/29 21:15:25 9221
  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. IF (IVERB.EQ.1) WRITE (6,*) ' ISUCC PAS DE SUCCESSEUR A ',JP,
  20. & ' DANS ',JF
  21. IF (IVERB.EQ.1) write (6,*) ' liste des facettes restantes '
  22. DO 444 I=1,NFCMAX
  23. IF (IFAT(I).EQ.1) GOTO 444
  24. IF (IVERB.EQ.1) WRITE(6,*) I,NFC(1,I),NFC(2,I),NFC(3,I),NFC(4,I)
  25. 444 CONTINUE
  26. i=100000000
  27. nfc(1,i)=1
  28. * CALL ERRTRA
  29. C
  30. return
  31. STOP
  32. 110 I=I+1
  33. IF (I.EQ.5) I=1
  34. IS=NFC(I,JF)
  35. IF (IS.EQ.0) IS=NFC(1,JF)
  36. ISUCC=IS
  37. RETURN
  38. C FIN DE LA FONCTION ISUCC
  39. END
  40.  
  41.  
  42.  
  43.  

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