C LIPIL     SOURCE    PV090527  26/04/30    21:15:50     12529          

C=======================================================================
C   BUT        : LECTURE DU FICHIER FORMATE OU NON IORES DEFINI PAR:
C                OPTIO REST IORES ;
C   APPELE PAR : REST
C   APPELLE    : LFCDIM LFCDIE LFCDI2 NOMNST ENSOLF  ENTNOM
C              : LIPOIN LIMAIL ERREUR(12)
C   ECRIT PAR FARVACQUE    -REPRIS PAR LENA
C
C HISTORIQUE : ajout des objets de type MATRAK et MATRIK par
C              GOUNAND (15/07/98)
C
C=======================================================================
C  TABLEAU KCOLA: VOIR LE SOUS-PROGRAMME TYPFIL
C=======================================================================
      SUBROUTINE LIPIL (ICOLAC,IFIN,IRET,IFORM,LABEL)

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

-INC PPARAM
-INC CCOPTIO
-INC CCNOYAU
-INC CCGEOME
-INC CCHAMP
-INC CCFXDR

-INC SMELEME
-INC SMBASEM
-INC SMCOORD
-INC SMRIGID
-INC SMELSTR
-INC SMCLSTR
-INC SMDEFOR
-INC SMSTRUC
-INC SMLREEL
-INC SMLENTI
-INC SMLMOTS
-INC SMTEXTE
-INC SMTABLE
-INC SMSUPER
-INC SMVECTD
-INC SMCHARG
-INC SMEVOLL
-INC SMLCHPO
-INC SMINTE
-INC SMLOBJE

-INC TMCOLAC

      SEGMENT JPV(MOTS(/2))
C=======================================================================
C  ICOLAC :  KCOLA : POINTEUR SUR LA PILE ITLACC
C            MCOLA : NOMBRE D'OBJETS INSPECTES DANS LA PILE
C            ICOLA : POINTEUR SUR ISGTR ( NOM-NOM-RANG DANS ITLACC)
C            KCOLAC: CONTIENT POUR CHAQUE PILE LE NOMBRE D'OBJETS A
C                    SORTIR
C=======================================================================
      SEGMENT/ITBBE1/( ITABE1(NN))
      SEGMENT/ITBBE2/( ITABE2(NN))
      segment itbbc2
       character*4 itabc2(nn)
      endsegment
      SEGMENT/ITBBM1/( ITABM1(NM))
      segment itbbc1
       character*4 itabc1(nm)
      endsegment
      SEGMENT/ITBBM2/( ITABM2(NM2))
      segment itbbc3
       character*4 itabc3(nm2)
      endsegment
      SEGMENT/ITBBM3/( ITABM3(NM2))
      segment itbbc4
       character*4 itabc4(nm2)
      endsegment
      SEGMENT/ITBBM4/( ITABM4(NM2))
      segment itbbc5
       character*4 itabc5(nm2)
      endsegment
      SEGMENT/ITBBR1/( TABR1(L)*D)
      SEGMENT/NOMM1/(NOM1(NOBJN1))
      SEGMENT NOMM2
      CHARACTER*(LONOM) NOM2(NOBJN1)
      ENDSEGMENT
      SEGMENT ITAMOT
      CHARACTER*(NN) ITAMO
      INTEGER ICOTA(NNN)
      ENDSEGMENT
      segment xmaaux
       real*8 reaux(laux,nelrig)
      endsegment

      CHARACTER*(*) LABEL
      DIMENSION ILENA(30)
      DIMENSION NOMM(2)
      CHARACTER*(8) ITYPE,CTYPE
      REAL*8  XVA
      LOGICAL LOGI
      CHARACTER*(72) CHA1T
      CHARACTER*(LOCHAI) CHA1
c*      CHARACTER*(1) CHARI
      REAL*4 DENSI4
C--------------------------------------------------------------------
      minouv=0
      mlnouv=0
      mrnouv=0
      mmnouv=0
      IQUOI =0
      NOMM1 =0
      NOMM2 =0
      ITBBM1=0
      ITBBM2=0
      ITBBM3=0
      ITBBM4=0
      ITBBE1=0
      ITBBE2=0
      ITBBR1=0
      IRET  =0
      IRETOU=0
      NOBJN1=0
      CHA1T =' '
      SEGINI NOMM1,NOMM2
      SEGACT ICOLAC*MOD,MCOORD*MOD
      NBANC =nbpts
      mianc =minouv
      mlanc =mlnouv
      mranc =mrnouv
      mmanc =mmnouv
C ------------------------------------------------------------------
C ---  BOUCLE DE LECTURE SUR UN DESCRIPTEUR-------------------------
 1097 CONTINUE
      IRETOU=0
      IQUOI =0
      CALL LFCDES (IORES,IQUOI,IRETOU,IFORM)
      IF (IIMPI.EQ.5) WRITE(IOIMP,555) IQUOI,IRETOU
 555  FORMAT(' ENREG DE TYPE ',I3,'  CODE RETOUR DE LECTURE =',I2)
      IF(IRETOU.NE.0) THEN
         IF( IONIVE.GE.10) THEN
            IF(LABEL.EQ.' '.AND.CHA1T.NE.' ') THEN
               IRETOU=0
               GOTO 1001
            ELSE
               MOTERR(1:24) = LABEL
               CALL ERREUR (874)
               GOTO 1000
            ENDIF
         ELSE
            MOTERR(1:24) = LABEL
            CALL ERREUR (874)
            GOTO 1000
         ENDIF
      ENDIF
C  *** FIN DES LECTURES ********SI IQUOI=5
      IF(IQUOI.EQ.5) THEN
         IF(IONIVE.GE.10) THEN
            IF(IFORM.EQ.1) READ (IORES,776) CHA1T
            IF(IFORM.EQ.0) READ (IORES) CHA1T
            if (iform.eq.2) ios=IXDRSTRING( ixdrr,cha1t(1:72))
 776        FORMAT(A72)
            WRITE (IOIMP,778) CHA1T
 778        FORMAT ( 'FIN DE LECTURE DU LABEL : ',/,A72,/)
           mianc=minouv
           mlanc=mlnouv
           mranc=mrnouv
           mmanc=mmnouv
            IF(LABEL.NE.' ') THEN
               IF(LABEL.EQ.CHA1T ) GOTO 1001
            ENDIF
            GOTO 1097
         ENDIF
      ENDIF
      GOTO(999 ,5000,4000,444,1001,999 ,4001,4002,4009),IQUOI
C --- ERREUR
 999  GOTO 1000
C--------------------------------------------------------------------
C  ***** LECTURE DES INFORMATIONS GENERALES A METTRE DANS LES COMMONS
C --- IQUOI=4
 444  CONTINUE
      IF(IFORM.EQ.1)READ(IORES,701,END=1000,ERR=1000) NIVEAU,IARR,JDIM
      IF(IFORM.EQ.0)READ(IORES,    END=1000,ERR=1000) NIVEAU,IARR,JDIM
      if(IFORM.eq.2) then
       ios=IXDRINT( ixdrr, niveau )
       ios=IXDRINT( ixdrr, iarr   )
       ios=IXDRINT( ixdrr, jdim   )
      endif
 701  FORMAT(7X,I4,14X,I4,10X,I4)
      WRITE (IOIMP,33201) NIVEAU
