Esope source files

   1 : C OPERIN    SOURCE    JC220346  12/06/19    21:15:05     7405           
   2 : C   CONVERTIT UN FLOTTANT EN ENTIER
   3 : C   OU UN LISTREEL EN LISTENTI
   4 : C
   5 :       SUBROUTINE OPERIN
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 :       IMPLICIT INTEGER(I-N)
   8 : -INC CCOPTIO
   9 : -INC SMLENTI
  10 : -INC SMLREEL
  11 : -INC SMLMOTS
  12 :       REAL*8 X1
  13 :       CHARACTER*32 CH
  14 :       CHARACTER*8  CHA8
  15 : 
  16 : 
  16 :       CALL QUETYP(CHA8,0,IRETOU)
  17 :       IF (IRETOU.EQ.0) GOTO 998
  18 : 
  19 : 
  20 : *     Conversion d'un LISTREEL en LISTENTI
  21 :       IF (CHA8.EQ.'LISTREEL') THEN
  21 :           CALL LIROBJ('LISTREEL',MLREEL,1,IRETOU)
  22 :           SEGACT MLREEL
  23 :           JG=PROG(/1)
  24 :           SEGINI MLENTI
  25 :           DO IG=1,JG
  26 :               LECT(IG)=int(PROG(IG))
  27 :           ENDDO
  28 :           SEGDES MLREEL
  29 :           SEGDES MLENTI
  29 :           CALL ECROBJ('LISTENTI',MLENTI)
  30 :           RETURN
  31 : 
  32 : 
  33 : *     Conversion d'un LISTMOTS en LISTENTI
  34 :       ELSEIF (CHA8.EQ.'LISTMOTS') THEN
  34 :           CALL LIROBJ('LISTMOTS',MLMOTS,1,IRETOU)
  35 :           SEGACT MLMOTS
  36 :           JG=MOTS(/2)
  37 :           SEGINI MLENTI
  38 :           DO IG=1,JG
  39 :               READ(MOTS(IG),FMT='(I4)',IOSTAT=IOS) LECT(IG)
  40 :               IF (IOS.NE.0) THEN
  41 :                   READ(MOTS(IG),FMT='(F4.0)',ERR=999) X1
  42 :                   LECT(IG)=int(X1)
  43 :               ENDIF
  44 :           ENDDO
  45 :           SEGDES MLENTI
  46 :           SEGDES MLMOTS
  46 :           CALL ECROBJ('LISTENTI',MLENTI)
  47 :           RETURN
  48 : 
  49 : 
  50 : *     Conversion d'un MOT en ENTIER
  51 :       ELSEIF (CHA8.EQ.'MOT') THEN
  51 :           CALL LIRCHA(CH,1,IRETOU)
  52 :           WRITE(CHA8,FMT='("(I",I2,")")') IRETOU
  53 :           READ(CH(1:IRETOU),FMT=CHA8,IOSTAT=IOS) I1
  54 :           IF (IOS.NE.0) THEN
  55 :               WRITE(CHA8,FMT='("(F",I2,".0)")') IRETOU
  56 :               READ(CH(1:IRETOU),FMT=CHA8,ERR=999) X1
  57 :               I1=int(X1)
  58 :           ENDIF
  58 :           CALL ECRENT(I1)
  59 :           RETURN
  60 : 
  61 : 
  62 : *     Conversion d'un FLOTTANT en ENTIER
  63 :       ELSEIF (CHA8.EQ.'ENTIER'.OR.CHA8.EQ.'FLOTTANT') THEN
  63 :           CALL LIRREE(X1,1,IRETOU)
  64 :           IF (IERR.NE.0) RETURN
  65 :           I1=int(X1)
  65 :           CALL ECRENT(I1)
  66 :           RETURN
  67 : 
  68 :       ENDIF
  69 : 
  70 : 
  71 : * /!\ ERREUR : AUCUN OBJET COMPATIBLE TROUVE
  72 :  998  MOTERR(1:40)='ENTIER  FLOTTANTLISTENTIMOT     LISTMOTS'
  72 :       CALL ERREUR(471)
  73 :       RETURN
  74 : 
  75 : 
  76 : * /!\ ERREUR LORS DE LA CONVERSION MOT=>FLOTTANT
  76 :  999  CALL ERREUR(21)
  77 :       RETURN
  78 : 
  79 :       END
  80 : 
  81 :