C OBTENI    SOURCE    JC220346  18/12/04    21:15:53     9991           
      SUBROUTINE OBTENI
      IMPLICIT INTEGER(I-N)
      
-INC PPARAM
-INC CCNOYAU
-INC CCOPTIO
-INC CCREDLE
-INC SMLENTI
-INC SMLREEL
-INC CCASSIS

      CHARACTER*(8)     CHAR
      CHARACTER*(LONOM) CHARB,CNOMP
      CHARACTER*(LOCHAI) CHARC
C    CHARACTER*(LOCHAI) CMTEXT
      CHARACTER*4 MOAST(1)
      LOGICAL LOGI
      REAL*8 XPO
      CHARACTER*26 MINU,MAJU
      DATA MINU/'abcdefghijklmnopqrstuvwxyz'/
      DATA MAJU/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
      DATA MOAST/'*   '/
      
      IPASS=1
      MLENTI=0
      MLREEL=0
    1 CONTINUE
      CALL QUETYP (CHAR,IPASS,IRETOU)
      IF(IERR.NE.0) RETURN
      IF(IRETOU.EQ.0) GO TO 200
      IF(CHAR.EQ.'ENTIER  ')    THEN
          CALL LIRENT(IPO,1,IRETOU)
      ELSEIF(CHAR.EQ.'FLOTTANT')THEN
          CALL LIRREE(XPO,1,IRETOU)
      ELSEIF(CHAR.EQ.'MOT     ')THEN
          CALL LIRCHA(CHAR,1,IRETOU)
      ELSEIF(CHAR.EQ.'LOGIQUE ')THEN
          CALL LIRLOG(LOGI,1,IRETOU)
      ELSE
          CALL LIROBJ(CHAR,IPO,1,IRETOU)
      ENDIF
      CALL QUENOM(CHARB)
      CALL LIRMOT(MOAST,1,IVAL,0)
      CHAR=' '
      IF(IVAL.NE.0) THEN
      CALL LIRCHA(CHAR,1,IRETOU)
      IF(IERR.NE.0) RETURN
      ENDIF
      ICREA=0
      IF(IPASS.NE.1) GO TO 25
C
C  *** SAUVETAGE DE LA LECTURE
C
*        CMTEXT(1:500)=TEXT(1:500)
*        NRAN1=NRAN
*        ICOUR1=ICOUR
*        IFINA1=IFINAN
*        IPREC1=IPREC
         call inired(sredle)
         NRAN= 0
         IPREC=1
   20   CONTINUE
         NRAN=0
         IFINAN=73
         ICOUR=72
         READ(IOTER,FMT='(A72)',END=21) TEXT(1:72)
   25    CALL REDLEC(sredle)
         IF(IRE.EQ.0.AND.CHAR.EQ.'LISTENTI') THEN
           MOTERR(1:8) ='LISTENTI'
           CALL ERREUR(-290)
           READ(IOTER,FMT='(A72)',END=21) TEXT(1:72)
           NRAN=0
           IFINAN=73
           ICOUR=72
           CALL REDLEC(sredle)
           IF(IRE.EQ.0) THEN
             IF(MLENTI.EQ.0) THEN
              CALL NOMOBJ('ANNULE',CHARB,MLENTI)
             ELSE
              SEGDES MLENTI
              CALL NOMOBJ(CHAR,CHARB,MLENTI)
             ENDIF
             GO TO 200
           ENDIF
         ENDIF
         IF(IRE.EQ.0.AND.CHAR.EQ.'LISTREEL') THEN
           MOTERR(1:8) ='LISTREEL'
           CALL ERREUR(-290)
           READ(IOTER,FMT='(A72)',END=21) TEXT(1:72)
           NRAN=0
           IFINAN=73
           ICOUR=72
           CALL REDLEC(sredle)
           IF(IRE.EQ.0) THEN
            IF(MLREEL.EQ.0) THEN
              CALL NOMOBJ('ANNULE',CHARB,MLREEL)
             ELSE
              SEGDES MLREEL
              CALL NOMOBJ(CHAR,CHARB,MLREEL)
             ENDIF
             GO TO 200
           ENDIF
         ENDIF
         IF(IRE.EQ.0) GO TO 21
         IAVA=0
         IF(IRE.EQ.3) THEN
            DO 123 IAUX=1,NCAR
*  PASSAGE EN MAJUSCULE
            IRAL=INDEX(MINU,MOT(IAUX:IAUX))
            IF (IRAL.NE.0) MOT(IAUX:IAUX)=MAJU(IRAL:IRAL)
 123        CONTINUE
         ENDIF
         CALL PRENOM(IPLAMO,IAVA,sredle)
         if(nbesc.ne.0) segact ipiloc
         IP= INOOB1(IPLAMO)
         IDEBCH=IPCHAR(IP)
         IFINCH=IPCHAR(IP+1)-1
          CNOMP=ICHARA(IDEBCH:IFINCH)
         IF(IIMPI.EQ.1754) WRITE(IOIMP,654) CNOMP
     #   ,INOOB2(IPLAMO)
  654 FORMAT(' DANS OBTENI OBJET(1.5)  ',A8,2X,A8,2X,A4)
         IF(IIMPI.EQ.1754) WRITE(IOIMP,657)CHAR
  657  FORMAT(' DANS OBTENI  TYPE ATTENDU  ',A8)
         if(nbesc.ne.0) SEGDES,IPILOC