33201 FORMAT (//,' NIVEAU DU FICHIER LU',I3)

C --- NIVEAU DE REFERENCE MAX. : IONIVR (voir aussi SAUV sauv.eso)
      IONIVR = 28
      IF (NIVEAU.LT.1 .OR. NIVEAU.GT.IONIVR) THEN
        INTERR(1)=NIVEAU
        INTERR(2)=1
        INTERR(3)=IONIVR
        CALL ERREUR(1068)
        RETURN
      ENDIF
      IONIVE = NIVEAU

      IF (NIVEAU .GE. 23) THEN
C       Lecture de la longueur des Chaines de CARACTERES des composantes ('MCHAML','CHPOINT','LISTMOTS',etc.)
C       utilisees lors de la sauvegarde
        IF(IFORM.EQ.1)READ(IORES,700,END=1000,ERR=1000) LCOMLU
        IF(IFORM.EQ.0)READ(IORES,    END=1000,ERR=1000) LCOMLU
        if(IFORM.eq.2) then
         ios=IXDRINT( ixdrr, LCOMLU )
        endif
 700    FORMAT(23X,I4)
        WRITE (IOIMP,33200) LCOMLU
33200   FORMAT (' TAILLE DES COMPOSANTES',I4)

      ELSE
        LCOMLU = -1
      ENDIF

CCCCC IF (NIVEAU.NE.0) GOTO 1000
      IF (IFORM.EQ.1) READ(IORES,702) DENSI4
      IF (IFORM.EQ.0) READ(IORES)     DENSI4
      if (iform.eq.2) ios=IXDRREAL( ixdrr, densi4 )
      densit = densi4
 702  FORMAT(8X,E12.5)
      WRITE (IOIMP,201) iarr,JDIM,DENSIT
 201  FORMAT (//,' NIVEAU D''ERREUR ',I2,' DIMENSION ',I2,' DENSITE ',
     1     1PE12.5)

      IERMAX=MAX(IERMAX,iarr)
      CALLGINT2
      IF (IDIM.EQ.0) IDIM=JDIM
      IF (JDIM.NE.0.AND.JDIM.NE.IDIM) CALL ERREUR(12)
      GOTO 1097
C
C  **** Noms des composantes primales et duales *****************
C  Repris de la lecture des LISTMOTS
C --- IQUOI=8
 4002 CONTINUE
      DO I=1,2
         ITOTO=2
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         JGN = ILENA(1)
         JGM = ILENA(2)
*         SEGINI MLMOTS
         NN=JGN*JGM
         NNN=0
         SEGINI ITAMOT
         CALL LFCDIC(IORES,ITAMO,IRETOU,IFORM)
         IF(IRETOU.NE.0) GOTO 1000
         IF (I.EQ.1) THEN
            LNOMDD=MIN(JGM,1000)
            KNOMDD=MIN(JGN,LEN(NOMDD(1)))
            DO IUH = 1,LNOMDD
               ideb = (IUH-1)*JGN+1
               ifin = ideb+knomdd-1
               NOMDD(IUH)= ITAMO(ideb:ifin)
            ENDDO
         ELSE
            LNOMDU=MIN(JGM,1000)
            KNOMDU=MIN(JGN,LEN(NOMDU(1)))
            DO IUH = 1,LNOMDU
               ideb = (IUH-1)*JGN+1
               ifin = ideb+knomdu-1
               NOMDU(IUH)= ITAMO(ideb:ifin)
            ENDDO
         ENDIF
         SEGSUP ITAMOT
      ENDDO
      GOTO 1097

C --- IQUOI=9
 4009 CONTINUE
      IF (NIVEAU .LT. 26) THEN
        write(ioimp,*) 'IQUOI = 9 pas a ce niveau ?',NIVEAU
      ELSE
        CALL HHOPIL(5,IORES,IFORM)
      ENDIF
      GOTO 1097
C
C  **** INFORMATIONS GENERALES CASTEM2000 *****************
C --- IQUOI=7
 4001 CONTINUE
      CALL LIINFG (IRETOU,IFORM)
      IF(IRETOU.NE.0) GOTO 1000
      GOTO 1097
C
C   ***** LECTURE D'UN TITRE     *************************************
C --- IQUOI=3
 4000 CONTINUE
      CALL LFCDIM(IORES,18,ILENA,IRETOU,IFORM)
      WRITE(TITREE,FMT='(18A4)')(ILENA(IY),IY=1,18)
      IF(IRETOU.NE.0) GOTO 1000
      GOTO 1097
C
C   ***** LECTURE D'UNE PILE     *************************************
C --- IQUOI=2
 5000 CONTINUE
      IF(IERR.NE.0) RETURN
      ITOTO=3
      CALL LFCDIP (IORES,ITOTO,ILENA,IRETOU,IFORM)
      IF (  IRETOU.NE.0) GOTO 1000
      IFILE  =ILENA(1)
      NOBJN  =ILENA(2)
      IMAX1  =ILENA(3)
      ITYPE=' '
      IF(IFILE.GT.0) THEN
         CALL TYPFIL(ITYPE,IFILE)
         WRITE (IOIMP,805) IMAX1,ITYPE
 805     FORMAT( ' LECTURE DE ',I8 , ' OBJETS ',A8)
         IF(IIMPI.NE.0)
     *        WRITE(IOIMP,803)IFILE,ITYPE,IMAX1,NOBJN
      ELSE
         ITYPE='POINT   '
         IF(IIMPI.NE.0) WRITE(IOIMP,804)IMAX1,NOBJN
      ENDIF
 803  FORMAT(///' * LA FILE NUMERO',I4,' CONSTITUEE D''OBJETS DE TYPE
     1     ',A8,' CONTIENT',I8,
     1     ' OBJETS, PARMI LESQUELS ',I5,' SONT NOMMES.')
 804  FORMAT(///' * IL Y A ',I8,' NOUVEAUX POINTS, PARMI LESQUELS ',
     1     I6,'  SONT NOMMES.')
C --- LECTURE DES NOMS S ILS EXISTENT
      CALL ENTNOM(IORES,NOBJN,NOMM1,NOMM2,IRETOU,IFORM)
      IF(IRETOU.NE.0) GOTO 1000
C --- LECTURE DE LA PILE - ON EN LIRA IMAX1-------------------------
      IF(IFILE.LE.0) GOTO 5001
C      KCOLAC(IFILE)=IMAX1+ KCOLAC(IFILE)
      ITLACC=KCOLA(IFILE)
C     write(6,*) 'IFILE,ITLACC=',IFILE,ITLACC
      segact itlacc*mod
      IRETOU=0
C ---
      GOTO(6001,6002,6003,1002,1002,6006,6007,6008,6009,6010,1002,
     1     6012,6013,6014,6015,6016,6017,6018,6019,6020,1002,6022,
     1     6023,6024,6025,6026,6027,6028,6029,6030,6031,6032,6033,
     1     6034,6035,6036,6037,6038,6039,6040,6041,6042,6043,6010,
     1     6045,1098,1098,6048,1098,6050,6051),IFILE
 1002 MOTERR(1:8)=ITYPE
      CALL ERREUR(336)
      IF (ITYPE.EQ.'ESCLAVE') GOTO 1097
      GOTO 1000
C    *************** POINTS ET COORD **********************************
 5001 CONTINUE
      IF(IONIVE.LE.9) THEN
         CALL LIPOIN (IMAX1,NOBJN,NOMM1,NOMM2,NBANC,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
      ENDIF
      GOTO 1097
C    **************************MELEME**********************************
 6001 CONTINUE
      DO 7 IEL=1,IMAX1
         IRETOU=0
         CALL LIMAIL (MELEME,NBANC,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         ITLAC(**)=MELEME
*  si on avait avant la restitution un point support de contact    il faut l
*  le confondre avec celui restitue.
    7 CONTINUE
      GOTO 1098
C     **************************CHPOINT*********************************
 6002 CONTINUE
      CALL LICHPO(IORES,ITLACC,IMAX1,IRETOU,IFORM,LCOMLU)
      IF (IRETOU.NE.0) GOTO 1000
      GOTO 1098
C     ***********************MRIGID*************************************
 6003 CONTINUE
      NN=0
      SEGINI ITBBE1
      NM=0
      SEGINI ITBBM1,itbbc1
      DO 1202 IEL=1,IMAX1
C     READ(IORES,8000,END=1000,ERR=1000) NRIGEL,ICHO,NBGEOR,NRIGE,J
         ITOTO=5
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         NRIGEL=   ILENA(1)
         ICHO  =   ILENA(2)
         NBGEOR=   ILENA(3)
         NRIGE =   ILENA(4)
         J     =   ILENA(5)
         SEGINI MRIGID
         ITLAC(**)=MRIGID
         IFORIG=J
         ITOTO=2
         if (iform.ne.2) then
         CALL LFCDIM(IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         WRITE(MTYMAT,FMT='(2A4)') ILENA(1),ILENA(2)
         else
         ios=IXDRSTRING( ixdrr, mtymat(1:8))
         if (ios.lt.0) goto 1000
         endif
         ICHOLE=ICHO
         NN=NRIGE*NRIGEL+NBGEOR
         IF(IONIVE.GE.5) NN=NN + NRIGEL
         SEGADJ ITBBE1
         CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         NNN=0
         DO 1203 IR=1,NRIGEL
            II=NRIGE*(IR-1)
            DO 1204 NR=1,NRIGE
               IRR=II+NR
               IRIGEL(NR,IR)=ITABE1(IRR)
 1204       CONTINUE
            NLIGRP=ITABE1(II+3)
            NLIGRD=NLIGRP
            IF(IONIVE.GE.5) THEN
               NLIGRD=ITABE1(IR+ NRIGE*NRIGEL+NBGEOR)
            ENDIF
            NNN=NNN+NLIGRP + NLIGRD
            SEGINI DESCR
            IRIGEL(3,IR)=DESCR
            if(ionive.ge.18.and.ionive.lt.20) then
                nelrig=ITABE1(II+4)
                segini xmatri
                IRIGEL(4,IR)=xmatri
            endif
 1203    CONTINUE
         IF(NBGEOR.EQ.0) GOTO 1207
         SEGINI IMGEOD
         DO 1206 I=1,NBGEOR
            IMGEOR(I)=ITABE1(NRIGE*NRIGEL+I)
 1206    CONTINUE
         SEGDES IMGEOD
         IMGEO1=IMGEOD
 1207    NN=NNN
         IF(IONIVE.LT.5) NN=NN/2
         SEGADJ ITBBE1
         NM=NNN
         SEGADJ ITBBM1,itbbc1
         CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
         IF(IRETOU.NE.0) GOTO 1000
         if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM)
         if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4))
         IF(IRETOU.NE.0) GOTO 1000
         J=0
         DO 1208 IR=1,NRIGEL
            DESCR=IRIGEL(3,IR)
            SEGACT DESCR*MOD
            NLIGRP=NOELEP(/1)
            IF(IONIVE.GE.5) THEN
               DO 1205 I=1,NLIGRP
                  J=J+1
                  NOELEP(I)=ITABE1(J)
                  if (iform.ne.2) WRITE(LISINC(I),FMT='(A4)')ITABM1(J)
                  if (iform.eq.2) lisinc(i)=itabc1(j)
 1205          CONTINUE
               NLIGRD=NOELED(/1)
               DO 1209 I=1,NLIGRD
                  J=J+1
                  NOELED(I)=ITABE1(J)
                  if (iform.ne.2) WRITE(LISDUA(I),FMT='(A4)')ITABM1(J)
                  if (iform.eq.2) lisdua(i)=itabc1(j)
 1209          CONTINUE
            ELSE
               DO 1215 I=1,NLIGRP
                  J=J+1
                  NOELEP(I)=ITABE1(J)
                  NOELED(I)=ITABE1(J)
                  if (iform.ne.2) then
           WRITE(LISINC(I),FMT='(A4)')ITABM1(2*J-1)
                  else
           lisinc(i)=itabc1(2*j-1)
                  endif
                  if (iform.ne.2) WRITE(LISDUA(I),FMT='(A4)')ITABM1(2*J)
                  if (iform.eq.2) lisdua(i)=itabc1(2*j)
 1215          CONTINUE
            ENDIF
            SEGDES DESCR
 1208    CONTINUE
         CALL LFCDI2(IORES,NRIGEL,COERIG,IRETOU,IFORM)
                 if(ionive.ge.18.and.ionive.lt.20) then
                   do ir=1,nrigel
                     xmatri=IRIGEL(4,ir)
                     lval=re(/1)*re(/2)*re(/3)
                     call lfcdi2(iores,lval,re,iretou,iform)
                     segdes xmatri
                   enddo
                 endif
         SEGDES MRIGID
         IF(IRETOU.NE.0) GOTO 1000
 1202 CONTINUE
      SEGSUP ITBBM1,itbbc1,ITBBE1
      GOTO 1098
C     ***************************        *******************************
 6004 CONTINUE
      GOTO 1098
C     ***********************          *********************************
 6005 CONTINUE
      GOTO 1098
C ********************************BLOQ STRUC
 6006 CONTINUE
      DO 60 IEL=1,IMAX1
         ITOTO=1
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF(IRETOU.NE.0) GOTO 1000
         N=ILENA(1)
         SEGINI MCLSTR
         ITLAC(**)= MCLSTR
         CALL LFCDIE (IORES,N    ,ISOSTR,IRETOU,IFORM)
         IF(IRETOU.NE.0) GOTO 1000
         CALL LFCDIE (IORES,N    ,IRIGCL,IRETOU,IFORM)
         IF(IRETOU.NE.0) GOTO 1000
         SEGDES MCLSTR
 60   CONTINUE
      GOTO 1098
C ********************************ELEM STRUC
 6007 CONTINUE
      DO 70 IEL=1,IMAX1
         ITOTO=1
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF(IRETOU.NE.0) GOTO 1000
         N=ILENA(1)
         SEGINI MELSTR
         ITLAC(**) =MELSTR
         CALL LFCDIE (IORES,N    ,ISOSTU,IRETOU,IFORM)
         IF(IRETOU.NE.0) GOTO 1000
         CALL LFCDIE (IORES,N    ,IMELEM,IRETOU,IFORM)
         IF(IRETOU.NE.0) GOTO 1000
         SEGDES MELSTR
 70   CONTINUE
      GOTO 1098
C     ****************************MSOLUT********************************
 6008 CONTINUE
      IMAX2=IMAX1
      DO 1800 IEL=1,IMAX1
         IRETOU=0
         IF (NIVEAU.LE.2) CALL ENSOLF(ICOLAC,IRET,IFORM)
         IF (NIVEAU.LE.2) MSOLUT=IRET
         IF (NIVEAU.GE.3) CALL LISOLU(MSOLUT,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         IRET=MSOLUT
         IF(IRET.GE.0) THEN
            ITLAC(**)=IRET
         ELSE
            IF(IRET.LT.0) THEN
               ITLAC(**)=-IRET
               IMAX2=IEL
            ELSE
               IMAX2=IEL-1
            ENDIF
            GOTO 1801
         ENDIF
 1800 CONTINUE
 1801 CONTINUE
      IMAX1=IMAX2
      GOTO 1098
C     ***************************MSTRUC********************************
 6009 CONTINUE
      DO 1901 IEL=1,IMAX1
C     READ(IORES,8000,END=1000,ERR=1000) N
         ITOTO=1
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         N     =   ILENA(1)
         SEGINI MSTRUC
         ITLAC(**)=MSTRUC
         CALL LFCDIE(IORES,N,LISTRU,IRETOU,IFORM)
         IF(IRETOU.NE.0) GOTO 1000
         SEGDES MSTRUC
 1901 CONTINUE
      GOTO 1098
C     ******************************* MTABLE **************************
 6010 CONTINUE
      NN=0
      SEGINI ITBBE1
      ITOTO=1
      DO 710 IEL=1,IMAX1
         MTABLE=0
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
*        write (6,*) ' lipil table ',ilena(1)
         IF (IRETOU.NE.0) GOTO 1000
         NN=ILENA(1)
CCC   IF (NN.EQ.0) GOTO 109
         M=NN/4
         SEGINI MTABLE
         MLOTAB=M
         IF (NN.EQ.0) GOTO 713
         SEGADJ ITBBE1
         CALL LFCDIE (IORES,NN,ITABE1,IRETOU,IFORM)
*        write (6,*) ' lipil table ',(itabe1(ii),ii=1,nn)
         IF(IRETOU.NE.0) GOTO 1000
         KK=0
         DO 711 K=1,NN,4
            KK=KK+1
            J=ITABE1(K)
            IVA=ITABE1(K+1)
            CTYPE=' '
            CALL  TYPFIL (CTYPE,J)
            if (ctype.eq.'ENTIER') then
*            write (6,*) ' lipil indice table ',ctype,iva,mianc
             if (ionive.le.20) iva=iva+mianc
            endif
            if (ctype.eq.'FLOTTANT') then
*            write (6,*) ' lipil indice table ',ctype,iva,mranc
             iva=iva+mranc
             if (iva.eq.0) call erreur(5)
            endif
            if (ctype.eq.'LOGIQUE') then
             iva=iva+mlanc
             if (iva.eq.0) call erreur(5)
            endif
            if (ctype.eq.'MOT    ') then
             iva=iva+mmanc
             if (iva.eq.0) call erreur(5)
            endif
            MTABII(KK)=IVA
            MTABTI(KK)=CTYPE
            J=ITABE1(K+2)
            IVA=ITABE1(K+3)
            CTYPE=' '
            CALL  TYPFIL (CTYPE,J)
            if (ctype.eq.'ENTIER') then
*            write (6,*) ' lipil valeur table ',ctype,iva,mianc
             if (ionive.le.20) iva=iva+mianc
            endif
            if (ctype.eq.'FLOTTANT') then
*            write (6,*) ' lipil indice table ',ctype,iva,mranc
             iva=iva+mranc
             if (iva.eq.0) call erreur(5)
            endif
            if (ctype.eq.'LOGIQUE') then
             iva=iva+mlanc
             if (iva.eq.0) call erreur(5)
            endif
            if (ctype.eq.'MOT    ') then
             iva=iva+mmanc
             if (iva.eq.0) call erreur(5)
            endif
** en attendant de savoir lire un esclave
            IF (CTYPE.EQ.'ESCLAVE') CTYPE='ANNULE'
            MTABIV(KK)=IVA
            MTABTV(KK)=CTYPE
 711     CONTINUE
 713     SEGDES MTABLE
 109     ITLAC(**)=MTABLE
 710  CONTINUE
      SEGSUP ITBBE1
      GOTO 1098
C     *****************************        *****************************
 6011 CONTINUE
      GOTO 1098
C     ************************ MSOSTU *******************************
 6012 CONTINUE
      NN=0
      SEGINI ITBBE1
      DO 2201 IEL=1,IMAX1
         ITOTO=1
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         NS    =   ILENA(1)
         SEGINI MSOSTU
         ITLAC (**)=MSOSTU
C     READ(IORES,8000,END=1000,ERR=1000)ITYSOU,ISRAID,ISMASS
         ITOTO=3+NS
         NN=ITOTO
         SEGADJ  ITBBE1
         CALL LFCDIE (IORES,ITOTO,ITABE1(1),IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         ITYSOU=  ITABE1(1)
         ISRAID=  ITABE1(2)
         ISMASS=  ITABE1(3)
         IF (NS.EQ.0) GOTO 120
         DO 12 I=1,NS
            ISCHAM(I)= ITABE1(I+3)
 12      CONTINUE
 120     SEGDES MSOSTU
 2201 CONTINUE
      SEGSUP ITBBE1
      GOTO 1098
C     ***************************** IMATRI *****************************
 6013 CONTINUE
      DO 2300 IEL=1,IMAX1
C     READ(IORES,8000,END=1000,ERR=1000)NELRIG
         ITOTO=4
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         nelrig=ilena(3)
         nligrd=ilena(1)
         nligrp=ilena(2)
         lval=nelrig*nligrp*nligrd
         RIGREL=0
         segini xmatri
         symre=ilena(4)
         if (symre.eq.0.and.nligrp.eq.nligrd) then
*  cas symetrique on ne lit que la partie triangulaire
          laux=nligrp*(nligrp+1)/2
          segini xmaaux
          call lfcdi2(iores,laux*nelrig,reaux,
     >          iretou,iform)
          do k=1,nelrig
            ip=0
            do j=1,nligrp
              do i=1,j
               re(i,j,k)=reaux(ip+i,k)
               re(j,i,k)=reaux(ip+i,k)
              enddo
              ip=ip+j
            enddo
          enddo
          segsup xmaaux
         else
*  cas general on lit tout
           call lfcdi2(iores,lval,re,iretou,iform)
         endif
         itlac(**)=xmatri
         SEGDES xMATRI
 2300 CONTINUE
      GOTO 1098
C     ***************************** MJONCT *****************************
 6014 CONTINUE
      CALL LIJONC (IORES,ITLACC,IMAX1,IRETOU,IFORM)
      IF (IRETOU.NE.0) GOTO 1000
      GOTO 1098
C     ***************************** MATTAC *****************************
 6015 CONTINUE
      CALL LIATTA (IORES,ITLACC,IMAX1,IRETOU,IFORM)
      IF (IRETOU.NE.0) GOTO 1000
      GOTO 1098
C     ***************************** MMATRI *****************************
 6016 CONTINUE
      CALL LIMMAT (IORES,ITLACC,IMAX1,IRETOU,IFORM)
      IF (IRETOU.NE.0) GOTO 1000
      GOTO 1098
C     *************************MDEFOR*******************************
 6017 CONTINUE
      NN=0
      SEGINI ITBBE1
      DO 2700 IEL=1,IMAX1
C     READ(IORES,8000,END=1000,ERR=1000) NDEF
         ITOTO=1
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         NDEF =   ILENA(1)
         SEGINI MDEFOR
         ITLAC(**)=MDEFOR
         CALL LFCDI2(IORES,NDEF,AMPL,IRETOU,IFORM)
         IF(IRETOU.NE.0) GOTO 1000
C     READ(IORES,8000,END=1000,ERR=1000)(IELDEF(I),I=1,NDEF),(ICHDEF(I),
C    1 I=1,NDEF), (JCOUL(I),I=1,NDEF)
         NN=7*NDEF
         SEGADJ  ITBBE1
         CALL LFCDIE (IORES,NN,ITABE1,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         CALL JDANSI ( IELDEF(1),ITABE1(1),NDEF)
         CALL JDANSI ( ICHDEF(1),ITABE1(NDEF +1),NDEF)
         CALL JDANSI ( JCOUL(1),ITABE1(2*NDEF+1),NDEF)
         CALL JDANSI ( MTVECT(1),ITABE1(3*NDEF+1),NDEF)
         CALL JDANSI ( MDCHP(1),ITABE1(4*NDEF+1),NDEF)
         CALL JDANSI ( MDCHEL(1),ITABE1(5*NDEF+1),NDEF)
         CALL JDANSI ( MDMODE(1),ITABE1(6*NDEF+1),NDEF)
         SEGDES MDEFOR
 2700 CONTINUE
      SEGSUP ITBBE1
      GOTO 1098
C     ******************************MLREEL**************************
 6018 CONTINUE
      DO 2800 IEL=1,IMAX1
C     READ(IORES,8000,END=1000,ERR=1000)N
         ITOTO=1
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         N    =   ILENA(1)
         JG=N
         SEGINI MLREEL
         CALL LFCDI2(IORES,N,PROG,IRETOU,IFORM)
         SEGDES MLREEL
         IF(IRETOU.NE.0) GOTO 1000
         ITLAC(**)=MLREEL
 2800 CONTINUE
      GOTO 1098
C     ******************************MLENTI****************************
 6019 CONTINUE
      DO 2900 IEL=1,IMAX1
         ITOTO=1
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         N    =   ILENA(1)
         JG=N
         SEGINI MLENTI
         CALL LFCDEE(IORES,N,LECT,IRETOU,IFORM)
         SEGDES MLENTI
         IF(IRETOU.NE.0) GOTO 1000
         ITLAC(**)=MLENTI
 2900 CONTINUE
      GOTO 1098
C     ****************************MCHARG******************************
 6020 CONTINUE
      NN=0
      NM=0
      NM2=0
      SEGINI ITBBM1,itbbc1
      SEGINI ITBBM2,itbbc3
      SEGINI ITBBM3,itbbc4
      SEGINI ITBBM4,itbbc5
      SEGINI ITBBE1
      SEGINI ITBBE2,itbbc2
      DO 3000 IEL=1,IMAX1
C        READ(IORES,8000,END=1000,ERR=1000)N
         IF(IONIVE.LE.6) THEN
            ITOTO=1
            CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
            IF (IRETOU.NE.0) GOTO 1000
            N = ILENA(1)
            SEGINI MCHARG
            NM=2*N
            SEGADJ ITBBM1,itbbc1
            if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM)
            if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4))
            IF(IRETOU.NE.0) GOTO 1000
            NN=3*N
            SEGADJ ITBBE1
            CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
            IF(IRETOU.NE.0) GOTO 1000
            DO 3001 I=1,N
c               WRITE (CHANOM(I),FMT='(I4)') I
               CHANOM(I)='    '
               SEGINI ICHARG
               KCHARG(I)=ICHARG
               I2=2*I
               I3=3*I
               if (iform.ne.2) then
                WRITE (CHANAT(I),FMT='(2A4)') ITABM1(I2-1),ITABM1(I2)
               else
                chanat(i)(1:4)=itabc1(i2-1)
                chanat(i)(5:8)=itabc1(i2)
               endif
               CHATYP='CHPOINT '
               ICHPO1=ITABE1(I3-2)
               ICHPO2=ITABE1(I3-1)
               ICHPO3=ITABE1(I3)
               SEGDES ICHARG
 3001       CONTINUE
         ELSE IF (IONIVE.GE.7.AND.IONIVE.LE.10) THEN
            ITOTO=1
            CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
            IF (IRETOU.NE.0) GOTO 1000
            N = ILENA(1)
            SEGINI MCHARG
            NN=2*N
            SEGADJ ITBBE2,itbbc2
            if (iform.ne.2) CALL LFCDIM(IORES,NN,ITABE2,IRETOU,IFORM)
            if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc2(1)(1:nn*4))
            IF(IRETOU.NE.0) GOTO 1000
            NM2=N
            SEGADJ ITBBM2,itbbc3
            if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM)
            if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4))
            IF(IRETOU.NE.0) GOTO 1000
            NM=2*N
            SEGADJ ITBBM1,itbbc1
            if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM)
            if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4))
            IF(IRETOU.NE.0) GOTO 1000
            NN=3*N
            SEGADJ ITBBE1
            CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
            IF(IRETOU.NE.0) GOTO 1000
            DO 3002 I=1,N
               SEGINI ICHARG
               KCHARG(I)=ICHARG
               I2=2*I
               I3=3*I
               if (iform.ne.2) then
               WRITE (CHATYP,FMT='(2A4)') ITABM1(I2-1),ITABM1(I2)
               WRITE (CHANAT(I),FMT='(2A4)') ITABE2(I2-1),ITABE2(I2)
               WRITE (CHANOM(I),FMT='(1A4)') ITABM2(I)
               else
               chatyp(1:4)=itabc1(i2-1)
               chatyp(5:8)=itabc1(i2)
               chanat(i)(1:4)=itabc2(i2-1)
               chanat(i)(5:8)=itabc2(i2)
               chanom(i)=itabc3(i)
               endif
