C LIPIL     SOURCE    PV        14/01/30    21:15:06     7929           
      SUBROUTINE LIPIL (ICOLAC,IFIN,IRET,IFORM,LABEL)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
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=======================================================================
-INC CCOPTIO
-INC SMELEME
-INC SMBASEM
-INC SMCOORD
      POINTEUR MCOOR1.MCOORD,MCOOR2.MCOORD
-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 CCGEOME
-INC TMCOLAC
-INC CCFXDR
C     
      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*(8) NOM2(NOBJN1)
      ENDSEGMENT
      SEGMENT ITAMOT
      CHARACTER*(NN) ITAMO
      INTEGER ICOTA(NNN)
      ENDSEGMENT
C     
      DIMENSION IPVV(2)
      DIMENSION ILENA(30)
      DIMENSION NOMM(2)
      CHARACTER*(8) ITYPE,CTYPE
      CHARACTER*72 LABEL
      REAL*8 XVA
      LOGICAL LOGI
      CHARACTER*(72) CHA1T
      CHARACTER*(512) CHA1
      CHARACTER*(1) CHARI
      REAL*4 DENSI4
C--------------------------------------------------------------------
      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
      SEGINI NOMM2
      SEGACT ICOLAC*MOD
      NBANC=XCOOR(/1)/(IDIM+1)
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 ',I6,'  CODE RETOUR DE LECTURE =',I2)
      IF(IRETOU.NE.0) THEN
         IF( IONIVE.GE.10) THEN
            IF(LABEL.EQ.' '.AND.CHA1T.NE.' ') THEN
               IRETOU=0
               GO TO 1001
            ELSE
               MOTERR(1:24) = LABEL
               CALL ERREUR (874)
               GO TO 1000
            ENDIF
         ELSE
            MOTERR(1:24) = LABEL
            CALL ERREUR (874)
            GO TO 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,/)
            IF(LABEL.NE.' ') THEN
               IF(LABEL.EQ.CHA1T ) GO TO 1001
            ENDIF
            GO TO 1097
         ENDIF
      ENDIF
      GO TO (999 ,5000,4000,444,1001,999 ,4001 ),IQUOI
C --- ERREUR
 999  GO TO 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   
      IONIVE=NIVEAU
 701  FORMAT(7X,I4,14X,I4,10X,I4)
      WRITE (IOIMP,33201) NIVEAU
33201 FORMAT (//,' NIVEAU DU FICHIER',I3)
CCCCC IF (NIVEAU.NE.0) GOTO 1000
      IF (IFORM.EQ.1) READ(IORES,702) DENSIT
      IF (IFORM.EQ.0) READ(IORES) DENSIT
      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)
*      IERR=0
      CALLGINT2
      IF (IDIM.EQ.0) IDIM=JDIM
      IF (JDIM.NE.0.AND.JDIM.NE.IDIM) CALL ERREUR(12)
      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) GO TO 1000
      IFILE  =ILENA(1)
      NOBJN  =ILENA(2)
      IMAX1  =ILENA(3)
      ITYPE=' '
      IF(IFILE.NE.0) THEN
         CALL TYPFIL(ITYPE,IFILE)
         WRITE (IOIMP,805) IMAX1,ITYPE
 805     FORMAT( ' LECTURE DE ',I5 , ' 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',I5,
     1     ' OBJETS, PARMI LESQUELS ',I5,' SONT NOMMES.')
 804  FORMAT(///' * IL Y A ',I6,' 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.EQ.0) GO TO 5001
C      KCOLAC(IFILE)=IMAX1+ KCOLAC(IFILE)
      ITLACC=KCOLA(IFILE)
      IRETOU=0
C --- 
      if(ionive.ge.17) then
        if(ifile.ge.24.and.ifile.le.27) then
          segsup itlacc
          segini itlacc
          kcolac(ifile)=imax1
          kcola(ifile) = itlacc
        endif
      endif
      GO TO (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,
     1       6042,6043,6010,6045     ),IFILE
 1002 MOTERR(1:8)=ITYPE
      CALL ERREUR(336)
      GO TO 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) GO TO 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) GO TO 1000
         ITLAC(**)=MELEME
    7 CONTINUE
      GOTO 1098