C
C  **** DECODAGE DE LA LECTURE ET VERIF DU TYPE
C
      IF(CNOMP.NE.'NON') GO TO 31
 210  CONTINUE
      CALL NOMOBJ('ANNULE',CHARB,ip1)
      GO TO 200
   31 CONTINUE
      IF(CHAR.EQ.'        ') CHAR=INOOB2(IPLAMO)
      IF(CHAR.EQ.'FLOTTANT'.AND.INOOB2(IPLAMO).EQ.'ENTIER  ') THEN
         IOO=IOUEP2(IPLAMO)
         XPO=IOO
           CALL NOMREE(CHARB,XPO)
         GO TO 465
      ENDIF
      IF(CHAR.EQ.'LISTREEL') THEN
         IF(ICREA.EQ.0) THEN
           JG=0
           SEGINI MLREEL
           ICREA=1
         ENDIF
         IF(INOOB2(IPLAMO) .NE . 'ENTIER  '.AND.
     $    INOOB2(IPLAMO) .NE . 'FLOTTANT' ) GO TO 54
          IOO=IOUEP2(IPLAMO)
         IF (INOOB2(IPLAMO).EQ.'ENTIER  ') THEN
         XPO=IOO
         ELSE
         if(nbesc.ne.0) segact ipiloc
         XPO= XIFLOT(IOO)
         if(nbesc.ne.0) SEGDES,IPILOC
         ENDIF
         JG=JG+1
         SEGADJ MLREEL
         PROG(JG)=XPO
         GO TO 25
      ENDIF
      IF(CHAR.EQ.'LISTENTI') THEN
         IF(ICREA.EQ.0) THEN
           JG=0
           SEGINI MLENTI
           ICREA=1
         ENDIF
         IF(INOOB2(IPLAMO) .NE . 'ENTIER  ') GO TO 52
         JG=JG+1
         SEGADJ MLENTI
         LECT(JG)=IOUEP2(IPLAMO)
         GO TO 25
      ENDIF
      IF(CHAR.NE.INOOB2(IPLAMO)) GO TO 50
      IOO=IOUEP2(IPLAMO)
      if(nbesc.ne.0) segact ipiloc
      IF(CHAR.EQ.'ENTIER  ') THEN
           IVAL=IOO
           CALL NOMENT(CHARB,IVAL)
      ELSEIF(CHAR.EQ.'FLOTTANT') THEN
           XPO= XIFLOT(IOO)
           CALL NOMREE(CHARB,XPO)
      ELSEIF(CHAR.EQ.'MOT    ') THEN
           ID=IPCHAR(IOO)
           IFI=IPCHAR(IOO+1)
           IF1=IFI-ID
           CHARC=' '
           IF1=MIN(IF1,72)
           CHARC(1:IF1)=ICHARA(ID:IFI-1)
           CALL NOMCHA(CHARB,CHARC(1:IF1))
      ELSEIF(CHAR.EQ.'LOGIQUE ')  THEN
           LOGI=IPLOGI(IOO)
           CALL NOMLOG(CHARB,LOGI)
      ELSE
           CALL NOMOBJ(CHAR,CHARB,IOO)
      ENDIF
      if(nbesc.ne.0) SEGDES,IPILOC
  465      CONTINUE
       IPASS=0
       GO TO 1
   50  CONTINUE
       WRITE(IOIMP,51) CHAR
       GO TO 20
   52  CONTINUE
       WRITE(IOIMP,51) 'ENTIER'
       GO TO 20
   54  CONTINUE
       WRITE(IOIMP,51) 'FLOTTANT'
       GO TO 20
   51  FORMAT(' LA QUANTITE LUE N''EST PAS DU TYPE ',A8,
     #' RECOMMENCEZ S''IL VOUS PLAIT')
  200  CONTINUE
C-- ON REMET TEXT EN PLACE
*        TEXT(1:500)=CMTEXT(1:500)
*        IFINAN=IFINA1
*        IPREC=IPREC1
*        ICOUR=ICOUR1
*        NRAN=NRAN1
         segsup sredle
         RETURN
   21    CONTINUE
         IF(IOGRA.EQ.3.OR.IOGRA.EQ.2) THEN
C         REWIND IOTER
         GOTO 210
         ELSE
         CALL ERREUR ( 34 )
         RETURN
         ENDIF
         END