c initialise par defaut
               CHAMOB(I) = 'STAT'
               CHALIE(I) = 'LIE '
c..
               ICHPO1=ITABE1(I3-2)
               ICHPO2=ITABE1(I3-1)
               ICHPO3=ITABE1(I3)
               SEGDES ICHARG
 3002       CONTINUE
         ELSE
            ITOTO=1
            CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
            IF (IRETOU.NE.0) GOTO 1000
            N = ILENA(1)
            SEGINI MCHARG
            NN=2*N
            SEGADJ ITBBE2,itbbc2
            if (iform.ne.2) CALL LFCDIM(IORES,NN,ITABE2,IRETOU,IFORM)
            if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc2(1)(1:nn*4))
            IF(IRETOU.NE.0) GOTO 1000
            NM2=N
            SEGADJ ITBBM2,itbbc3
            if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM)
            if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4))
            IF(IRETOU.NE.0) GOTO 1000
            SEGADJ ITBBM3,itbbc4
            if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM3,IRETOU,IFORM)
            if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc4(1)(1:nm2*4))
            IF(IRETOU.NE.0) GOTO 1000
            SEGADJ ITBBM4,itbbc5
            if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM4,IRETOU,IFORM)
            if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc5(1)(1:nm2*4))
            IF(IRETOU.NE.0) GOTO 1000
            NM=2*N
            SEGADJ ITBBM1,itbbc1
            if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM)
            if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4))
            IF(IRETOU.NE.0) GOTO 1000
            NN=7*N
            SEGADJ ITBBE1
            CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
            IF(IRETOU.NE.0) GOTO 1000
            DO 3003 I=1,N
               SEGINI ICHARG
               KCHARG(I)=ICHARG
               I2=2*I
               I3=7*I
               if (iform.ne.2) then
               WRITE (CHATYP,FMT='(2A4)') ITABM1(I2-1),ITABM1(I2)
               WRITE (CHANAT(I),FMT='(2A4)') ITABE2(I2-1),ITABE2(I2)
               WRITE (CHANOM(I),FMT='(1A4)') ITABM2(I)
               WRITE (CHAMOB(I),FMT='(1A4)') ITABM3(I)
               WRITE (CHALIE(I),FMT='(1A4)') ITABM4(I)
               else
               chatyp(1:4)=itabc1(i2-1)
               chatyp(5:8)=itabc1(i2)
               chanat(i)(1:4)=itabc2(i2-1)
               chanat(i)(5:8)=itabc2(i2)
               chanom(i)=itabc3(i)
               chamob(i)=itabc4(i)
               chalie(i)=itabc5(i)
               endif
               ICHPO1=ITABE1(I3-6)
               ICHPO2=ITABE1(I3-5)
               ICHPO3=ITABE1(I3-4)
               ICHPO4=ITABE1(I3-3)
               ICHPO5=ITABE1(I3-2)
               ICHPO6=ITABE1(I3-1)
               ICHPO7=ITABE1(I3)
               if (ionive.le.19) then