C     **************************CHPOINT*********************************
 6002 CONTINUE
      CALL LICHPO(IORES,ITLACC,IMAX1,IRETOU,IFORM)
      IF (IRETOU.NE.0) GO TO 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) GO TO 1000
         NRIGEL=   ILENA(1)
         ICHO  =   ILENA(2)
         NBGEOR=   ILENA(3)
         NRIGE =   ILENA(4)
         J     =   ILENA(5)
         SEGINI MRIGID
         ITLAC(**)=MRIGID
         IFORIG=J
C     READ(IORES,8001,END=1000,ERR=1000)MTYMAT(1),MTYMAT(2)
         ITOTO=2
CCC   CALL LFCDIM (IORES,ITOTO,MTYMAT,IRETOU,IFORM)
         if (iform.ne.2) then
         CALL LFCDIM (IORES,ITOTO,IPVV,IRETOU,IFORM)
         IF (IRETOU.NE.0) GO TO 1000
         WRITE(MTYMAT,FMT='(2A4)') IPVV(1),IPVV(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) GO TO 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) 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) 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) GO TO 1000
         N=ILENA(1)
         SEGINI MCLSTR
         ITLAC(**)= MCLSTR
         CALL LFCDIE (IORES,N    ,ISOSTR,IRETOU,IFORM)
         IF(IRETOU.NE.0) GO TO 1000
         CALL LFCDIE (IORES,N    ,IRIGCL,IRETOU,IFORM)
         IF(IRETOU.NE.0) GO TO 1000
         SEGDES MCLSTR
 60   CONTINUE
      GO TO 1098
C ********************************ELEM STRUC
 6007 CONTINUE
      DO 70 IEL=1,IMAX1
         ITOTO=1
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF(IRETOU.NE.0) GO TO 1000
         N=ILENA(1)
         SEGINI MELSTR
         ITLAC(**) =MELSTR
         CALL LFCDIE (IORES,N    ,ISOSTU,IRETOU,IFORM)
         IF(IRETOU.NE.0) GO TO 1000
         CALL LFCDIE (IORES,N    ,IMELEM,IRETOU,IFORM)
         IF(IRETOU.NE.0) GO TO 1000
         SEGDES MELSTR
 70   CONTINUE
      GO TO 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) GO TO 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) GO TO 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) GO TO 1000
         NN=ILENA(1)
CCC   IF (NN.EQ.0) GO TO 109
         M=NN/4
         SEGINI MTABLE
         MLOTAB=M
         IF (NN.EQ.0) GO TO 713
         SEGADJ ITBBE1
         CALL LFCDIE (IORES,NN,ITABE1,IRETOU,IFORM)
*        write (6,*) ' lipil table ',(itabe1(ii),ii=1,nn)
         IF(IRETOU.NE.0) GO TO 1000
         KK=0
         DO 711 K=1,NN,4
            KK=KK+1
            J=ITABE1(K)
            IVA=ITABE1(K+1)
            CTYPE=' '
            CALL  TYPFIL (CTYPE,J)
            MTABII(KK)=IVA
            MTABTI(KK)=CTYPE
            J=ITABE1(K+2)
            IVA=ITABE1(K+3)
            CTYPE=' '
            CALL  TYPFIL (CTYPE,J)
** 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
      GO TO 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) GO TO 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) GO TO 1000
         ITYSOU=  ITABE1(1)
         ISRAID=  ITABE1(2)
         ISMASS=  ITABE1(3)
         IF (NS.EQ.0) GO TO 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
      NN=0
      SEGINI ITBBE1
      DO 2300 IEL=1,IMAX1
