C CQUOI     SOURCE    CB215821  24/07/17    21:15:04     11961          
      SUBROUTINE CQUOI(MCHAR,ITYPE,IVAL,RVAL,CVAL,LVAL,IOBJ)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C
C   a partir d'un nom dans la chaine MCHAR(<500caracteres)
C   fournit l'objet qui y est attache si cela est possible
C   SI ITYPE n'est pas blanc on impose le type de l'objet
C   attendu (erreur sinon)
C en sortie ; ITYPE type de l'objet
C             IVAL RVAL CVAL LVAL IOBJ donne la valeur
C             associee dans le cas d'entier, de flottant, de mot
C             de logique ou d'objet
C

-INC PPARAM
-INC CCOPTIO
-INC CCNOYAU
-INC CCREDLE
-INC SMBLOC
-INC SMTABLE
-INC CCASSIS

      CHARACTER*(*) MCHAR,CVAL
      CHARACTER*8 ITYPE,LTYPE,JTYPE,ITYP1
      CHARACTER*(8) INDIC1 ,TYPOBJ ,MOTYP,CHARRE
*     CHARACTER*(LOCHAI) CMTEXT
      LOGICAL LVAL,ICOND,IBOOL
      ICOND=.FALSE.
      IF(ITYPE.NE.'        ') ICOND=.TRUE.
      ITYP1=ITYPE
      IF(ITYPE.EQ.'FLOTTANT') ITYP1='ENTIER  '
      LECTAB=0
      IF(ITYPE.EQ.'TABLE   ') THEN LECTAB=1
      CRIT = 1.D0 / 3.D0
      CRAT =ABS( CRIT * 3.D0 - 1.d0 )* 1000.
C-- ON SAUVE TEXT DE FACON A LE SURCHARGER TEMPORAIREMENT
*      CMTEXT(1:500)=TEXT(1:500)
*      NRAN1=NRAN
*      ICOUR1=ICOUR
*      IFINA1=IFINAN
*      IPREC1=IPREC
      segini sredle
C-- ON PLACE L'OBJET DE TYPE TEXTE DANS TEXT
      LENI=LEN(MCHAR)
      TEXT(1:500)=MCHAR(1:LENI)
      NRAN= 0
      IPREC=1
      IFINAN=LENI
      ICOUR=LENI
      INSTAB=0
      KER=0
*      write(6,*) ' avant appel redlec text', text(1:20)
      CALL REDLEC(sredle)
      IF(IRE.EQ.0) THEN
        CALL ERREUR(21)
      ENDIF
*      write(6,*) ' ire ', ire
C IRE = 0 FIN DE PHRASE
*      write(6,*) MOT(1:20)
      CALL PRENOM(IPLAMO,0,sredle)
      LTYPE=INOOB2(IPLAMO)
      IPLAFI=IOUEP2(IPLAMO)
*      write(6,*) iplamo,ltype,iplafi
      MTABLE=IOUEP2(IPLAMO)
   25 CONTINUE
      IF(LTYPE.EQ.'TABLE  '.OR.LTYPE.EQ.'OBJET   ')THEN
*          write(6,*) ' on a bien trouve une table ou un objet'
        CALL REDLEC(sredle)
        IF(IRE.EQ.0) THEN
          GO TO 500
        ENDIF
        CALL PRENOM(IPLAMA,0,sredle)
        JTYPE=INOOB2(IPLAMA)
*         write(6,*) ' jtype ',jtype
        IF( JTYPE.EQ.'SEPARATE'.OR.JTYPE.EQ.'METHODOL')THEN
           CALL REDLEC(sredle)
           IF(IRE.EQ.0) THEN
              KER=1
              GO TO 500
           ENDIF