**                if (ICHPO4.gt.0) then
                 if (chamob(i).eq.'TRAN') then
                   ipt1 = ICHPO4 + nbanc
                   CALL CRELEM(ipt1)
C*? C On verifie s'il n'a pas deja ete preconditionne.
C*?                    CALL CRECH1(ipt1,1)
                   segdes,ipt1
                   ICHPO4 = ipt1
                 else if (chamob(i).eq.'ROTA') then
                   ipt1 = ICHPO4 + nbanc
                   CALL CRELEM(ipt1)
C*? C On verifie s'il n'a pas deja ete preconditionne.
C*?                    CALL CRECH1(ipt1,1)
                   segdes,ipt1
                   ICHPO4 = ipt1
                   if (ICHPO5.gt.0) then
                     ipt1 = ICHPO5 + nbanc
                     CALL CRELEM(ipt1)
C*? C On verifie s'il n'a pas deja ete preconditionne.
C*?                      CALL CRECH1(ipt1,1)
                     segdes,ipt1
                     ICHPO5 = ipt1
                   endif
                 endif
**                endif
               endif
               SEGDES ICHARG
 3003       CONTINUE
         ENDIF
         SEGDES MCHARG
         ITLAC(**)=MCHARG
 3000 CONTINUE
      SEGSUP ITBBM1,itbbc1,ITBBE1,ITBBM2,itbbc3,ITBBM3,itbbc4,
     >       ITBBM4,itbbc5,ITBBE2,itbbc2
      GOTO 1098