C     READ(IORES,8000,END=1000,ERR=1000)NELRIG
         ITOTO=1
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GO TO 1000
         nelrig=0
         nligrp=0
         nligrd=0
         NELRIG=   ILENA(1)
            NN=2
         SEGADJ ITBBE1
         CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM)
         IF(IRETOU.NE.0) GOTO 1000
            NLIGRD=ITABE1(1)
            NLIGRP=ITABE1(2)
            LVAL=NLIGRP*NLIGRD
            segini xmatri
*            write(6,*) ' nligrd nligrp nelrig',nligrd,nligrp,nelrig
         ITLAC(**)=xMATRI
         DO 2301 J=1,NELRIG
            if (lval.ne.0) 
     >           CALL LFCDI2(IORES,LVAL,RE(1,1,j),IRETOU,IFORM)
            IF(IRETOU.NE.0) GOTO 1000
 2301    CONTINUE
         SEGDES xMATRI
 2300 CONTINUE
      SEGSUP ITBBE1
      GOTO 1098
C     ***************************** MJONCT *****************************
 6014 CONTINUE
      CALL LIJONC (IORES,ITLACC,IMAX1,IRETOU,IFORM)
      IF (IRETOU.NE.0) GO TO 1000
      GOTO 1098
C     ***************************** MATTAC *****************************
 6015 CONTINUE
      CALL LIATTA (IORES,ITLACC,IMAX1,IRETOU,IFORM)
      IF (IRETOU.NE.0) GO TO 1000
      GOTO 1098
C     ***************************** MMATRI *****************************
 6016 CONTINUE
      CALL LIMMAT (IORES,ITLACC,IMAX1,IRETOU,IFORM)
      IF (IRETOU.NE.0) GO TO 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) GO TO 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) GO TO 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) GO TO 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) GO TO 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) GO TO 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) GO TO 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) GO TO 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)
               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) GO TO 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
         NN=3*N
         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) GO TO 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
            I4=3*IN
            IPROGX=ITABE1(I4-2)
            IPROGY=ITABE1(I4-1)
            NUMEVX=ITABE1(I4)
            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) GO TO 1000
         NTOTO=ILENA(1)
         SEGINI MSUPER
         ITLAC(**)=MSUPER
         CALL LFCDIE (IORES,NTOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GO TO 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
      GO TO 1000
C     ************************* LOGIQUE  ***************************
 6024 CONTINUE
      ITOTO=1
      CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
      IF (IRETOU.NE.0) GO TO 1000
      N  = ILENA(1)
      M=ITLAC(/1)+1
      NM=M+N-1
      DO 241 I=1,N
         ITLAC(**)=0
 241  CONTINUE
      CALL LFCDIE (IORES,N,ITLAC(M),IRETOU,IFORM)
      IF(IRETOU.NE.0) GOTO 1000
      DO 242 I=M,NM
         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
      GO TO 1098
C     ******************************FLOTTANT**********************
 6025 CONTINUE
      ITOTO=1
      CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
      IF (IRETOU.NE.0) GO TO 1000
      N    =   ILENA(1)
      M=ITLAC(/1)
      DO 251 I=1,N
         ITLAC(**)=0
 251  CONTINUE
      L=N
      SEGINI ITBBR1
      CALL LFCDI2(IORES,N,TABR1,IRETOU,IFORM)
      IF(IRETOU.NE.0) GO TO 1000
      DO 250 I=1,N
         XVA=TABR1(I)
         CALL QUERAN(IRAT,'FLOTTANT',IVB,XVA,CTYPE,LOGI,IOB)
         ITLAC(I+M)=IRAT
 250  CONTINUE
      SEGSUP ITBBR1
      ITBBR1=0
      GO TO 1098
C     **************************** ENTIER***************************
 6026 CONTINUE
      ITOTO=1
      CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
      IF (IRETOU.NE.0) GO TO 1000
      N    =   ILENA(1)
      M=ITLAC(/1)
      DO 261 I=1,N
         ITLAC(**)=0
 261  CONTINUE
      L=N
      NN=L
      SEGINI ITBBE1
      CALL LFCDEE(IORES,N,ITABE1,IRETOU,IFORM)
      IF(IRETOU.NE.0) GO TO 1000
      DO 260 I=1,L
         IVB=ITABE1(I)
         CALL QUERAN(IRAT,'ENTIER  ',IVB,XVA,CTYPE,LOGI,IOB)
         ITLAC(M+I)=IRAT
 260  CONTINUE
      SEGSUP ITBBE1
      GOTO 1098
C     **************************** MOT   ***************************
 6027 CONTINUE
      ITOTO=2
      CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
      IF (IRETOU.NE.0) GO TO 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) GO TO 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)
         ITLAC(MM+I-1) =IRAT
 270  CONTINUE
      SEGSUP ITAMOT
      GOTO 1098
