Télécharger la plaquette Cast3M


fr en

Télécharger operfl.eso

Retour à la liste

Numérotation des lignes : 

operfl

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

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