C     ****************************        **************************
 6021 CONTINUE
      GOTO 1098
C     *****************************MEVOLL***************************
 6022 CONTINUE
      NN=0
      NM=0
      NM2=20
      SEGINI ITBBM2,itbbc3
      SEGINI ITBBE1,ITBBM1,itbbc1
      LDECA=7
      IF(NIVEAU.GE.3) LDECA=11
      LDECA2=18
      DO 3200 IEL=1,IMAX1
         ITOTO=1
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         N    =   ILENA(1)
         NM2=20
         SEGADJ ITBBM2,itbbc3
         SEGINI MEVOLL
         if (iform.ne.2) then
         CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM)
         IF(IRETOU.NE.0) GOTO 1000
         WRITE (ITYEVO,FMT='(2A4)') ITABM2(1),ITABM2(2)
         WRITE(IEVTEX,FMT='(18A4)') (ITABM2(I+2),I=1,18)
         else
         ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4))
*        write (6,*) ' evol itabc3 ',itabc3(1),itabc3(2)
         ityevo(1:4)=itabc3(1)
         ityevo(5:8)=itabc3(2)
         do jpv=1,18
         ievtex(1+4*(jpv-1):4*jpv)=itabc3(jpv+2)
         enddo
         endif
         IF (IONIVE.GE.25) THEN
           NN=6*N
         ELSE
           NN=3*N
         ENDIF
         SEGADJ ITBBE1
         CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
         IF(IRETOU.NE.0) GOTO 1000
         NM=LDECA*N
         SEGADJ ITBBM1,itbbc1
         if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM)
         if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4))
         IF(IRETOU.NE.0) GOTO 1000
         IF (NIVEAU.LT.3) GOTO 221
         NM2=LDECA2*N
         SEGADJ ITBBM2,itbbc3
         if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM)
         if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4))
         IF(IRETOU.NE.0) GOTO 1000
 221     CONTINUE
         DO 3201 IN=1,N
            SEGINI KEVOLL
            IEVOLL(IN)=KEVOLL
            IF (IONIVE.GE.25) THEN
              I4=6*IN
              IPROGX=ITABE1(I4-5)
              IPROGY=ITABE1(I4-4)
              NUMEVX=ITABE1(I4-3)
              LSTYL =ITABE1(I4-2)
              MMARQ =ITABE1(I4-1)
              KTAIL =ITABE1(I4  )
            ELSE
              I4=3*IN
              IPROGX=ITABE1(I4-2)
              IPROGY=ITABE1(I4-1)
              NUMEVX=ITABE1(I4  )
            ENDIF
            I7=LDECA*(IN-1)
            if (iform.ne.2) then
            WRITE(NOMEVX,FMT='(3A4)')(ITABM1(I7+I),I=1,3)
            WRITE(NOMEVY,FMT='(3A4)')(ITABM1(I7+I+3),I=1,3)
            WRITE (NUMEVY,FMT='(A4)') ITABM1(I7+7)
            IF(NIVEAU.GE.3) THEN
               I8=LDECA2*(IN-1)
               WRITE(TYPX,FMT='(2A4)')(ITABM1(I7+7+I),I=1,2)
               WRITE(TYPY,FMT='(2A4)')(ITABM1(I7+9+I),I=1,2)
               WRITE(KEVTEX,FMT='(18A4)') (ITABM2(I8+JPV),JPV=1,18)
            ENDIF
            else