C     ****************************TEXTE    *************************
 6028 CONTINUE
      DO 280 IEL=1,IMAX1
         ITOTO=1
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GO TO 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
      GO TO 1098
C     ******************************MLMOTS****************************
 6029 CONTINUE
      DO 290 IEL=1,IMAX1
         ITOTO=2
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GO TO 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
         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) GO TO 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) GO TO 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) GO TO 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) GO TO 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
           go to 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
         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
*         write(6,*) ' mcoord ' , mcoord
         endif
      ENDIF
      GO TO 1098
C     *************************** MLCHPO   *************************
 6034 CONTINUE
      DO 340 IEL=1,IMAX1
         ITOTO=1
         CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM)
         IF (IRETOU.NE.0) GO TO 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) GO TO 1000
         N=ILENA(1)
         SEGINI MBASEM
         DO 3501 I=1,N
            ITOTO=1
            CALL LFCDIE( IORES,ITOTO,ILENA,IRETOU,IFORM)
            IF (IRETOU.NE.0) GO TO 1000
            NIBST=ILENA(1)
            SEGINI MSOBAS
            LISBAS(I)=MSOBAS
            CALL LFCDIE(IORES,NIBST,IBSTRM(1),IRETOU,IFORM)
            IF (IRETOU.NE.0) GO TO 1000
            SEGDES MSOBAS
 3501    CONTINUE
         SEGDES MBASEM
         ITLAC(**)=MBASEM
 3500 CONTINUE
      GOTO 1098
C     *************************** PROCED ****************************
 6036 CONTINUE
      IMAX1=NOBJN
      SEGACT NOMM1,NOMM2
      DO 636 IEL=1,IMAX1
         SEGACT NOMM1,NOMM2
         CHA1(1:8)=NOM2(IEL)
         CHA1(9:16)=' '
         CALL CQUOI(CHA1(1:8),CHA1(9:16),IVAL,XVA,CHARI,LOGI,IOBJ)
         IF(IERR.EQ.0)THEN
            ITLAC(**)= IOBJ
         ELSE
            IRETOU=1
            GO TO 1000
         ENDIF
 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) GO TO 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) GO TO 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) GO TO 1000
      GOTO 1098
C     ************************* MATRAK ********************************
 6042 CONTINUE
      CALL LIMTAK(IORES,ITLACC,IMAX1,IRETOU,IFORM)
      IF (IRETOU.NE.0) GO TO 1000
      GOTO 1098
C     ************************* MATRIK ********************************
 6043 CONTINUE
      CALL LIMTIK(IORES,ITLACC,IMAX1,IRETOU,IFORM)
      IF (IRETOU.NE.0) GO TO 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) GO TO 1000
      CALL LFCDIE(IORES,IMAX1,ITLAC,IRETOU,IFORM)
      IF (IRETOU.NE.0) GO TO 1000
      GOTO 1098
C     ******************************************************************
C     *****FIN DE LECTURE D'UNE PILE : NOM DES OBJETS*******************
C     
 1098 CONTINUE
*******  KCOLAC(IFILE)=IMAX1+ KCOLAC(IFILE)
      CALL CREOB (ITYPE,NOMM1,NOMM2,ITLACC)
      IF(IFIN.EQ.1) GOTO 1000
      GOTO 1097
********************* ON REBOUCLE EN LECTURE **********************
 1000 CONTINUE
 1099 CONTINUE
 1001 CONTINUE
      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