Télécharger la plaquette Cast3M


fr en

Télécharger signe.eso

Retour à la liste

Numérotation des lignes : 

signe

  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.  
  55. -INC PPARAM
  56. -INC CCOPTIO
  57. *
  58.       PARAMETER (NBTYPE = 2)
  59. *
  60. *
  61.       REAL*8 RSIGNE
  62.       CHARACTER*(8) CTYP
  63. *
  64.       REAL*8 REELDP
  65.       CHARACTER*(8) CMOT
  66. *
  67. *
  68. *     LECTURE DU TYPE DU RESULTAT:
  69.       ICODE = 0
  70.       CALL LIRCHA (CMOT,ICODE,LUMOT)
  71.       IF(LUMOT.EQ.0)  CMOT ='ENTIER'
  72.       IF (LUMOT.NE.0 ) THEN
  73.            IF(CMOT.NE.'ENTIER   '.AND.CMOT.NE.'FLOTTANT') THEN
  74.            CALL REFUS
  75.            ENDIF
  76.       ENDIF
  77. *
  78. *     LECTURE DU NOMBRE:
  79.       CALL QUETYP(CTYP,0,IRETOU)
  80.       IF(IRETOU.EQ.0) THEN
  81.          CALL ERREUR ( 533)
  82.          RETURN
  83.       ENDIF
  84.       IF(CTYP.NE.'ENTIER   '.AND.CTYP.NE.'FLOTTANT') CALL ERREUR(15)
  85.       IF (IERR .NE. 0) RETURN
  86.       ISIGNE=1
  87.       IF(CTYP.EQ.'ENTIER  ') THEN
  88.        CALL LIRENT(IENT,1,IRETOU)
  89.        IF(IENT.LT.0) ISIGNE=-1
  90.        ELSE
  91.         CALL LIRREE(REELDP,1,IRETOU)
  92.         IF(REELDP.LT.0D0) ISIGNE=-1
  93.       ENDIF
  94. *
  95.       IF (CMOT.EQ.'ENTIER   ') THEN
  96.          CALL ECRENT (ISIGNE)
  97.       ELSE
  98.          RSIGNE=ISIGNE
  99.          CALL ECRREE (RSIGNE)
  100.       END IF
  101. *
  102.       END
  103.  
  104.  

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