*            write(6, *) 'ire au deuxieme appel redlec', ire
           CALL PRENOM (IPLAMA,0,sredle)
           INDIC1=INOOB2(IPLAMA)
           INDIC2=IOUEP2(IPLAMA)
           SEGACT MTABLE
           NB=MLOTAB
           IF(NB.EQ.0)  THEN
              KER=1
              GOTO 500
           ENDIF
           TYPOBJ=' '
           MOTYP='MOT'
           CALL ACCTAB(MTABLE,MOTYP,IVAL,XER,'SOUSTYPE',IBOOL
     $     ,IOBJ,TYPOBJ,IVALRE,XER,CHARRE,IBOOL,IOBRE)
           IBOOL=.FALSE.
           IF(TYPOBJ.EQ.'MOT     '.AND.CHARRE.EQ.'RESULTAT')
     $     IBOOL=.TRUE.
           DO 10 IJ=1,NB
           IF (INDIC1.NE.MTABTI(IJ)) GOTO 10
           IF (INDIC1.NE.'FLOTTANT') THEN
             IF (INDIC2.NE.MTABII(IJ)) GOTO 10
           ELSE
             IF (IBOOL) THEN
               XER=ABS((XIFLOT(INDIC2)-RMTABI(IJ))/
     $         (ABS(XIFLOT(INDIC2))+MAX(1.D-20 ,ABS(XIFLOT(INDIC2))
     $         )/ 1.D15))
               IF(XER. GT . CRAT )  GO TO 10
             ELSE
               IF (XIFLOT(INDIC2).NE.RMTABI(IJ)) GOTO 10
             ENDIF
           ENDIF
           GOTO 20
  10       CONTINUE
C   pas d'indice dans la table
           KER=1
           GO TO 500
  20       LTYPE=MTABTV(IJ)
           IF (LTYPE.NE.'FLOTTANT') THEN
             IPLAFI=MTABIV(IJ)
           ELSE
*  SYNTONISER LA VALEUR AVEC LA PILE DES FLOTTANTS
             XXVA=RMTABV(IJ)
             DO 1000 J=1,LMNREE
             IF(XIFLOT(J).NE.XXVA) GO TO 1000
C LA VALEUR EXISTE DEJA  EN J IEME POSITION
             IPLAFI=J
             GO TO 1100
 1000        CONTINUE
C LA VALEUR N'EXISTE PAS
             LMNREE=LMNREE+1
             if( nbesc.ne.0) SEGDES,IPILOC
             segact ipiloc*mod
             IL=XIFLOT(/1)
             IF(LMNREE.GT.IL) THEN
               LMxx=LMNREE+100
               lmmm=ichara(/1)
               lmcc=ipchar(/1)
               lmll=iplogi(/1)
               SEGADJ IPiloc
             ENDIF
             XIFLOT(LMNREE)=XXVA
             IPLAFI=LMNREE
             if( nbesc.ne.0) SEGDES,IPILOC
 1100        CONTINUE
           ENDIF
           SEGDES MTABLE
           MTABLE = IPLAFI
           GO TO 25
        ELSE
           KER=1
           GO TO 500
        ENDIF
      ENDIF
  500 CONTINUE
C
C   on arrive ici avec LTYPE et IPLAFI et KER
C
      IF(KER.EQ.1)  THEN
        IF(ICOND) THEN
          MOTERR(1:8)=ITYPE
          CALL ERREUR(37)
        ELSE
          CALL ERREUR(21)
        ENDIF
        GO TO 3000
      ELSE
        IF(ICOND) THEN
          IF(LTYPE.NE.ITYPE.AND.LTYPE.NE.ITYP1) THEN
            MOTERR(1:8)=ITYPE
            CALL ERREUR(37)
            GO TO 3000
          ENDIF
          IF(LTYPE.NE.ITYPE) THEN
            RVAL=IPLAFI
            GO TO 3000
          ENDIF
        ENDIF
        ITYPE=LTYPE
        IF(ITYPE.EQ.'MOT     ') THEN
          IP=IPLAFI
          ID=IPCHAR(IP)
          IFI=IPCHAR(IP+1)
          CVAL=ICHARA(ID:IFI-1)
          IVAL=MIN(LEN(CVAL),IFI - ID )
        ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN
          LVAL=IPLOGI(IPLAFI)
        ELSEIF(ITYPE.EQ.'FLOTTANT') THEN
          RVAL=XIFLOT(IPLAFI)
        ELSEIF(ITYPE.EQ.'ENTIER  ') THEN
          IVAL=IPLAFI
        ELSE
          IOBJ=IPLAFI
        ENDIF
      ENDIF
 3000 CONTINUE
C
C    on remet la pile de lecture en place
C
*      TEXT(1:500)=CMTEXT(1:500)
*      IFINAN=IFINA1
*      IPREC=IPREC1
*      ICOUR=ICOUR1
*      NRAN=NRAN1
      segsup sredle
      RETURN
      END








 
 
 
 
 
 