*        write (6,*) ' evol itabc1 ',itabc1(i7+1),itabc1(i7+2)
*        write (6,*) ' evol itabc1 ',itabc1(i7+3+1),itabc1(i7+3+2)
            nomevx(1:4)=itabc1(i7+1)
            nomevx(5:8)=itabc1(i7+2)
            nomevx(9:12)=itabc1(i7+3)
            nomevy(1:4)=itabc1(i7+3+1)
            nomevy(5:8)=itabc1(i7+3+2)
            nomevy(9:12)=itabc1(i7+3+3)
            numevy=itabc1(i7+7)
            if (niveau.ge.3) then
            I8=LDECA2*(IN-1)
            typx(1:4)=itabc1(i7+7+1)
            typx(5:8)=itabc1(i7+7+2)
            typy(1:4)=itabc1(i7+9+1)
            typy(5:8)=itabc1(i7+9+2)
            do jpv=1,18
            kevtex(1+(jpv-1)*4:4*jpv)=itabc3(i8+jpv)
            enddo
            endif
            endif
 3202       CONTINUE
            SEGDES KEVOLL
 3201    CONTINUE
         SEGDES MEVOLL
         ITLAC(**)=MEVOLL
 3200 CONTINUE
      SEGSUP ITBBE1,ITBBM1,itbbc1
      SEGSUP ITBBM2,itbbc3
      GOTO 1098
