Télécharger signe.eso

Retour à la liste

Numérotation des lignes :

  1. C SIGNE SOURCE CHAT 05/01/13 03:18:04 5004
  2. SUBROUTINE SIGNE
  3. ************************************************************************
  4. *
  5. * S I G N E
  6. * ---------
  7. *
  8. * SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "SIGNE"
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * DONNER LE SIGNE D'UN NOMBRE.
  14. *
  15. * PHRASE D'APPEL (EN GIBIANE):
  16. * ----------------------------
  17. *
  18. * | (ENTIER) |
  19. * II = SIGNE | | AA ;
  20. * | FLOTTANT |
  21. *
  22. * LES PARENTHESES INDIQUANT UN OPERANDE FACULTATIF.
  23. *
  24. * OPERANDES ET RESULTATS:
  25. * -----------------------
  26. *
  27. * AA 'FLOTTANT' ) NOMBRE DONT ON CHERCHE LE SIGNE.
  28. * OU 'ENTIER ' )
  29. * ENTIER 'MOT ' MOT-CLE INDIQUANT QUE LE RESULTAT "II" SERA
  30. * DE TYPE 'ENTIER'.
  31. * FLOTTANT 'MOT ' MOT-CLE INDIQUANT QUE LE RESULTAT "II" SERA
  32. * DE TYPE 'FLOTTANT'.
  33. * II NOMBRE EGAL A +1 OU -1.
  34. * TYPE 'ENTIER' PAR DEFAUT.
  35. *
  36. * SOUS-PROGRAMMES APPELES:
  37. * ------------------------
  38. *
  39. * LIRE, LIRTYP, ECRIRE.
  40. *
  41. * AUTEUR, DATE DE CREATION:
  42. * -------------------------
  43. *
  44. * PASCAL MANIGOT 19 FEVRIER 1985
  45. *
  46. * LANGAGE:
  47. * --------
  48. *
  49. * FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS
  50. *
  51. ************************************************************************
  52. *
  53. IMPLICIT INTEGER(I-N)
  54. -INC CCOPTIO
  55. *
  56. PARAMETER (NBTYPE = 2)
  57. *
  58. *
  59. REAL*8 RSIGNE
  60. CHARACTER*(8) CTYP
  61. *
  62. REAL*8 REELDP
  63. CHARACTER*(8) CMOT
  64. *
  65. *
  66. * LECTURE DU TYPE DU RESULTAT:
  67. ICODE = 0
  68. CALL LIRCHA (CMOT,ICODE,LUMOT)
  69. IF(LUMOT.EQ.0) CMOT ='ENTIER'
  70. IF (LUMOT.NE.0 ) THEN
  71. IF(CMOT.NE.'ENTIER '.AND.CMOT.NE.'FLOTTANT') THEN
  72. CALL REFUS
  73. ENDIF
  74. ENDIF
  75. *
  76. * LECTURE DU NOMBRE:
  77. CALL QUETYP(CTYP,0,IRETOU)
  78. IF(IRETOU.EQ.0) THEN
  79. CALL ERREUR ( 533)
  80. RETURN
  81. ENDIF
  82. IF(CTYP.NE.'ENTIER '.AND.CTYP.NE.'FLOTTANT') CALL ERREUR(15)
  83. IF (IERR .NE. 0) RETURN
  84. ISIGNE=1
  85. IF(CTYP.EQ.'ENTIER ') THEN
  86. CALL LIRENT(IENT,1,IRETOU)
  87. IF(IENT.LT.0) ISIGNE=-1
  88. ELSE
  89. CALL LIRREE(REELDP,1,IRETOU)
  90. IF(REELDP.LT.0D0) ISIGNE=-1
  91. ENDIF
  92. *
  93. IF (CMOT.EQ.'ENTIER ') THEN
  94. CALL ECRENT (ISIGNE)
  95. ELSE
  96. RSIGNE=ISIGNE
  97. CALL ECRREE (RSIGNE)
  98. END IF
  99. *
  100. END
  101.  
  102.  

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