Télécharger operfl.eso

Retour à la liste

Numérotation des lignes :

  1. C OPERFL SOURCE BP208322 16/05/24 21:15:12 8932
  2.  
  3. C=======================================================================
  4. C
  5. C CONVERTIT : - UN ENTIER EN FLOTTANT
  6. C - OU UN LISTENTI/MOT/LISTMOTS EN LISTREEL
  7. C
  8. C=======================================================================
  9.  
  10. SUBROUTINE OPERFL
  11. IMPLICIT REAL*8 (A-H,O-Z)
  12. IMPLICIT INTEGER(I-N)
  13.  
  14. -INC CCOPTIO
  15.  
  16. c REAL*8 X1
  17. c CHARACTER*32 CH
  18. REAL*8 XVALRE
  19. CHARACTER*32 CHARIN
  20. CHARACTER*8 CHA8
  21.  
  22.  
  23. C=======================================================================
  24. C LECTURE DES OBJETS EN ENTREE + CONVERSION EN FLOTTANT
  25. C=======================================================================
  26.  
  27. CALL QUETYP(CHA8,0,IRETOU)
  28. IF (IRETOU.EQ.0) GOTO 998
  29.  
  30. * Conversion d'un LISTENTI en LISTREEL
  31. IF (CHA8.EQ.'LISTENTI') THEN
  32. CALL LIROBJ('LISTENTI',MLENTI,1,IRETOU)
  33. IF (IERR.NE.0) RETURN
  34. c SEGACT MLENTI
  35. c JG=LECT(/1)
  36. c SEGINI MLREEL
  37. c DO IG=1,JG
  38. c PROG(IG)=LECT(IG)
  39. c ENDDO
  40. c SEGDES MLREEL
  41. c SEGDES MLENTI
  42. IOBIN=MLENTI
  43. CALL FLOT(CHA8,IVALIN,CHARIN,IOBIN,XVALRE,IOBRE)
  44. MLREEL=IOBRE
  45. CALL ECROBJ('LISTREEL',MLREEL)
  46. RETURN
  47.  
  48. * Conversion d'un ENTIER ou d'un FLOTTANT en FLOTTANT
  49. c ELSEIF (CHA8.EQ.'ENTIER'.OR.CHA8.EQ.'FLOTTANT') THEN
  50. c CALL LIRREE(X1,1,IRETOU)
  51. c IF (IERR.NE.0) RETURN
  52. c CALL ECRREE(X1)
  53. c RETURN
  54. * Conversion d'un ENTIER en FLOTTANT : on passe par FLOT
  55. ELSEIF (CHA8.EQ.'ENTIER') THEN
  56. CALL LIRENT(IVALIN,1,IRETOU)
  57. IF (IERR.NE.0) RETURN
  58. CALL FLOT(CHA8,IVALIN,CHARIN,IOBIN,XVALRE,IOBRE)
  59. CALL ECRREE(XVALRE)
  60. RETURN
  61. * Conversion d'un FLOTTANT en FLOTTANT : on ne passe pas dans FLOT !
  62. ELSEIF (CHA8.EQ.'FLOTTANT') THEN
  63. CALL LIRREE(XVALRE,1,IRETOU)
  64. IF (IERR.NE.0) RETURN
  65. CALL ECRREE(XVALRE)
  66. RETURN
  67.  
  68. * Conversion d'un LISTMOTS en LISTREEL
  69. ELSEIF (CHA8.EQ.'LISTMOTS') THEN
  70. CALL LIROBJ('LISTMOTS',MLMOTS,1,IRETOU)
  71. IF (IERR.NE.0) RETURN
  72. c SEGACT MLMOTS
  73. c JG=MOTS(/2)
  74. c SEGINI MLREEL
  75. c DO IG=1,JG
  76. c READ(MOTS(IG),FMT='(F4.0)',ERR=999) PROG(IG)
  77. c ENDDO
  78. c SEGDES MLREEL
  79. c SEGDES MLMOTS
  80. IOBIN=MLMOTS
  81. CALL FLOT(CHA8,IVALIN,CHARIN,IOBIN,XVALRE,IOBRE)
  82. MLREEL=IOBRE
  83. CALL ECROBJ('LISTREEL',MLREEL)
  84. RETURN
  85.  
  86. * Conversion d'un MOT en FLOTTANT
  87. ELSEIF (CHA8.EQ.'MOT') THEN
  88. c CALL LIRCHA(CH,1,IRETOU)
  89. c WRITE(CHA8,FMT='("(F",I2,".0)")') IRETOU
  90. c READ(CH(1:IRETOU),FMT=CHA8,ERR=999) X1
  91. CALL LIRCHA(CHARIN,1,IVALIN)
  92. IF (IERR.NE.0) RETURN
  93. CALL FLOT(CHA8,IVALIN,CHARIN,IOBIN,XVALRE,IOBRE)
  94. CALL ECRREE(XVALRE)
  95. RETURN
  96.  
  97. ENDIF
  98.  
  99.  
  100. C=======================================================================
  101. C ERREURS
  102. C=======================================================================
  103.  
  104. * /!\ ERREUR : AUCUN OBJET COMPATIBLE TROUVE
  105. 998 MOTERR(1:40)='ENTIER FLOTTANTLISTENTIMOT LISTMOTS'
  106. CALL ERREUR(471)
  107. RETURN
  108.  
  109.  
  110. c * /!\ ERREUR LORS DE LA CONVERSION MOT=>FLOTTANT
  111. c 999 CALL ERREUR(21)
  112. c RETURN
  113.  
  114. END
  115.  
  116.  
  117.  
  118.  
  119.  

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