C
C     **********************SUPERELE************************************
 6023 CONTINUE
      ITOTO=1
      DO 230 IEL=1,IMAX1
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         NTOTO=ILENA(1)
         SEGINI MSUPER
         ITLAC(**)=MSUPER
         CALL LFCDIE (IORES,NTOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1023
         MRIGTO=ILENA(1)
         MSUPEL=ILENA(2)
         MSURAI=ILENA(3)
         MBLOQU=ILENA(4)
         MSUMAS=ILENA(5)
         MCROUT=ILENA(6)
         SEGDES MSUPER
 230  CONTINUE
      GOTO 1098
 1023 CONTINUE
      SEGDES MSUPER
      GOTO 1000
C     ************************* LOGIQUE  ***************************
 6024 CONTINUE
      ITOTO=1
      CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
      IF (IRETOU.NE.0) GOTO 1000
      N  = ILENA(1)
      M=ITLAC(/1)
      do i=m+1,m+n
        itlac(**)=0
      enddo
      CALL LFCDIE (IORES,N,ITLAC(M+1),IRETOU,IFORM)
      IF(IRETOU.NE.0) GOTO 1000
      DO 242 I=m+1,m+n
         ITOTO=ITLAC(I)
         LOGI=.FALSE.
         IF(ITOTO.EQ.1)LOGI=.TRUE.
         CALL QUERAN (IRAT,'LOGIQUE ',IVB,XVA,CTYPE,LOGI,IOB)
         ITLAC(i) =IRAT
 242  CONTINUE
      mlnouv=itlac(/1)
      GOTO 1098
C     ******************************FLOTTANT**********************
 6025 CONTINUE
      ITOTO=1
      CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
      IF (IRETOU.NE.0) GOTO 1000
      N    =   ILENA(1)
      M=ITLAC(/1)
      L=N
      SEGINI ITBBR1
      CALL LFCDI2(IORES,N,TABR1,IRETOU,IFORM)
      IF(IRETOU.NE.0) GOTO 1000
      DO 250 I=1,N
         XVA=TABR1(I)
         CALL QUERAN(IRAT,'FLOTTANT',IVB,XVA,CTYPE,LOGI,IOB)
         ITLAC(**)=IRAT
 250  CONTINUE
      SEGSUP ITBBR1
      ITBBR1=0
      mrnouv=itlac(/1)
      GOTO 1098
C     **************************** ENTIER***************************
 6026 CONTINUE
      ITOTO=1
      CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
      IF (IRETOU.NE.0) GOTO 1000
      N    =   ILENA(1)
      M=ITLAC(/1)
      L=N
      NN=L
      SEGINI ITBBE1
      CALL LFCDEE(IORES,N,ITABE1,IRETOU,IFORM)
      IF(IRETOU.NE.0) GOTO 1000
      DO 260 I=1,L
         IVB=ITABE1(I)
         itlac(**)=ivb
 260  CONTINUE
      SEGSUP ITBBE1
      minouv=itlac(/1)
      GOTO 1098
C     **************************** MOT   ***************************
 6027 CONTINUE
      ITOTO=2
      CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
      IF (IRETOU.NE.0) GOTO 1000
      N    =   ILENA(2)
      NNN=N
      NN=ILENA(1)
      SEGINI ITAMOT
      MM=ITLAC(/1)+1
      DO 271 I=1,N
         ITLAC(**)=0
 271  CONTINUE
      CALL LFCDIC(IORES,ITAMO,IRETOU,IFORM)
      IF(IRETOU.NE.0) GOTO 1000
      CALL LFCDIE(IORES,N,ICOTA,IRETOU,IFORM)
      IF(IRETOU.NE.0) GOTO 1000
      M=1
      DO 270 I=1,N
         LL=ICOTA(I)
         NN=ICOTA(I)-M+1
         IVA=NN
         CHA1(1:NN)=ITAMO(M:LL)
         M=LL+1
         CALL QUERAN(IRAT,'MOT     ',IVA,XVA,CHA1(1:NN),LOGI,IOB)
         if (irat.eq.0) call erreur(5)
         ITLAC(MM+I-1) =IRAT
 270  CONTINUE
      SEGSUP ITAMOT
      mmnouv=itlac(/1)
      GOTO 1098
C     ****************************TEXTE    *************************
 6028 CONTINUE
      DO 280 IEL=1,IMAX1
         ITOTO=1
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         N = ILENA(1)
         SEGINI MTEXTE
         NCART= N
         CALL LFCDIC(IORES,MTEXT,IRETOU,IFORM)
         SEGDES MTEXTE
         IF(IRETOU.NE.0) GOTO 1000
         ITLAC(**)=MTEXTE
 280  CONTINUE
      GOTO 1098
C     ******************************MLMOTS****************************
 6029 CONTINUE
      DO 290 IEL=1,IMAX1
         ITOTO=2
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         JGN = ILENA(1)
         JGM = ILENA(2)
         SEGINI MLMOTS
         NN=JGN*JGM
         NNN=0
         SEGINI ITAMOT
         CALL LFCDIC(IORES,ITAMO,IRETOU,IFORM)
         IF(IRETOU.NE.0) GOTO 1000
         DO 56 IUH = 1,JGM
            MOTS(IUH)= ITAMO((IUH-1)*JGN+1:IUH*JGN)
 56      CONTINUE
         SEGSUP ITAMOT
         SEGDES MLMOTS
         ITLAC(**)=MLMOTS
 290  CONTINUE
      GOTO 1098
C    **************************MVECTE**********************************
 6030 CONTINUE
      DO 300 IOB=1,IMAX1
         IRETOU=0
         CALL LIVECT (MVECTE,IORES,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         ITLAC(**)=MVECTE
 300  CONTINUE
      GOTO 1098
C     ************************* VECTD    ***************************
 6031 CONTINUE
      DO 310 IEL=1,IMAX1
         ITOTO=1
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         INC  =   ILENA(1)
         SEGINI MVECTD
         CALL LFCDI2(IORES,N,VECTBB,IRETOU,IFORM)
         SEGDES MVECTD
         IF(IRETOU.NE.0) GOTO 1000
         ITLAC(**)=MVECTD
 310  CONTINUE
      GOTO 1098
C     **************************** POINTS **************************
 6032 CONTINUE
      ITOTO=1
      CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
      IF (IRETOU.NE.0) GOTO 1000
      N    =   ILENA(1)
      M = ITLAC(/1)
      IPLU=N-M
      DO 322 I=1,IPLU
         ITLAC(**)=0
 322  CONTINUE
      CALL LFCDIE(IORES,N,ITLAC,IRETOU,IFORM)
      IF(IRETOU.NE.0) GOTO 1000
      DO 321 I=1,N
         ITLAC(I)=ITLAC(I)+NBANC
 321  CONTINUE
      GOTO 1098
C     ****************************CONFIG   *************************
 6033 CONTINUE
      IAV=ITLAC(/1)
*      write(6,*) ' imax1 iav ' , imax1,iav
      iconul=0
      ibon=0
      DO 330 IEL=1,IMAX1
         ITOTO=1
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
*         write(6,*) ' lipil iel  ilena(1)' , iel , ilena(1)
         IF (IRETOU.NE.0) GOTO 1000
         ILONG=ILENA(1)
*         write(6,*) ' lipil iel  ilong' , iel , ilong
         if(ilong.eq.0) then
         iconul=iconul+1
*           nbpts=idim+1
*           segini mcoor1
*           itlac(**)=mcoor1
           GOTO 330
         endif
         IDRES=IDIM
         IDIM  = 0
*         write(6,*) ' iel ilong idres nbanc ', iel,ilong,idres,nbanc
         NBPTS = ILONG+NBANC*(IDRES+1)
         SEGINI MCOOR1
         if(ibon.eq.0) ibon=mcoor1
         IDIM=IDRES
         IDIM11= (IDIM+1)*NBANC+1
         CALL LFCDI2(IORES,ILONG,MCOOR1.XCOOR(IDIM11),IRETOU,IFORM)
         IF(IRETOU.NE.0) GOTO 1000
         DO 332 J=1,NBANC*(IDIM+1)
            MCOOR1.XCOOR(J)=XCOOR(J)
 332     CONTINUE
*         write(6,*) ' mcoor1' , mcoor1
          if (ionive.gt.26) then
           CALL LFCDIE (IORES,2,ILENA,IRETOU,IFORM)
           idimr=ilena(1)
           nbpts=ilena(2)
           if (idimr.gt.0) then
            mrotat=mcoord.mrota
            if (mrotat.eq.0) segini mrotat
            segini mrota1
            ilong=idimr*nbpts
            CALL LFCDI2(IORES,ILONG,xrota(1,nbanc+1),IRETOU,IFORM)
            DO  J=1,NBANC
            DO  i=1,idimr
              mrota1.xrota(i,j)=xrota(i,j)
            enddo
            enddo
            mcoor1.mrota=mrota1
           endif
          endif
         SEGDES MCOOR1
         ITLAC(**)=MCOOR1
 330  CONTINUE
      IF(IONIVE.GT.9) THEN
         if( iconul.ne.imax1) then
          MCOOR1=Ibon
          SEGACT MCOOR1*MOD
          SEGDES MCOORD
          MCOORD=MCOOR1
          nbpts=xcoor(/1)/(idim+1)
*         write(6,*) ' mcoord ' , mcoord
         endif
      ENDIF
      GOTO 1098
C     *************************** MLCHPO   *************************
 6034 CONTINUE
      DO 340 IEL=1,IMAX1
         ITOTO=1
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         N1    =   ILENA(1)
         SEGINI MLCHPO
         ITLAC(**)=MLCHPO
         CALL LFCDIE(IORES,N1,ICHPOI,IRETOU,IFORM)
         SEGDES MLCHPO
         IF(IRETOU.NE.0) GOTO 1000
 340  CONTINUE
      GOTO 1098
C     ****************************MBASEM*****************************
 6035 CONTINUE
      NN=0
      DO 3500 IEL=1,IMAX1
         ITOTO=1
         CALL LFCDIE( IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         N=ILENA(1)
         SEGINI MBASEM
         DO 3501 I=1,N
            ITOTO=1
            CALL LFCDIE( IORES,ITOTO,ILENA,IRETOU,IFORM)
            IF (IRETOU.NE.0) GOTO 1000
            NIBST=ILENA(1)
            SEGINI MSOBAS
            LISBAS(I)=MSOBAS
            CALL LFCDIE(IORES,NIBST,IBSTRM(1),IRETOU,IFORM)
            IF (IRETOU.NE.0) GOTO 1000
            SEGDES MSOBAS
 3501    CONTINUE
         SEGDES MBASEM
         ITLAC(**)=MBASEM
 3500 CONTINUE
      GOTO 1098
C     *************************** PROCED ****************************
 6036 CONTINUE
c       ========= LES PROCEDURES NE SONT PAS SAUVEES =========
c       IMAX1=NOBJN
c       SEGACT NOMM1,NOMM2
c       DO 636 IEL=1,IMAX1
c          SEGACT NOMM1,NOMM2
c          CHA1(1:8)=NOM2(IEL)
c          CHA1(9:16)=' '
c          CALL CQUOI(CHA1(1:8),CHA1(9:16),IVAL,XVA,CHARI,LOGI,IOBJ)
c          IF(IERR.EQ.0)THEN
c             ITLAC(**)= IOBJ
c          ELSE
c             IRETOU=1
c             GOTO 1000
c          ENDIF
c  636  CONTINUE
      GOTO 1097
C     *************************** BLOC   ****************************
 6037 CONTINUE
      GOTO 1097
C     *************************** MMODEL ****************************
 6038 CONTINUE
      CALL LIMODL(IORES,ITLACC,IMAX1,IRETOU,IFORM,NIVEAU,NBANC)
      IF (IRETOU.NE.0) GOTO 1000
      GOTO 1098
C     *************************** MCHAML ****************************
 6039 CONTINUE
      CALL LICHAM(IORES,ITLACC,IMAX1,IRETOU,IFORM,NIVEAU)
      IF (IRETOU.NE.0) GOTO 1000
      GOTO 1098
C     *************************** MINTE  ****************************
 6040 CONTINUE
      DO 2840 IEL=1,IMAX1
         ITOTO=2
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         NBNO   = ILENA(1)
         NBPGAU = ILENA(2)
         L=NBPGAU*4+6*NBPGAU*NBNO
         SEGINI ITBBR1
         CALL LFCDI2 (IORES,L,TABR1,IRETOU,IFORM)
         IF(IRETOU.NE.0) GOTO 1000
         SEGINI MINTE
         I=0
         DO 2841 IC=1,NBPGAU
            I=I+1
            POIGAU(IC)=TABR1(I)
            I=I+1
            QSIGAU(IC)=TABR1(I)
            I=I+1
            ETAGAU(IC)=TABR1(I)
            I=I+1
            DZEGAU(IC)=TABR1(I)
            DO 28411 IB=1,NBNO
               DO 28412 IA=1,6
                  I=I+1
                  SHPTOT(IA,IB,IC)=TABR1(I)
28412          CONTINUE
28411       CONTINUE
 2841    CONTINUE
         SEGSUP ITBBR1
         SEGDES MINTE
         ITLAC(**)=MINTE
 2840 CONTINUE
      GOTO 1098
C    **************************NUAGE ***************************
 6041 CALL LINUAG(IORES,ITLACC,IMAX1,IRETOU,IFORM)
      IF(IRETOU.NE.0) GOTO 1000
      GOTO 1098
C     ************************* MATRAK ********************************
 6042 CONTINUE
      CALL LIMTAK(IORES,ITLACC,IMAX1,IRETOU,IFORM)
      IF (IRETOU.NE.0) GOTO 1000
      GOTO 1098
C     ************************* MATRIK ********************************
 6043 CONTINUE
      CALL LIMTIK(IORES,ITLACC,IMAX1,IRETOU,IFORM)
      IF (IRETOU.NE.0) GOTO 1000
      GOTO 1098
C  **************************  METHODE *****************************
 6045 CONTINUE
      DO 6945 I=1,IMAX1
         ITLAC(**)=0
 6945 CONTINUE
      CALL LFCDIE(IORES,1,ILENA,IRETOU,IFORM)
      IF (IRETOU.NE.0) GOTO 1000
      CALL LFCDIE(IORES,IMAX1,ITLAC,IRETOU,IFORM)
      IF (IRETOU.NE.0) GOTO 1000
      GOTO 1098
C     ************************* IELVAL ********************************
 6048 CONTINUE
      CALL LIIELV(IORES,ITLACC,IMAX1,IRETOU,IFORM)
      IF (IRETOU.NE.0) GOTO 1000
      GOTO 1098
C     ************************ LISTOBJE *******************************
 6050 CONTINUE
      DO 500 IEL=1,IMAX1
         ITOTO=1
         IF (IONIVE.GT.27) ITOTO=2
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GOTO 1000
         NOBJ = ILENA(1)
         NREE = 0
         IF (ITOTO.GT.1) NREE = ILENA(2)
         SEGINI, MLOBJE
         IK = 1
         IF (NREE.GT.0) IK = 2
         ITLAC(**)=MLOBJE
         NM2 = 2
         SEGINI, ITBBM2,itbbc3
         IF (IFORM.NE.2) THEN
           CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM)
           IF(IRETOU.NE.0) GOTO 1000
           WRITE (TYPOBJ,FMT='(2A4)') ITABM2(1),ITABM2(2)
         ELSE
           ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4))
