Télécharger icalp.eso

Retour à la liste

Numérotation des lignes :

  1. C ICALP SOURCE BP208322 15/09/21 21:15:04 8627
  2. INTEGER FUNCTION ICALP (X,Y)
  3. *
  4. * X (E) : BORNE INF D'AXE
  5. * Y (E) : BORNE SUP D'AXE
  6. *
  7. * RETOURNE N TEL QUE X SOUS FORMAT X' *10 E N
  8. * AVEC 1 <ou= X' < 10
  9. * EXCEPTION 0
  10. *
  11. IMPLICIT INTEGER(I-N)
  12. IMPLICIT REAL*8 (A-H,O-Y)
  13. *
  14. if (x.gt.-1d50.and.x.lt.1d50) then
  15. if (y.gt.-1d50.and.y.lt.1d50) then
  16. *
  17. B=ABS(X)
  18. N=0
  19. IF (B.EQ.0.d0) GOTO 3
  20. 1 IF (B.LT.1.D0) THEN
  21. B=B*10
  22. N=N-1
  23. GOTO 1
  24. ENDIF
  25. 2 IF (B.GE.10.D0) THEN
  26. B=B/10
  27. N=N+1
  28. GOTO 2
  29. ENDIF
  30. *
  31. 3 N2=N
  32. B=ABS(Y)
  33. N=0
  34. IF (B.EQ.0.D0) GOTO 6
  35. 4 IF (B.LT.1.D0) THEN
  36. B=B*10
  37. N=N-1
  38. GOTO 4
  39. ENDIF
  40. 5 IF (B.GE.10.D0) THEN
  41. B=B/10
  42. N=N+1
  43. GOTO 5
  44. ENDIF
  45. 6 N1=N
  46. *
  47. * ON PREND L'EXPOSANT LE + GRAND, SAUF SI UNE BORNE EST 0
  48. IF (N1.GT.N2) THEN
  49. IF (Y.EQ.0.D0) THEN
  50. IP=N2
  51. ELSE
  52. IP=N1
  53. ENDIF
  54. ELSE
  55. IF (X.EQ.0.D0) THEN
  56. IP=N1
  57. ELSE
  58. IP=N2
  59. ENDIF
  60. ENDIF
  61.  
  62. * UN NOMBRE A 2 CHIFFRES ON LE LAISSE TEL QUEL
  63. IF (ABS(IP).EQ.1) IP=0
  64. * BP : on LAISSE AUSSI LES NOMBRES A 3 et 4 CHIFFRES :
  65. IF (IP.GT.0.AND.IP.LE.3) IP=0
  66.  
  67. ICALP=IP
  68. return
  69. *
  70. endif
  71. endif
  72. *
  73. END
  74.  
  75.  
  76.  
  77.  
  78.  
  79.  

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