C          write (6,*) ' TYPOBJ itabc3 ',itabc3(1),itabc3(2)
           TYPOBJ(1:4)=itabc3(1)
           TYPOBJ(5:8)=itabc3(2)
         ENDIF
         IF (IK.EQ.1) CALL LFCDIE(IORES,NOBJ,LISOBJ,IRETOU,IFORM)
         IF (IK.EQ.2) CALL LFCDI2(IORES,NREE,RLIREE,IRETOU,IFORM)
         SEGDES, MLOBJE
         IF(IRETOU.NE.0) GOTO 1000
 500  CONTINUE
      GOTO 1098
C     ************************* IMODEL ********************************
 6051 CONTINUE
      if (niveau.lt.26) then
        write(ioimp,*) 'Pile n existant pas avant le niveau 26'
        call erreur(5)
        return
      endif
      CALL LIIMOD(IORES,ITLACC,IMAX1,IRETOU,IFORM)
      IF (IRETOU.NE.0) GOTO 1000
      GOTO 1098

C     ******************************************************************
C     *****FIN DE LECTURE D'UNE PILE : NOM DES OBJETS*******************
C
 1098 CONTINUE

C  ****  KCOLAC(IFILE)=IMAX1+ KCOLAC(IFILE)
      CALL CREOB (ITYPE,NOMM1,NOMM2,ITLACC,mianc,mranc,mlanc,mmanc)
      IF(IFIN.EQ.1) GOTO 1000
      GOTO 1097
********************* ON REBOUCLE EN LECTURE **********************
 1000 CONTINUE
 1099 CONTINUE
 1001 CONTINUE
      CALL HHOPIL(6,NIVEAU,ICOLAC)
      IRET=IRETOU
      IF(NOMM1.NE.0) SEGSUP NOMM1
      IF(NOMM2.NE.0) SEGSUP NOMM2
      IF (ITBBM1.NE.0) SEGSUP ITBBM1,itbbc1
      IF (ITBBM2.NE.0) SEGSUP ITBBM2,itbbc3
      IF (ITBBE1.NE.0) SEGSUP ITBBE1
      IF (ITBBE2.NE.0) SEGSUP ITBBE2,itbbc2
      IF (ITBBR1.NE.0) SEGSUP ITBBR1

      SEGDES ICOLAC

      RETURN
C -------------------------------------------------------
 8000 FORMAT(16I5)
 8001 FORMAT(16(1X,A4))
      END