Télécharger femv12.eso

Retour à la liste

femv12
C FEMV12    SOURCE    CB215821  25/04/22    21:15:05     12245          
      SUBROUTINE FEMV12(IUFEM,NBLIGN,MTABLE)
 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C BUT: Lecture des fichiers .fem du profil OptiStruct de HyperMesh.
C      Les données sont rendues dans une table.
C
C Auteur : Clément BERTHINIER
C          Novembre 2013
C
C Liste des Corrections :
C  26/11/2013
C  Clément B. : Anomalie lors de l'import de coordonnées corrigée
C
C Appele par : LIRFEM
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
C Définition des COMMON utiles
-INC PPARAM
-INC CCOPTIO
-INC CCREDLE
-INC CCGEOME
 
C Définition des OBJETS utiles
C SMCOORD : à ne jamais désactiver contenant les coordonnées des points
C SMELEME : objet MAILLAGE
C SMTABLE : objet TABLE
-INC SMCOORD
-INC SMELEME
-INC SMTABLE
 
 
C***********************************************************************
C Définition des différents segments et de leur contenu
C***********************************************************************
      SEGMENT MLINOE
C       JGNOLO   : ID du noeud dans la numérotation LOCALE
C       JGNOLU   : ID du noeud lu dans le fichier
C       INOC3M   : Numéro du noeud dans la numérotation absolue de Cast3M
C       INOEHM   : Numéro du JGième noeud lu dans le fichier .fem
C       ICORNO   : Correspondance depuis la numérotation lue vers la numérotation LOCALE des noeuds
        INTEGER INOC3M(JGNOLO)
        INTEGER INOEHM(JGNOLO)
        INTEGER ICORNO(JGNOLU)
      ENDSEGMENT
 
      SEGMENT MLIELE
C       JGELLO   : ID de l'élément dans la numérotation LOCALE
C       JGELLU   : ID de l'élément lu dans le fichier
C       JELCON   : Nombre total connectivité lues
C       IELCON   : Ou aller lire le début de la connectivité dans ICONTO
C       IELNBN   : Nombre de noeuds de connectivité à lire dans ICONTO
C       IELTYP   : Type de l'élément lu pour Cast3M
C       IELPRO   : ID de la propriété dans HM (Valeur lue pour IVALU = 2)
C       IELCOM   : ID du component    dans HM dans lequel est rangé cet élément
C       ICONTO   : Tableau dans lequel sont placées toutes les connectivités les unes après les autres
C       ICOREL   : Correspondance depuis la numérotation LOCALE vers la numérotation lue des ELEMENTS
        INTEGER IELCON(JGELLU)
        INTEGER IELNBN(JGELLU)
        INTEGER IELTYP(JGELLU)
        INTEGER IELPRO(JGELLU)
        INTEGER IELCOM(JGELLU)
        INTEGER ICONTO(JELCON)
        INTEGER ICOREL(JGELLO)
      ENDSEGMENT
 
 
      SEGMENT MELEQU
C       Dans ce tableau dynamique sera stoquée la place dans NOMS (voir bdata.eso) des éléments équivalents Cast3M
        INTEGER IELEQU(NBGEOM)
      ENDSEGMENT
 
C     Segment contenant tout ce qui sera utile pour définir un component au sens HM
      SEGMENT MCOMP
C       JGCOLO   : Indice du composant dans la numérotation LOCALE
C       JGCOLU   : ID lu dans le fichier
C       NBGEOM   : Nombre de types d'éléments relu dans HM
C       NAMECO   : Nom     des components
C       ICOULC   : Couleur des components
C       NBTYPE   : Nombre de types d'éléments dans le component + le nombre total de sous type (NBSOUS) dans la dernière case
C       NBELCO   : Nombre d'éléments de chaque type dans le component (NBELEM)
C       NBELC2   : Nombre d'éléments de chaque type dans le component a mesure qu'ils sont triés (à la fin)
C       NPOINT   : Liste des pointeurs vers les MELEME simples de chaque component, l'indice NBGEOM+1 représente un pointeur de MELEME COMPLEXE au cas échéant
C       ICOCOR   : Correspondance entre la numérotation LOCALE et HM des components
        CHARACTER*80 NAMECO(JGCOLU)
        INTEGER      ICOULC(JGCOLU)
        INTEGER      NBTYPE(JGCOLU,NBGEOM+1)
        INTEGER      NBELCO(JGCOLU,NBGEOM)
        INTEGER      NBELC2(JGCOLU,NBGEOM)
        INTEGER      NPOINT(JGCOLU,NBGEOM+1)
        INTEGER      ICOCOR(JGCOLO)
      ENDSEGMENT
 
C     Segment contenant tout le necessaire pour reconstituer les SETS de noeuds et d'elements
      SEGMENT MSET
C       JGSELU   : ID  du SET lu
C       JGSELO   : ID  du SET incrémenté à chaque nouveau set (Numérotation Locale)
C       JGNBEL   : Nombre d'entité maximum lues pour un SET
C       NOMSET   : Nom du SET lu
C       ITYSET   : Type de SET lu (1 noeud, 2 element)
C       ILISTE   : Liste des ID des entités lues pour chaque SET LU(Noeuds ou Elements)
C       NBENTI   : Nombre d'entité lues Pour chaque SET
C       NBTYPS   : Nombre de types d'éléments dans le SET + le nombre total de sous type (NBSOUS) dans la dernière case
C       NBELSE   : Nombre d'éléments de chaque type dans le SET a mesure qu'ils sont triés (à la fin)
C       NPOINS   : Liste des pointeurs vers les MELEME simples de chaque SETS, l'indice NBGEOM+1 représente un pointeur de MELEME COMPLEXE au cas échéant
C       ISECOR   : Correspondance entre la numérotation LOCALE et HM (Lu) des Sets
        CHARACTER*80 NOMSET(JGSELU)
        INTEGER      ITYSET(JGSELU)
        INTEGER      ILISTE(JGNBEL,JGSELU)
        INTEGER      NBENTI(JGSELO)
        INTEGER      NBTYPS(JGSELU,NBGEOM+1)
        INTEGER      NBELSE(JGSELU,NBGEOM)
        INTEGER      NPOINS(JGSELU,NBGEOM+1)
        INTEGER      ISECOR(JGSELO)
      ENDSEGMENT
 
C     Segment contenant tout le necessaire pour reconstituer les LOADCOL (SPC, FORCE, MOMENT, PRESSION, TEMPERATURE)
      SEGMENT MLOCOL
C       JGLCLU   : ID  du LOADCOL lu
C       JGLCLO   : ID  du LOADCOL incrémenté à chaque nouveau LOADCOL (Numérotation Locale)
C       JGNBEN   : Nombre d'entité maximum lues pour un LOADCOL
C       NOMLOC   : Nom du LOADCOL lu
C       ILOCNO   : Liste des ID des noeuds lus pour chaque LOADCOL LU
C       ISPC     : Liste des blocages sous la forme d'un entier pour les SPC
C       TEMP     : Liste des températures sous la forme d'un flottant
C       FORCX    : Valeur de la force lue suivant X
C       FORCY    : Valeur de la force lue suivant Y
C       FORCZ    : Valeur de la force lue suivant Z
C       MOMX     : Valeur du moment lu suivant X
C       MOMY     : Valeur du moment lu suivant Y
C       MOMZ     : Valeur du moment lu suivant Z
C       NBENLC   : Nombre d'entité lues Pour chaque LOADCOL
C       ITYLOC   : Type de LOADCOL lu
C                  1- SPC
C                  2- TEMP
C                  3- FORCE
C                  4- MOMENT
C                  5- PRESSION Normale
C                  6- PRESSION Directionnelle (Vecteur contrainte)
C       ILCCOR   : Correspondance entre la numérotation LOCALE et HM (Lu) des LOADCOL
        CHARACTER*80 NOMLOC(JGLCLU)
        INTEGER      ITYLOC(JGLCLU)
        INTEGER      ILOCNO(JGNBEN,JGLCLU)
        INTEGER      ISPC(JGNBEN,JGLCLU)
        REAL*8       TEMP(JGNBEN,JGLCLU)
        REAL*8       FORCX(JGNBEN,JGLCLU)
        REAL*8       FORCY(JGNBEN,JGLCLU)
        REAL*8       FORCZ(JGNBEN,JGLCLU)
        REAL*8       MOMX(JGNBEN,JGLCLU)
        REAL*8       MOMY(JGNBEN,JGLCLU)
        REAL*8       MOMZ(JGNBEN,JGLCLU)
        INTEGER      NBENLC(JGLCLU)
        INTEGER      ILCCOR(JGLCLO)
      ENDSEGMENT
 
C***********************************************************************
C Définition des DATA et déclarations diverses
C***********************************************************************
      PARAMETER (NBNGEO=9)
      PARAMETER (NBREPR=3)
      PARAMETER (NBGEOM=16)
      PARAMETER (LONOBJ=1+NBGEOM+1)
 
C Déclaration des chaines de caractères
      CHARACTER*80  LIGNE
      CHARACTER*4   COLO4
      CHARACTER*8   MOTCL8
      CHARACTER*8   COLO8
      CHARACTER*9   COLO9
      CHARACTER*16  COLO16
      CHARACTER*17  COLO17
      CHARACTER*80  COLO80
 
C Déclaration de tableaux de chaines de caractères
      CHARACTER*8 NGTYPE(NBNGEO)
      CHARACTER*8 NREPRI(NBREPR)
      CHARACTER*8 GETYPE(NBGEOM)
      CHARACTER*4 GELEQU(NBGEOM)
 
C Décalration des Boleens
C      LOGICAL DEBCB
      LOGICAL PRECID
 
      LOGICAL BSPC
      LOGICAL BFORC
      LOGICAL BMOM
      LOGICAL BPRES
      LOGICAL BTEMP
 
 
 
      INTEGER GECONN(NBGEOM)
      INTEGER IORDCO(NBGEOM*20)
      INTEGER NOBJ(LONOBJ)
C     NOBJ( 1 ) : Nbr d'objets géométriques différents lus
C     NOBJ( n ) : Nombre d'objets géométriques de chaque type Lus
C     NOBJ(end) : Nombre d'éléments lu au total
 
 
 
C     Liste des mots clé non Géométrique en début de ligne d'un fichier .fem
      DATA NGTYPE / '$HMMOVE ',
     &              '$HMNAME ',
     &              '$HWCOLOR',
     &              '$HMSET  ',
     &              'SPC     ',
     &              'TEMP    ',
     &              'FORCE   ',
     &              'MOMENT  ',
     &              'PLOAD4  ' /
 
C     Liste des mots clé non Géométrique en début de ligne d'un fichier .fem
      DATA NREPRI / '+       ',
     &              '*       ',
     &              '$       ' /
 
C Liste des mots clé de Géométrie en début de ligne d'un fichier .fem
      DATA GETYPE / 'GRID    ','GRID*   ',
     &              'RBE2    ','RBE3    ',
     &              'CTRIA3  ','CTRIA6  ',
     &              'CQUAD4  ','CQUAD8  ',
     &              'CTETRA  ','CTETRA10',
     &              'CPYRA   ','CPYRA13 ',
     &              'CPENTA  ','CPENTA15',
     &              'CHEXA   ','CHEXA20 ' /
 
C Elements equivalents dans Cast3M
      DATA GELEQU / 'POI1','POI1',
     &              'SEG2','SEG3',
     &              'TRI3','TRI6',
     &              'QUA4','QUA8',
     &              'TET4','TE10',
     &              'PYR5','PY13',
     &              'PRI6','PR15',
     &              'CUB8','CU20' /
 
C     Data indiquant le nombre de noeud de connectivité pour chaque Elements
      DATA GECONN / 1,1 ,
     &              2,3 ,
     &              3,6 ,
     &              4,8 ,
     &              4,10,
     &              5,13,
     &              6,15,
     &              8,20 /
 
 
C     Data permettrant de mettre le bon ordre dans la connectivité des éléments
C     Le facteur 20 de ce DATA vient du fait que l'élément le plus
C     Complexe a une connectivité à 20 éléments (CU20 ou HEXA 2nd Ordre)
      DATA IORDCO /
     &     1,0,0,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         POI1
     &     1,0,0,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         POI1
     &     1,2,0,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         SEG2
     &     3,1,2,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         SEG3
     &     1,2,3,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         TRI3
     &     1,4,2,5 ,3,6 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         TRI6
     &     1,2,3,4 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         QUA4
     &     1,5,2,6 ,3,7 ,4 ,8 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         QUA8
     &     1,2,3,4 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         TET4
     &     1,5,2,6 ,3,7 ,8 ,9 ,10,4 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         TE10
     &     1,2,3,4 ,5,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         PYR5
     &     2,7,3,8 ,4,9 ,1 ,6 ,11,12,13,10,5 ,0 ,0 ,0 ,0,0 ,0,0 ,         PY13
     &     1,2,3,4 ,5,6 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         PRI6
     &     1,7,2,8 ,3,9 ,10,11,12,4 ,13,5 ,14,6 ,15,0 ,0,0 ,0,0 ,         PR15
     &     1,2,3,4 ,5,6 ,7 ,8 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         CUB8
     &     1,9,2,10,3,11,4 ,12,13,14,15,16,5 ,17,6 ,18,7,19,8,20 /        CU20
 
C Option de Débuggage par Clément BERTHINIER
C      DEBCB = .TRUE.
C      DEBCB = .FALSE.
 
 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C      IF (DEBCB) THEN
C        WRITE(IOIMP,*)'Entree dans la Subroutine LIRFEM '
C      ENDIF
 
C Création de la table VIDE de sortie
      M=0
      SEGINI,MTABLE
 
C Format de lecture d'un fichier .fem
C 10 fois 8  caractères par ligne en simple précision
C 5  fois 16 caractères par ligne en double précision
 
 1000 FORMAT(A80)
 
C Initialisation des Segments
      MLINOE = 0
      MLIELE = 0
      MELEQU = 0
      MCOMP  = 0
      MSET   = 0
 
C Initialisations autres
C Increment de NOEUD
      INCJGN = 5000
C Increment d' ELEMENT
      INCJGE = 5000
C Increment de CONNECTIVITE
      INCJCO = 5000
C Increment de COMPONENT
      INCCOM = 10
C Increment de SETS
      INCSET = 10
C Increment de LOADCOL
      INCLOC = 10
 
      IRETO1 = 0
      IRETO2 = 0
      IRETO3 = 0
      IRETO4 = 0
      IVALU  = 0
      IDLU   = 0
      IDLU0  = 0
      IDLU1  = 0
      IDCOMP = 0
      IDTYPE = 0
      IDELEM = 0
      IDCONN = 0
      IDCOCA = 0
      IDCOLU = 0
      IDMAIL = 0
      INDICE = 0
      JNDICE = 0
      ICOL   = 0
      ITEST  = 0
      IADD   = 0
      IENTLU = 0
 
      IPT1   = 0
      IPT2   = 0
 
      LCOL   = 0
      NCOLOL = 0
      NBCONN = 0
      NBCOMP = 0
      NBSETS = 0
      NBLOCO = 0
 
      NBNPTS = 0
      NELTOT = 0
      NENTIT = 0
 
      XNCJG  = REAL(2.0D0)
 
      PRECID = .FALSE.
      BSPC   = .FALSE.
      BFORC  = .FALSE.
      BMOM   = .FALSE.
      BPRES  = .FALSE.
      BTEMP  = .FALSE.
C Tableau NOBJ initialisé à 0
      DO 1 INDICE = 1, LONOBJ
        NOBJ(INDICE)=0
 1    CONTINUE
 
C Segment de lecture libre
      SEGINI,sredle
      SEPARA=.FALSE.
      MOT=' '
 
C Initialisation des segments
      JGNOLU=INCJGN
      JGNOLO=INCJGN
      SEGINI,MLINOE
 
      JGELLU=INCJGE
      JGELLO=INCJGE
      JELCON=INCJCO
      SEGINI,MLIELE
 
      SEGINI,MELEQU
 
      JGCOLU=INCCOM
      JGCOLO=INCCOM
      SEGINI,MCOMP
 
      JGNBEL=INCJGE
      JGSELU=INCSET
      JGSELO=INCSET
      SEGINI,MSET
 
 
C      JGENLU=INCJGE
      JGNBEN=INCJGE
      JGLCLU=INCLOC
      JGLCLO=INCLOC
      SEGINI,MLOCOL
 
      segact mcoord*mod
      NBANC=nbpts
      idimp1=IDIM+1
      NBPTS=NBANC+JGNOLO
      SEGADJ,MCOORD
 
C     Remplissage du tableau d'entier représentant la place dans NOMS (Type d'élément selon CastM3)
C     La taille de NOMS est spécifiée maximum égale à 100 dans CCGEOME.INC
      DO 9 INDICE = 1, NBGEOM
        COLO4=GELEQU(INDICE)
        CALL PLACE(NOMS,100,IRETO3,COLO4)
        IELEQU(INDICE)=IRETO3
 9    CONTINUE
 
 10   CONTINUE
C     Lecture de la ligne complete (80 caracteres)
      READ(IUFEM,1000,ERR=989,END=100) LIGNE
      NBLIGN = NBLIGN + 1
C       IF (DEBCB) THEN
C         WRITE(IOIMP,*) 'Nombre de LIGNES : ',NBLIGN
C       ENDIF
 
C     Premier mot de la ligne
      COLO8=LIGNE(1:LEN(COLO8))
 
C     Largeur des colonnes à lire par défaut en Simple Précision
      PRECID = .FALSE.
 
C     Recherche si balise de suite d'instruction
      CALL PLACE(NREPRI,NBREPR,IRETO4,COLO8)
      IF (IRETO4.NE.0) THEN
        IF (IRETO4.EQ.2) THEN
          PRECID = .TRUE.
        ENDIF
        GOTO 12
      ENDIF
 
C     Recherche dans le DATA des mots-clés non géométriques
      CALL PLACE(NGTYPE,NBNGEO,IRETO2,COLO8)
      IF (IRETO2.NE.0) THEN
        IVALU = 0
      ENDIF
 
C     Recherche dans le DATA des éléments géométriques
      CALL PLACE(GETYPE,NBGEOM,IRETO1,COLO8)
      IF (IRETO1.NE.0) THEN
        IF (IRETO1.EQ.2) THEN
          PRECID = .TRUE.
        ENDIF
        IVALU = 0
 
C       Si le type rencontré n'avait pas été rencontré alors j'incrémente le nombre d'objet de ce type
        IF ( NOBJ(1+IRETO1).EQ.0) THEN
          NOBJ(1) = NOBJ(1) + 1
        ENDIF
 
C       Incrémente le nombre total d'éléments lus dans la dernière case de NOBJ
        IF (IRETO1.GT.2) THEN
           NOBJ(LONOBJ) = NOBJ(LONOBJ) + 1
        ENDIF
 
        NOBJ(1+IRETO1) = NOBJ(1+IRETO1)+1
        NBNPTS = NOBJ(2)+NOBJ(3)
        NELTOT = NOBJ(LONOBJ)
      ENDIF
 
 12   CONTINUE
 
C     Détermination du Format de Lecture des colonnes
      IF (PRECID) THEN
        NCOLOL = 4
        LCOL   = LEN(COLO16)
      ELSE
        NCOLOL = 9
        LCOL   = LEN(COLO8)
      ENDIF
 
C     Boucle pour lire les Colonnes qui suivent :
      DO 11 ICOL = 1, NCOLOL
        IDCOL = LEN(COLO8) + 1 + (ICOL - 1) * LCOL
        IFCOL = IDCOL + LCOL
C        IF (DEBCB) THEN
C          WRITE(IOIMP,*) 'IDCOL : ',IDCOL
C          WRITE(IOIMP,*) 'IFCOL : ',IFCOL
C          WRITE(IOIMP,*) 'LCOL  : ',LCOL
C        ENDIF
 
        TEXT = LIGNE(IDCOL:IFCOL)
        IF (PRECID) THEN
          COLO16 = LIGNE(IDCOL:IFCOL)
        ELSE
          COLO8 = LIGNE(IDCOL:IFCOL)
        ENDIF
 
        ICOUR = LCOL
        IFINAN= ICOUR+1
 
C       Correction à la volée d'une caractéristique du format .fem le 'E' n'est pas toujours mis pour les puissances négatives
        IF ((IRETO1.EQ.1).AND.(IVALU.GE.1)) THEN
C         Cas de la lecture des coordonnées d'un noeud simple precision
          IF(COLO8(1:1).EQ.'-')THEN
            IADD = 1
          ELSE
            IADD = 0
          ENDIF
 
          DO 15 ICHAR1 = 1+IADD, LCOL
            IF((COLO8(ICHAR1:ICHAR1).EQ.'-').AND.
     &         (COLO8(ICHAR1-1:ICHAR1-1).NE.'e').AND.
     &         (COLO8(ICHAR1-1:ICHAR1-1).NE.'E').AND.
     &         (COLO8(ICHAR1-1:ICHAR1-1).NE.'d').AND.
     &         (COLO8(ICHAR1-1:ICHAR1-1).NE.'D').AND.
     &         (COLO8(ICHAR1-1:ICHAR1-1).NE.' '))THEN
              COLO9 =COLO8(1:ICHAR1-1)//'E-'//COLO8(ICHAR1+1:LCOL)
              TEXT  = COLO9
              ICOUR =LEN(COLO9)
              IFINAN=ICOUR+1
C              WRITE(IOIMP,*) 'Nouvelle COLO9 : ',COLO9
              GOTO 15
            ENDIF
 15       CONTINUE
        ELSEIF ((IRETO1.EQ.2).AND.(IVALU.GE.1)) THEN
C         Cas de la lecture des coordonnées d'un noeud double precision
          IF(COLO16(1:1).EQ.'-')THEN
            IADD = 1
          ELSE
            IADD = 0
          ENDIF
 
          DO 16 ICHAR1 = 1+IADD, LCOL
            IF((COLO16(ICHAR1:ICHAR1).EQ.'-').AND.
     &         (COLO16(ICHAR1-1:ICHAR1-1).NE.'e').AND.
     &         (COLO16(ICHAR1-1:ICHAR1-1).NE.'E').AND.
     &         (COLO16(ICHAR1-1:ICHAR1-1).NE.'d').AND.
     &         (COLO16(ICHAR1-1:ICHAR1-1).NE.'D').AND.
     &         (COLO16(ICHAR1-1:ICHAR1-1).NE.' '))THEN
              COLO17 =COLO16(1:ICHAR1-1)//'E-'//
     &                COLO16(ICHAR1+1:LCOL)
              TEXT  = COLO17
              ICOUR = LEN(COLO17)
              IFINAN=ICOUR+1
C              WRITE(IOIMP,*) 'Nouvelle COLO17 : ',COLO17
              goto 16
            ENDIF
 16       CONTINUE
        ENDIF
 
        NRAN  = 0
        CALL REDLEC(sredle)
 
C       Poursuite dans le cas ou quelque chose a été lue
        IF (IRE.NE.0) THEN
          IVALU  = IVALU + 1
 
C          IF (DEBCB) THEN
C           WRITE(IOIMP,*) 'TEXT          :',TEXT(1:ICOUR)
C           WRITE(IOIMP,*) 'IVALU         :',IVALU
C            IF (IRE.EQ.1) THEN
C              WRITE(IOIMP,*) 'Entier Lu   :',NFIX
C            ENDIF
C           IF (IRE.EQ.2) THEN
C             WRITE(IOIMP,*) 'Flottant Lu :',FLOT
C           ENDIF
C          ENDIF
 
 
C***********************************************************************
C           Traitement des des coordonnées des Noeuds
C***********************************************************************
          IF ((IRETO1.EQ.1).OR.(IRETO1.EQ.2)) THEN
C           Ajustement du segment MCOORD
            IF (NBNPTS.GT.JGNOLO) THEN
              INCJGN = INT(REAL(INCJGN) * XNCJG)
              JGNOLO    = JGNOLO + INCJGN
              NBPTS = JGNOLO + NBANC
              SEGADJ,MLINOE
              SEGADJ,MCOORD
C              IF (DEBCB) THEN
C                WRITE(IOIMP,*) 'Segment MCOORD Ajuste'
C                WRITE(IOIMP,*) 'INCJGN : ',INCJGN
C                WRITE(IOIMP,*) '   JGNOLO  : ',JGNOLO
C                WRITE(IOIMP,*) 'NBPTS  : ',NBPTS
C              ENDIF
            ENDIF
 
            j=(NBANC+NBNPTS-1)*idimp1
 
C           Lecture du numéro du noeud (TYPE ENTIER)
            IF (IVALU.EQ.1) THEN
C             Prévoir erreur si pas entier lu
              INOC3M(NBNPTS)=NBANC+NBNPTS
              INOEHM(NBNPTS)=NFIX
 
C             Ajustement du segment MLINOE pour le tableau ICORNO(JGNOLU)
              IF(NFIX.GT.JGNOLU) THEN
                INCJGN = INT(REAL(INCJGN) * XNCJG)
                JGNOLU = NFIX + INCJGN
                SEGADJ,MLINOE
              ENDIF
              ICORNO(NFIX)=NBNPTS
 
C           Lecture des 3 Coordonnées qui suivent le numéro du noeud (TYPE FLOT)
            ELSEIF((IVALU.GT.1).AND.(IVALU.LE.4)) THEN
              IF (IRE.EQ.1) THEN
                XCOOR(j+(IVALU-1))=NFIX
C               IF (DEBCB) THEN
C                 WRITE(IOIMP,*) 'Entier   Lu :',NFIX
C                 WRITE(IOIMP,*) 'ICOL-3  :',ICOL-3
C                 WRITE(IOIMP,*) 'IVALU-1 :',IVALU-1
C               ENDIF
              ELSEIF (IRE.EQ.2) THEN
                XCOOR(j+(IVALU-1))=FLOT
C                IF (DEBCB) THEN
C                 WRITE(IOIMP,*) ' Flottant Lu :',FLOT
C                 WRITE(IOIMP,*) 'ICOL-3  :',ICOL-3
C                 WRITE(IOIMP,*) 'IVALU-1 :',IVALU-1
C                ENDIF
              ENDIF
            ELSEIF (IVALU.GT.4) THEN
              WRITE(IOIMP,*) 'ERREUR, IVALU > 4 pour des Coordonnées'
            ENDIF
C           La densité n'a pas d'équivalent dans Hyper Mesh, elle est à 0.D0 par défaut
C            XCOOR(j+idimp1)=REAL(0.D0)
 
 
C***********************************************************************
C           Traitement des ELEMENTS et de leur CONNECTIVITE
C***********************************************************************
          ELSEIF (IRETO1.GE.2) THEN
C           Ajustement du segment MLIELE
            IF(NELTOT.GT.JGELLO) THEN
              INCJGE = INT(REAL(INCJGE) * XNCJG)
              JGELLO = NELTOT + INCJGE
              SEGADJ,MLIELE
            ENDIF
 
            IF (IVALU.EQ.1) THEN
C             Lecture de l'ID de l'élément
              IDLU = NFIX
 
C             Enregistrement de la correspondance
              ICOREL(NELTOT)=IDLU
 
C             Ajustement du segment MLIELE
              IF (IDLU.GT.JGELLU) THEN
                INCJGE = INT(REAL(INCJGE) * XNCJG)
                JGELLU = IDLU + INCJGE
                SEGADJ,MLIELE
              ENDIF
 
              IELTYP(IDLU) = IRETO1
 
C              IF(DEBCB) THEN
C                WRITE(IOIMP,*) 'IDLU',IELTYP(IDLU),'IRETO1',IRETO1
C              ENDIF
 
            ELSEIF (IRE.EQ.1) THEN
              IF (IRETO1.EQ.3) THEN
C               Cas particulier des RBE2
                IF (IVALU.EQ.3) THEN
C                 Pour l'instant cette données n'est pas utilisée (C'est déjà de la mise en donnée Elément Finis)
C                 Je ne m'occupe pour l'instant que des supports géométriques des éléments
C                  IF (DEBCB) THEN
C                    WRITE(IOIMP,*) 'Degres bloques RBE2',COLO8
C                  ENDIF
                ELSE
                  NBCONN = NBCONN + 1
                  IF (IVALU.EQ.2) THEN
C                   Enregistrer ou débute la lecture de la connectivité
                    IELCON(IDLU)=NBCONN
                  ENDIF
C                 Ajustement du segment MLIELE
                  IF (NBCONN.GT.JELCON) THEN
                    INCJCO = INT(REAL(INCJCO) * XNCJG)
                    JELCON = NBCONN + INCJCO
                    SEGADJ,MLIELE
                  ENDIF
 
C                 Enregistrer la connectivité de l'élément
                  ICONTO(NBCONN)=NFIX
                  IELNBN(IDLU)=IELNBN(IDLU)+1
C                  IF (DEBCB) THEN
C                    WRITE(IOIMP,*) 'IVALU:',IVALU
C                    WRITE(IOIMP,*) 'REB2 Connectivite :',NFIX
C                  ENDIF
                ENDIF
 
              ELSEIF (IRETO1.EQ.4) THEN
C               Cas particulier des RBE3
                IF ((IVALU.EQ.3).OR.(IVALU.EQ.4).OR.(IVALU.EQ.5)) THEN
C                 Pour l'instant ces données ne sont pas utilisées (C'est déjà de la mise en donnée Elément Finis)
C                 Je ne m'occupe pour l'instant que des supports géométriques des éléments
C                  IF (DEBCB) THEN
C                    WRITE(IOIMP,*) 'Degres bloques RBE2',COLO8
C                  ENDIF
                ELSE
                  NBCONN = NBCONN + 1
                  IF (IVALU.EQ.2) THEN
C                   Enregistrer ou débute la lecture de la connectivité
                    IELCON(IDLU)=NBCONN
                  ENDIF
C                 Ajustement du segment MLIELE
                  IF (NBCONN.GT.JELCON) THEN
                    INCJCO = INT(REAL(INCJCO) * XNCJG)
                    JELCON = NBCONN + INCJCO
                    SEGADJ,MLIELE
                  ENDIF
 
C                 Enregistrer la connectivité de l'élément
                  ICONTO(NBCONN)=NFIX
                  IELNBN(IDLU)=IELNBN(IDLU)+1
C                  IF (DEBCB) THEN
C                    WRITE(IOIMP,*) 'IVALU:',IVALU
C                    WRITE(IOIMP,*) 'REB3 Connectivite :',NFIX
C                  ENDIF
                ENDIF
              ELSE
C               Cas de tous les autres éléments
                IF (IVALU.EQ.2) THEN
C                 Lecture de la Property à laquelle appartient l'élément
                  IELPRO(IDLU)=NFIX
 
                ELSE
                  NBCONN = NBCONN + 1
                  IF (IVALU.EQ.3) THEN
C                   Enregistrer ou débute la lecture de la connectivité
                    IELCON(IDLU)=NBCONN
                  ENDIF
 
C                 Ajustement du segment MLIELE
                  IF (NBCONN.GT.JELCON) THEN
                    INCJCO = INT(REAL(INCJCO) * XNCJG)
                    JELCON = NBCONN + INCJCO
                    SEGADJ,MLIELE
                  ENDIF
 
C                 Enregistrer la connectivité de l'élément
                  ICONTO(NBCONN)=NFIX
                  IELNBN(IDLU)=IELNBN(IDLU)+1
C                  IF (DEBCB) THEN
C                    WRITE(IOIMP,*) 'IVALU:',IVALU
C                    WRITE(IOIMP,*) 'Entier Lu :',NFIX
C                    WRITE(IOIMP,*) 'IELNBN(IDLU):',IELNBN(IDLU),
C     &                             'IDLU:',IDLU
C                  ENDIF
 
C                 Détection d'éléments d'ordre 2 par le nombre de noeuds dans la connectivité
C                 Pour [IRETO1 >= 9] Exception car les éléments ont des noms identiques pour HM...
                  IF ((IRETO1.GE.9).AND.
     &                (IELNBN(IDLU).EQ.GECONN(IRETO1+1))) THEN
                    IELTYP(IDLU) = IRETO1+1
C                    IF (DEBCB) THEN
C                      WRITE(IOIMP,*) 'IDLU:',IDLU,
C     &                        'Ordre 2 IELTYP(IDLU):',IELTYP(IDLU)
C                    ENDIF
                    NOBJ(1+IRETO1)   = NOBJ(1+IRETO1)-1
                    NOBJ(1+IRETO1+1) = NOBJ(1+IRETO1+1)+1
                  ENDIF
                ENDIF
              ENDIF
            ENDIF
 
C***********************************************************************
C           Répartition des éléments dans les Components adéquats
C***********************************************************************
          ELSEIF (IRETO2.EQ.1) THEN
            IF (IVALU.EQ.1) THEN
              IDCOMP = NFIX
C             Ajustement du segment MCOMP
              IF (IDCOMP.GT.JGCOLU) THEN
                INCCOM = INT(REAL(INCCOM) * XNCJG)
                JGCOLU = IDCOMP + INCCOM
                SEGADJ,MCOMP
C                IF (DEBCB) THEN
C                  WRITE(IOIMP,*) 'Ajustement du segment MCOMP 1'
C                  WRITE(IOIMP,*) 'JGCOLU',JGCOLU
C                ENDIF
              ENDIF
C             IF (DEBCB) THEN
C               WRITE(IOIMP,*) 'IDCOMP',IDCOMP
C             ENDIF
            ELSE
              IF (COLO8.EQ.'THRU    ') THEN
                IDLU0 = IDELEM
C                IF (DEBCB) THEN
C                  WRITE(IOIMP,*) 'MOTLU:',COLO8,':'
C                  WRITE(IOIMP,*) 'IDLU0: ',IDLU0
C                ENDIF
              ELSE
                IF (IRE.EQ.1) THEN
                  IF (IDLU0.NE.0) THEN
                    IDLU1 = NFIX
C                    IF (DEBCB) THEN
C                      WRITE(IOIMP,*) 'IDLU1: ',IDLU1
C                    ENDIF
 
C                   BOUCLE entre (IDLU0+1) et IDLU1 (IDLU0 a déjà été traité au premier passage )
C                     Enregistrement de l'ID du component auquel appartient l'element
C                                     du type de l'élément lu
C                                     du nombre de type d'éléments dans le component et quels types sont présents
C                                     du nombre d'élément de chaque type dans le component
                    DO IDELEM=(IDLU0+1),IDLU1
                      IELCOM(IDELEM) = IDCOMP
                      IDTYPE = IELTYP(IDELEM)
                      IF (NBELCO(IDCOMP,IDTYPE).EQ.0) THEN
                        NBTYPE(IDCOMP,IDTYPE) = 1
                        NBTYPE(IDCOMP,NBGEOM+1) =
     &                         NBTYPE(IDCOMP,NBGEOM+1) + 1
                      ENDIF
                      NBELCO(IDCOMP,IDTYPE) = NBELCO(IDCOMP,IDTYPE)+1
 
C                      IF (DEBCB) THEN
C                        WRITE(IOIMP,*) 'IDELEM THRU',IDELEM,
C     &                                 'IDCOMP',IDCOMP,
C     &                                 'IDTYPE',IDTYPE,
C     &                                 'NBNO  ',GECONN(IDTYPE)
C                      ENDIF
                    ENDDO
 
C                   Remise à zéro de IDLU0
                    IDLU0 = 0
 
                  ELSE
C                   Enregistrement de l'ID du component auquel appartient l'element
C                                du type de l'élément lu
C                                du nombre de type d'éléments dans le component et quels types sont présents
C                                du nombre d'élément de chaque type dans le component
                    IDELEM = NFIX
                    IELCOM(IDELEM) = IDCOMP
                    IDTYPE = IELTYP(IDELEM)
                    IF (NBELCO(IDCOMP,IDTYPE).EQ.0) THEN
                      NBTYPE(IDCOMP,IDTYPE) = 1
                      NBTYPE(IDCOMP,NBGEOM+1) =
     &                       NBTYPE(IDCOMP,NBGEOM+1) + 1
                    ENDIF
                    NBELCO(IDCOMP,IDTYPE) = NBELCO(IDCOMP,IDTYPE) + 1
 
C                    IF (DEBCB) THEN
C                      WRITE(IOIMP,*) 'IDELEM THRU',IDELEM,
C     &                               'IDCOMP',IDCOMP,
C     &                               'IDTYPE',IDTYPE,
C     &                               'NBNO  ',GECONN(IDTYPE)
C                    ENDIF
                  ENDIF
                ENDIF
              ENDIF
            ENDIF
 
C***********************************************************************
C           Traitement des noms de COMPONENT ET LOADCOL
C***********************************************************************
          ELSEIF (IRETO2.EQ.2) THEN
            IF (IVALU.EQ.1) THEN
C             Lecture du deuxième mot clé
              MOTCL8 = COLO8
 
              IF (MOTCL8.EQ.'COMP    ') THEN
C               Incrémentation du nombre de COMPONENT
                NBCOMP = NBCOMP + 1
C               Ajustement du segment MCOMP
                IF (NBCOMP.GT.JGCOLO) THEN
                  INCCOM = INT(REAL(INCCOM) * XNCJG)
                  JGCOLO = NBCOMP + INCCOM
                  SEGADJ,MCOMP
                ENDIF
 
              ELSEIF (MOTCL8.EQ.'LOADCOL ') THEN
C               Incrémentation du nombre de LOADCOL
                NBLOCO = NBLOCO + 1
C               Ajustement du segment MCOMP
                IF (NBLOCO.GT.JGLCLO) THEN
                  INCLOC = INT(REAL(INCLOC) * XNCJG)
                  JGLCLO = NBLOCO + INCLOC
                  SEGADJ,MLOCOL
                ENDIF
 
              ELSE
                WRITE(IOIMP,*) '       Carte non lue : ',MOTCL8
              ENDIF
 
C           Lecture de d'ID
            ELSEIF (IVALU.EQ.2) THEN
              IDLU = NFIX
 
              IF (MOTCL8.EQ.'COMP    ') THEN
C               Ajustement du segment MCOMP
                IF (IDLU.GT.JGCOLU) THEN
                  INCCOM = INT(REAL(INCCOM) * XNCJG)
                  JGCOLU = IDLU + INCCOM
                  SEGADJ,MCOMP
C                   IF (DEBCB) THEN
C                     WRITE(IOIMP,*) 'Ajustement du segment MCOMP 2'
C                     WRITE(IOIMP,*) 'JGCOLU',JGCOLU
C                   ENDIF
                ENDIF
                ICOCOR(NBCOMP)=IDLU
C                IF (DEBCB) THEN
C                  WRITE(IOIMP,*) 'ID lu noms :',IDLU,'LIGNE : ',NBLIGN
C                ENDIF
 
              ELSEIF (MOTCL8.EQ.'LOADCOL ') THEN
C               Ajustement du segment MLOCOL
                IF (IDLU.GT.JGLCLU) THEN
                  INCLOC = INT(REAL(INCLOC) * XNCJG)
                  JGLCLU = IDLU + INCLOC
                  SEGADJ,MLOCOL
C                   IF (DEBCB) THEN
C                     WRITE(IOIMP,*) 'Ajustement du segment MLOCOL 2'
C                     WRITE(IOIMP,*) 'JGLCLU',JGLCLU
C                   ENDIF
                ENDIF
                ILCCOR(NBLOCO)=IDLU
C                 IF (DEBCB) THEN
C                   WRITE(IOIMP,*) 'ID lu noms :',IDLU,'LIGNE : ',NBLIGN
C                 ENDIF
 
              ENDIF
 
C           Lecture du MOT représentant le nom du COMPONENT
            ELSEIF (IVALU.EQ.3) THEN
              COLO80 = LIGNE(IDCOL+1:80)
 
C             Retrait de la double côte représentant la fin du nom lu
              DO INDICE=2,LEN(COLO80)
                IF ((COLO80(INDICE:INDICE)).EQ.'"') THEN
                  COLO80 = COLO80(1:INDICE-1)
                  GOTO 320
                ENDIF
              ENDDO
 
 320          CONTINUE
              IF (MOTCL8.EQ.'COMP    ') THEN
                NAMECO(IDLU) = COLO80
C                 IF (DEBCB) THEN
C                   WRITE(IOIMP,*) 'NAMECO(IDLU):',NAMECO(IDLU)
C      &                          ,':','LIGNE : ',NBLIGN
C                 ENDIF
 
              ELSEIF (MOTCL8.EQ.'LOADCOL ') THEN
                NOMLOC(IDLU) = COLO80
C                 IF (DEBCB) THEN
C                   WRITE(IOIMP,*) 'NOMLOC(IDLU):',NOMLOC(IDLU)
C      &                          ,':','LIGNE : ',NBLIGN
C                 ENDIF
 
              ENDIF
            ENDIF
 
C***********************************************************************
C           Traitement des couleurs
C***********************************************************************
          ELSEIF (IRETO2.EQ.3) THEN
            IF (IVALU.EQ.1) THEN
C             Lecture du deuxième mot clé
              MOTCL8 = COLO8
 
C           Lecture de d'ID
            ELSEIF (IVALU.EQ.2) THEN
              IDLU = NFIX
C              IF (DEBCB) THEN
C                WRITE(IOIMP,*) 'ID lu couleurs :',IDLU
C              ENDIF
 
C           Lecture de l'entier représentant la couleur
            ELSEIF (IVALU.EQ.3) THEN
              IF (MOTCL8.EQ.' COMP   ') THEN
C               Cas du sous mot clé ' COMP   '
                ICOULC(IDLU) = NFIX
C                IF (DEBCB) THEN
C                  WRITE(IOIMP,*) 'Couleur lue :',NFIX
C                ENDIF
              ENDIF
            ENDIF
 
 
C***********************************************************************
C           Traitement des SETS lus dans le fichier .fem
C***********************************************************************
          ELSEIF (IRETO2.EQ.4) THEN
C           Lecture de d'ID du SET
            IF (IVALU.EQ.1) THEN
C             Incrémentation du nombre de sets
              NBSETS = NBSETS + 1
 
C             Ajustement du segment MSET
              IF (NBSETS.GT.JGSELO) THEN
                INCSET = INT(REAL(INCSET) * XNCJG)
                JGSELO = NBSETS + INCSET
                SEGADJ,MSET
C                IF (DEBCB) THEN
C                  WRITE(IOIMP,*) 'Ajustement du segment MSET 1',JGSELU
C                ENDIF
              ENDIF
 
              IDLU = NFIX
 
              ISECOR(NBSETS)=IDLU
C              IF (DEBCB) THEN
C                WRITE(IOIMP,*)'ID du set Lu : ',IDLU
C              ENDIF
 
C             Ajustement du segment MSET
              IF (IDLU.GT.JGSELU) THEN
                INCSET = INT(REAL(INCSET) * XNCJG)
                JGSELU = IDLU + INCSET
                SEGADJ,MSET
C                IF (DEBCB) THEN
C                  WRITE(IOIMP,*) 'Ajustement du segment MSET 1',JGSELU
C                ENDIF
              ENDIF
            ELSEIF (IVALU.EQ.2) THEN
C             Type de set lu On s'en sert pour créer des maillages SIMPLES ou COMPLEXES
C             1 ==> Noeuds
C             2 ==> Elements
C              IF (DEBCB) THEN
C                WRITE(IOIMP,*)'Type de SET Lu : ',NFIX
C              ENDIF
              ITYSET(IDLU)=NFIX
 
C           Lecture du MOT représentant le nom du SET
            ELSEIF (IVALU.EQ.3) THEN
              COLO80 = LIGNE(IDCOL+2:80)
 
C             Retrait de la double côte représentant la fin du nom lu
              DO 330 INDICE=2,LEN(COLO80)
                IF ((COLO80(INDICE:INDICE)).EQ.'"') THEN
                  COLO80 = COLO80(1:INDICE-1)
                ENDIF
 330          CONTINUE
 
              NOMSET(IDLU)=COLO80
C              IF (DEBCB) THEN
C                WRITE(IOIMP,*) 'Nom du SET = ',NOMSET(IDLU)
C              ENDIF
 
 
C*******************************************
C  LECTURE du format d'écriture des SETS
C*******************************************
              NENTIT = 0
 
C             Lecture de la première ligne après la détection d'un SET
              READ(IUFEM,1000,ERR=989,END=100) COLO80
              NBLIGN = NBLIGN + 1
 
              DO INDICE=1,LEN(COLO80)
                IF ((COLO80(INDICE:INDICE)).EQ.'=') THEN
C                 Format à vigule rencontré pour cette ligne
                  COLO80=COLO80(INDICE+2:(LEN(COLO80)))
                  IDINI=1
                  IDFIN=1
C                   IF (DEBCB) THEN
C                     WRITE(IOIMP,*)'Format a VIRGULE'
C                     WRITE(IOIMP,*)'Ligne a analyser :',COLO80
C                   ENDIF
                  GOTO 331
                ENDIF
              ENDDO
 
C             Format Standard attendu lecture de la ligne suivante
C               IF (DEBCB) THEN
C                 WRITE(IOIMP,*)'Format STANDARD'
C               ENDIF
              GOTO 334
 
C*******************************************
C  LECTURE du format avec le séparateur ','
C*******************************************
 331          CONTINUE
              DO INDICE=IDINI,(LEN(COLO80)-1)
C                 IF (DEBCB) THEN
C                   WRITE(IOIMP,*)'Lettre:',COLO80(INDICE:INDICE),':'
C                 ENDIF
                IF ((COLO80(INDICE:INDICE)).EQ.',') THEN
                  IDFIN=INDICE-1
                  NENTIT = NENTIT + 1
                  IF(IDFIN - IDINI + 1 .GT. 10)THEN
C                   Format '(I10)' a reviser
                    CALL ERREUR(1094)
                    RETURN
                  ENDIF
 
                  TEXT=COLO80(IDINI:IDFIN)
                  NRAN=0
                  ICOUR=IDFIN
                  CALL REDLEC(sredle)
                  IENTLU = NFIX
 
C                  READ (COLO80(IDINI:IDFIN),FMT='(I10)') IENTLU
C                   IF (DEBCB) THEN
C                     WRITE(IOIMP,*)'NOMBRE =',IENTLU
C                   ENDIF
 
C                 Ajustement du segment MSET
                  IF (IENTLU.GT.JGELLU) THEN
                    INCJGE = INT(REAL(INCJGE) * XNCJG)
                    JGELLU = IENTLU + INCJGE
                    SEGADJ,MSET
                  ENDIF
                  IF (NENTIT.GT.JGNBEL) THEN
                    INCJGE = INT(REAL(INCJGE) * XNCJG)
                    JGNBEL = NENTIT + INCJGE
                    SEGADJ,MSET
                  ENDIF
 
C                 Sauvegarde de l'entité lue
                  ILISTE(NENTIT,IDLU)=IENTLU
 
                  IDINI=INDICE+1
                  IF ((COLO80(INDICE+1:INDICE+1)).EQ.' ') THEN
C                   Lecture de la ligne suivante
                    GOTO 332
                  ENDIF
 
                ELSEIF ((COLO80(INDICE:INDICE)).EQ.' ') THEN
                  NENTIT = NENTIT + 1
                  IDFIN=INDICE-1
                  IF(IDFIN - IDINI + 1 .GT. 10)THEN
C                   Format '(I10)' a reviser
                    CALL ERREUR(1094)
                    RETURN
                  ENDIF
 
                  TEXT=COLO80(IDINI:IDFIN)
                  NRAN=0
                  ICOUR=IDFIN
                  CALL REDLEC(sredle)
                  IENTLU = NFIX
 
C                  READ (COLO80(IDINI:IDFIN),FMT='(I10)') IENTLU
C                   IF (DEBCB) THEN
C                     WRITE(IOIMP,*)'NOMBRE =',IENTLU
C                   ENDIF
 
C                 Ajustement du segment MSET
                  IF (IENTLU.GT.JGELLU) THEN
                    INCJGE = INT(REAL(INCJGE) * XNCJG)
                    JGELLU = IENTLU + INCJGE
                    SEGADJ,MSET
                  ENDIF
                  IF (NENTIT.GT.JGNBEL) THEN
                    INCJGE = INT(REAL(INCJGE) * XNCJG)
                    JGNBEL = NENTIT + INCJGE
                    SEGADJ,MSET
                  ENDIF
 
C                 Sauvegarde de l'entité lue et du nombre d'entité lues
                  NBENTI(NBSETS)=NENTIT
                  ILISTE(NENTIT,IDLU)=IENTLU
C                 Fin de lecture du SET, retour en 10
                  GOTO 10
                ENDIF
              ENDDO
 
 332          CONTINUE
C             Lecture des lignes incrémentale
              READ(IUFEM,1000,ERR=989,END=100) COLO80
              NBLIGN = NBLIGN + 1
 
              DO INDICE=6,LEN(COLO80)
                IF ((COLO80(INDICE:INDICE)).NE.' ') THEN
                 COLO80=COLO80(INDICE:(LEN(COLO80)))
                  IDINI=1
                  IDFIN=1
C                   IF (DEBCB) THEN
C                     WRITE(IOIMP,*)'Ligne a analyser :',COLO80
C                   ENDIF
                GOTO 331
                ENDIF
              ENDDO
 
C**********************************************************************************
C  LECTURE des lignes formatées avec les balises THRU et les EXCEPT et les ENDTHRU
C**********************************************************************************
 333          CONTINUE
C              IF (DEBCB) THEN
C                WRITE(IOIMP,*)'MOT LU :',COLO80(IDINI:IDINI+7),':'
C              ENDIF
              IF ((COLO80(IDINI:IDINI+7)).EQ.'        ') THEN
C               Lecture de la ligne suivante
                GOTO 334
 
              ELSEIF ((COLO80(IDINI:IDINI+7)).EQ.'  THRU  ') THEN
                IDINI=IDINI+8
C                IF (DEBCB) THEN
C                  WRITE(IOIMP,*)'MOT LU :',COLO80(IDINI:IDINI+7),':'
C                ENDIF
 
                TEXT=COLO80(IDINI:IDINI+7)
                NRAN=0
                ICOUR=IDINI+7
                CALL REDLEC(sredle)
                IENTFI = NFIX
 
C                READ (COLO80(IDINI:IDINI+7),FMT='(I8)') IENTFI
                IDINI=IDINI+8
C                 IF (DEBCB) THEN
C                   WRITE(IOIMP,*)'INITIAL =',IENTLU,'FINAL =',IENTFI
C                 ENDIF
 
C               Ajustement du segment MSET
                IF (IENTFI.GT.JGELLU) THEN
                  INCJGE = INT(REAL(INCJGE) * XNCJG)
                  JGELLU = IENTFI + INCJGE
                  SEGADJ,MSET
                ENDIF
 
                DO JNDICE=(IENTLU+1),IENTFI
C                 Sauvegarde de l'entité lue
                  NENTIT = NENTIT + 1
 
C                 Ajustement du segment MSET
                  IF (NENTIT.GT.JGNBEL) THEN
                    INCJGE = INT(REAL(INCJGE) * XNCJG)
                    JGNBEL = NENTIT + INCJGE
                    SEGADJ,MSET
                  ENDIF
 
                  ILISTE(NENTIT,ISECOR(NBSETS))=JNDICE
                ENDDO
 
C               Lecture de l'entité suivante
                GOTO 333
 
              ELSE
                NENTIT = NENTIT + 1
 
                TEXT=COLO80(IDINI:IDINI+7)
                NRAN=0
                ICOUR=IDINI+7
                CALL REDLEC(sredle)
                IENTLU = NFIX
 
C                READ (COLO80(IDINI:IDINI+7),FMT='(I8)') IENTLU
                IDINI=IDINI+8
C                 IF (DEBCB) THEN
C                   WRITE(IOIMP,*)'NOMBRE =',IENTLU
C                 ENDIF
 
C               Ajustement du segment MSET
                IF (IENTLU.GT.JGELLU) THEN
                  INCJGE = INT(REAL(INCJGE) * XNCJG)
                  JGELLU = IENTLU + INCJGE
                  SEGADJ,MSET
                ENDIF
                IF (NENTIT.GT.JGNBEL) THEN
                  INCJGE = INT(REAL(INCJGE) * XNCJG)
                  JGNBEL = NENTIT + INCJGE
                  SEGADJ,MSET
                ENDIF
 
C               Sauvegarde de l'entité lue et du nombre d'entité lues
                NBENTI(NBSETS)=NENTIT
                ILISTE(NENTIT,ISECOR(NBSETS))=IENTLU
 
C               Lecture de l'entité suivante
                GOTO 333
 
              ENDIF
 
 334          CONTINUE
C             Lecture des lignes incrémentale
              READ(IUFEM,1000,ERR=989,END=100) COLO80
              NBLIGN = NBLIGN + 1
 
              DO INDICE=1,LEN(COLO80)
                IF ((COLO80(1:1)).NE.'+') THEN
C                 Fin de lecture du SET, retour en 10
                  NBENTI(NBSETS)=NENTIT
C                  IF (DEBCB) THEN
C                    WRITE(IOIMP,*)'Fin Set, NENTIT = :',NENTIT,':'
C                  ENDIF
                  GOTO 10
                ELSE
                  COLO80=COLO80(9:(LEN(COLO80)))
                  IDINI=1
C                  IF (DEBCB) THEN
C                    WRITE(IOIMP,*)'Ligne a analyser :',COLO80,':'
C                  ENDIF
                  GOTO 333
                ENDIF
              ENDDO
 
            ENDIF
 
 
C***********************************************************************
C           Traitement des LOAD COLLECTORS lus dans le fichier .fem
C***********************************************************************
          ELSEIF (IRETO2.EQ.5) THEN
C         Cas des SPC
            IF (BSPC .EQV. .FALSE.) THEN
              BSPC = .TRUE.
              WRITE(IOIMP,*)'       Carte non lue : ',NGTYPE(IRETO2)
            ENDIF
 
            IF (IVALU.EQ.1) THEN
C             Récupération de l'ID du LOADCOL
              IDLU = NFIX
              NBENLC(IDLU)=NBENLC(IDLU)+1
              ITYLOC(IDLU)=1
 
              NBRENT = NBENLC(IDLU)
              NUMLOC = IDLU
 
            ELSEIF (IVALU.EQ.2) THEN
C             Lecture de l'ID de l'entité LU
              IDLU = NFIX
C               IF (DEBCB) THEN
C                 WRITE(IOIMP,*) 'LOADCOL n:',NUMLOC,'NBR',NBRENT,
C      &                         'Entite',IDLU
C               ENDIF
 
C             Ajustement du segment MLOCOL
              IF (IDLU.GT.JGNBEN) THEN
                JGNBEN = IDLU + MAX(INCJGN,INCJGE)
                SEGADJ,MLOCOL
C                     IF (DEBCB) THEN
C                       WRITE(IOIMP,*) 'Ajustement du segment MLOCOL 3'
C                       WRITE(IOIMP,*) 'JGNBEN',JGNBEN
C                     ENDIF
              ENDIF
 
C             Sauvgarde de l'entité lue
              ILOCNO(NBRENT,NUMLOC)=IDLU
 
            ELSEIF (IVALU.EQ.3) THEN
C           Lecture des degrés de liberté bloqués
 
            ENDIF
 
          ELSEIF (IRETO2.EQ.6) THEN
C         Cas des TEMPERATURES
            IF (BTEMP .EQV. .FALSE.) THEN
              BTEMP = .TRUE.
              WRITE(IOIMP,*)'       Carte non lue : ',NGTYPE(IRETO2)
            ENDIF
 
C           Lecture de d'ID du LOAD COLLECTOR
 
          ELSEIF (IRETO2.EQ.7) THEN
C         Cas des FORCES
            IF (BFORC .EQV. .FALSE.) THEN
              BFORC = .TRUE.
              WRITE(IOIMP,*)'       Carte non lue : ',NGTYPE(IRETO2)
            ENDIF
 
C           Lecture de d'ID du LOAD COLLECTOR
 
          ELSEIF (IRETO2.EQ.8) THEN
C         Cas des MOMENTS
            IF (BMOM .EQV. .FALSE.) THEN
              BMOM = .TRUE.
              WRITE(IOIMP,*)'       Carte non lue : ',NGTYPE(IRETO2)
            ENDIF
 
C           Lecture de d'ID du LOAD COLLECTOR
 
          ELSEIF (IRETO2.EQ.9) THEN
C         Cas des PRESSIONS (Normales ou directionnelles)
            IF (BPRES .EQV. .FALSE.) THEN
              BPRES = .TRUE.
              WRITE(IOIMP,*)'       Carte non lue : ',NGTYPE(IRETO2)
            ENDIF
 
C           Lecture de d'ID du LOAD COLLECTOR
 
          ENDIF
        ENDIF
 11   CONTINUE
 
C      IF (DEBCB) THEN
C        WRITE(IOIMP,*) 'IVALU :',IVALU
C      ENDIF
 
      GOTO 10
 
 100  CONTINUE
 
C     Ajustement des segments à la fin
      IF (NBNPTS .LT. JGNOLO) THEN
        JGNOLO=NBNPTS
        NBPTS=NBANC+JGNOLO
        SEGADJ,MLINOE
        SEGADJ,MCOORD
      ENDIF
 
      IF (NELTOT .LT. JGELLO) THEN
        JGELLO = NELTOT
        JELCON = NBCONN
        SEGADJ,MLIELE
      ENDIF
 
      IF (NBCOMP .LT. JGCOLO) THEN
        JGCOLO = NBCOMP
        SEGADJ,MCOMP
      ENDIF
 
      IF (NBSETS .LT. JGSELO) THEN
        JGSELO = NBSETS
        SEGADJ,MSET
      ENDIF
 
      IF (NBLOCO .LT. JGLCLO) THEN
        JGLCLO = NBLOCO
        SEGADJ,MLOCOL
      ENDIF
 
 
CC       Affichage des nombre d'objets lus selon leur Type :
C        DO 111 INDICE = 1, LONOBJ
C          IF(INDICE.EQ.1) THEN
C            WRITE(IOIMP,*)   'Objets Geom        :',
C     &                        NOBJ(INDICE)
C          ELSEIF (INDICE.LT.LONOBJ) THEN
C            WRITE(IOIMP,*)   'Nombre de ',GETYPE(INDICE-1),' :',
C     &                       NOBJ(INDICE)
C          ELSE
C            WRITE(IOIMP,*)   'Elements total     :',
C     &                        NOBJ(INDICE)
C          ENDIF
C 111    CONTINUE
C      ENDIF
 
 
 
C***********************************************************************
C     Création du tableau des pointeurs qui vont accueillir les MELEME
C     De chaque COMPONENT pour chaque TYPE d'élément lu
C***********************************************************************
C      IF (DEBCB) THEN
C        WRITE(IOIMP,*) 'NBCOMP',NBCOMP
C      ENDIF
      DO 210 INDICE = 1, NBCOMP
        IDCOMP = ICOCOR(INDICE)
        NBSOUS = NBTYPE(IDCOMP,NBGEOM+1)
C        IF (DEBCB) THEN
C          WRITE(IOIMP,*)
C          WRITE(IOIMP,*) 'IDCOMP     :',IDCOMP
C          WRITE(IOIMP,*) 'NBSOUS',NBSOUS
C        ENDIF
        IF (NBSOUS.GT.0) THEN
C         Construction des pointeurs des MELEME : OBJETS GEOMETRIQUES SIMPLE
          DO 211 IDTYPE = 1,NBGEOM
            IF (NBELCO(IDCOMP,IDTYPE).GT.0) THEN
              IPT2   = 0
              NBSOUS = 0
              NBREF  = 0
              NBNN   = GECONN(IDTYPE)
              NBELEM = NBELCO(IDCOMP,IDTYPE)
              SEGINI,IPT2
              IPT2.ITYPEL = IELEQU(IDTYPE)
 
C             Enregistrement dans un tableau du numéro de pointeur vers le MELEME non renseigné
              NPOINT(IDCOMP,IDTYPE) = IPT2
              SEGDES,IPT2
 
C              IF (DEBCB) THEN
C                WRITE(IOIMP,*) 'IDTYPE  :',IDTYPE
C                WRITE(IOIMP,*) 'NBNN    :',GECONN(IDTYPE)
C                WRITE(IOIMP,*) 'NB_ELEM :',NBELCO(IDCOMP,IDTYPE)
C                WRITE(IOIMP,*) 'Pointeur:',IPT2
C              ENDIF
            ENDIF
 211      CONTINUE
        ENDIF
 210  CONTINUE
 
 
C***********************************************************************
C     Relecture de tous les éléments du maillage
C     pour les placer dans le bon MELEME SIMPLE
C***********************************************************************
C     Cas des éléments lus appartenant aux COMPONENT
      DO 220 INDICE = 1,NELTOT
        IDELEM = ICOREL(INDICE)
        NBNN   = IELNBN(IDELEM)
        IDCONN = IELCON(IDELEM)
        IDCOMP = IELCOM(IDELEM)
        IDTYPE = IELTYP(IDELEM)
 
C       On incrémente le nombre d'élément placés dans le MELEME
        NBELC2(IDCOMP,IDTYPE) = NBELC2(IDCOMP,IDTYPE) + 1
        IELEME = NBELC2(IDCOMP,IDTYPE)
        IDMAIL = NPOINT(IDCOMP,IDTYPE)
 
C        IF (DEBCB) THEN
C          WRITE(IOIMP,*)
C          WRITE(IOIMP,*) 'INDICE   :',INDICE
C          WRITE(IOIMP,*) 'IDELEM      :',IDELEM
C          WRITE(IOIMP,*) 'IDCOMP:',IDCOMP
C          WRITE(IOIMP,*) 'IDTYPE:',IDTYPE
C          WRITE(IOIMP,*) 'NBNN  :',NBNN
C          WRITE(IOIMP,*) 'IELEME:',IELEME
C          WRITE(IOIMP,*) 'IDMAIL:',IDMAIL
C        ENDIF
 
C       Rechargement du pointeur du bon MELEME à remplir
        IPT2   = IDMAIL
        SEGACT,IPT2*MOD
C        IPT2.ICOLOR(IELEME) = ICOULC(IDCOMP)
        IPT2.ICOLOR(IELEME) = 0
 
        DO 221 JNDICE = 1,NBNN
C         Reconstitution de la connectivité dans l'ordre Cast3M
          ITEST  = IORDCO(20* (IDTYPE-1) + JNDICE)
          IDCOLU = ICONTO(IDCONN+(ITEST-1))
          IDCOCA = ICORNO(IDCOLU)+NBANC
          IPT2.NUM(JNDICE,IELEME) = IDCOCA
 
C          IF (DEBCB) THEN
C            WRITE(IOIMP,*) 'ITEST',ITEST
C            WRITE(IOIMP,*) 'ConLU :',IDCOLU,'ConC3M:',IDCOCA
C          ENDIF
 221    CONTINUE
      SEGDES,IPT2
 220  CONTINUE
 
C***********************************************************************
C     Traitement des SETS
C***********************************************************************
      DO INDICE=1,NBSETS
        IDSET =ISECOR(INDICE)
        COLO80=NOMSET(IDSET)
C        IF (DEBCB) THEN
C          WRITE(IOIMP,*) ' '
C          WRITE(IOIMP,*) 'Nom du Set :',COLO80,':'
C          WRITE(IOIMP,*) '(ID Set,Type Set     ,Nbr Entite)',
C     &                     IDSET ,ITYSET(IDSET),NBENTI(INDICE)
C        ENDIF
 
 
C       Cas des SETS de NOEUDS
        IF (ITYSET(IDSET) .EQ. 1) THEN
C          WRITE(IOIMP,*) 'Traitement d''un SET de NOEUDS'
C          WRITE(IOIMP,*)'Indice_SET : ',INDICE
C          WRITE(IOIMP,*) 'Nombre de noeuds : ',NBENTI(INDICE)
 
C          IF (DEBCB) THEN
C            WRITE(IOIMP,*) ' '
C            WRITE(IOIMP,*) 'Nom du Set :',COLO80,':'
C            WRITE(IOIMP,*) '(ID Set,Type Set     ,Nbr Entite)',
C     &                       IDSET ,ITYSET(IDSET),NBENTI(INDICE)
C            WRITE(IOIMP,*) 'GECONN(1) = ',GECONN(1)
C          ENDIF
          IPT2   = 0
          NBSOUS = 0
          NBREF  = 0
          NBNN   = GECONN(1)
          NBELEM = NBENTI(INDICE)
          SEGINI,IPT2
          IPT2.ITYPEL = IELEQU(1)
 
          DO JNDICE=1,NBENTI(INDICE)
C             IF (DEBCB) THEN
C               WRITE(IOIMP,*) 'LISTE DES NOEUDS',ILISTE(JNDICE,INDICE)
C             ENDIF
              IPT2.NUM(1,JNDICE)=ILISTE(JNDICE,IDSET)+NBANC
 
          ENDDO
 
C         Ecriture dans la table de Sortie du MELEME SIMPLE
          CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,COLO80    ,.FALSE.,0,
     &                       'MAILLAGE',0,0.d0,'RIEN',.FALSE.,IPT2)
          IF (IERR.NE.0) THEN
            CALL ERREUR(IERR)
            RETURN
          ENDIF
          SEGDES,IPT2
 
C       Cas des SETS d'elements
        ELSEIF (ITYSET(IDSET) .EQ. 2) THEN
C          IF (DEBCB) THEN
C            WRITE(IOIMP,*) 'Traitement d''un SET d''ELEMENT'
C            WRITE(IOIMP,*)'Indice_SET : ',INDICE
C            WRITE(IOIMP,*) '(ID Set,Type Set     ,Nbr Entite)',
C     &                       IDSET ,ITYSET(IDSET),NBENTI(INDICE)
C          ENDIF
          IPT1=0
          IPT2=0
          NBELEM = NBENTI(INDICE)
 
          DO JNDICE=1,NBELEM
C           Boucle sur tous les éléments du SET
            IDELEM = ILISTE(JNDICE,IDSET)
            NBNN   = IELNBN(IDELEM)
            IDCONN = IELCON(IDELEM)
            IDTYPE = IELTYP(IDELEM)
 
C            IF (DEBCB) THEN
C              WRITE(IOIMP,*) 'LISTE DES ELEMENTS',IDELEM
C              WRITE(IOIMP,*) 'Type d''element  :',IDTYPE
C              WRITE(IOIMP,*) 'Nombre Noeuds    :',NBNN
C              WRITE(IOIMP,*) 'IDCONN           :',IDCONN
C            ENDIF
 
C           Incrément du nombre d'élément de ce TYPE pour ce SET
            NBELSE(IDSET,IDTYPE) = NBELSE(IDSET,IDTYPE) + 1
 
            IF (NBTYPS(IDSET,IDTYPE) .EQ. 0) THEN
C             Cas d'un nouveau type d'élément rencontré
 
              IF (IPT1 .NE. 0) THEN
                SEGDES,IPT1
                IPT1 = 0
              ENDIF
 
              NBSOUS = 0
              NBREF  = 0
              SEGINI,IPT1
              IPT1.ITYPEL=IELEQU(IDTYPE)
 
C              WRITE(IOIMP,*) 'Nouveau MELEME SIMPLE :',IDTYPE,
C     &         GELEQU(IDTYPE), IPT1
 
C             Sauvegarde du pointeur
              NPOINS(IDSET,IDTYPE)   = IPT1
 
C             Incrément du nombre de types d'éléments dans le SET
              NBTYPS(IDSET,IDTYPE)   = 1
              NBTYPS(IDSET,NBGEOM+1) = NBTYPS(IDSET,NBGEOM+1) + 1
 
              IF(NBTYPS(IDSET,NBGEOM+1) .EQ. 1) THEN
C               Cas du premier MELEME SIMPLE rencontré
                NPOINS(IDSET,NBGEOM+1)   = IPT1
C                WRITE(IOIMP,*) 'Premier MELEME SIMPLE :',IDTYPE,
C     &         GELEQU(IDTYPE), IPT1
 
              ELSEIF (NBTYPS(IDSET,NBGEOM+1) .EQ. 2) THEN
C               Création d'un MELEME COMPLEXE
                NBNN   = 0
                NBELEM = 0
                NBSOUS = 2
                SEGINI,IPT2
                IPT2.LISOUS(1)=NPOINS(IDSET,NBGEOM+1)
                IPT2.LISOUS(2)=IPT1
C                WRITE(IOIMP,*) 'MELEME COMPLEXE Création :',IPT2, IPT1
 
C               Sauvegarde du MELEME COMPLEXE
                NPOINS(IDSET,NBGEOM+1)=IPT2
 
              ELSEIF(NBTYPS(IDSET,NBGEOM+1) .GT. 2) THEN
C               Ajout au MELEME COMPLEXE du nouveau MELEME SIMPLE
                NBNN   = 0
                NBELEM = 0
                NBSOUS = NBTYPS(IDSET,NBGEOM+1)
                SEGADJ,IPT2
                IPT2.LISOUS(NBSOUS)=IPT1
 
C                WRITE(IOIMP,*) 'MELEME COMPLEXE ajout :',IPT2, IPT1
              ENDIF
 
            ELSE
C             Cas d'un type d'élément déjà créé
              IF (NPOINS(IDSET,IDTYPE) .NE. IPT1) THEN
C               Cas ou le MELEME SIMPLE IPT1 actif n'est pas le bon
                SEGDES,IPT1
                IPT1 = NPOINS(IDSET,IDTYPE)
                WRITE(IOIMP,*)'   IPT1 Charge :',IPT1
                SEGACT,IPT1*MOD
              ENDIF
            ENDIF
 
C            WRITE(IOIMP,*)'NBNN :', IELNBN(IDELEM)
C            WRITE(IOIMP,*)'IPT1 INFO:',IPT1.NUM(/1),IPT1.NUM(/2)
C            WRITE(IOIMP,*)'Element LU :',IDELEM,'TYPE :',IDTYPE
 
            DO KNDICE=1,IELNBN(IDELEM)
C             Boucle sur la connectivité des éléments
              ITEST  = IORDCO(20* (IDTYPE-1) + KNDICE)
              IDCOLU = ICONTO(IDCONN+(ITEST-1))
              IDCOCA = ICORNO(IDCOLU)+NBANC
              IPT1.NUM(KNDICE,NBELSE(IDSET,IDTYPE)) = IDCOCA
C             WRITE(IOIMP,*)'  Connecti  LU / Cast3M:',IDCOLU,IDCOCA,
C     &                     'ITEST :',ITEST
            ENDDO
 
C            WRITE(IOIMP,*)'IPT1 :',IPT1.NUM(/1)
C            WRITE(IOIMP,*)'IPT1 :',IPT1.NUM(/2)
C            DO jjj=1,IPT1.NUM(/1)
C              DO kkk=1,IPT1.NUM(/2)
C
C                WRITE(IOIMP,*)'Connectivite :',IPT1.NUM(jjj,kkk)
C              ENDDO
C            ENDDO
C            SEGDES,IPT1
 
          ENDDO
C         Fin de la boucle sur les ELEMENTS d'un SET
 
C          WRITE(IOIMP,*)' '
 
C         Désactivation des SEGMENTS des MELEME encore ACTIFS
          IF (IPT1 .NE. 0) THEN
            SEGDES,IPT1
            IPT1 = 0
          ENDIF
          IF (IPT2 .NE. 0) THEN
            SEGDES,IPT2
            IPT2 = 0
          ENDIF
 
          DO JNDICE=1,NBGEOM
C           Ajustement de la taille des MELEME SIMPLES
            IF ( NBELSE(IDSET,JNDICE) .NE. 0 ) THEN
              IPT1 = NPOINS(IDSET,JNDICE)
              SEGACT,IPT1
 
              NBSOUS = 0
              NBREF  = 0
              NBELEM = NBELSE(IDSET,JNDICE)
              NBNN   = IPT1.NUM(/1)
              SEGADJ,IPT1
              SEGDES,IPT1
C              WRITE(IOIMP,*)'AJUSTEMENT IPT1 :',IPT1.NUM(/2),NBNN
            ENDIF
          ENDDO
 
          IPT2=NPOINS(IDSET,NBGEOM+1)
C          WRITE(IOIMP,*)'IPT2 TABLE :',IPT2
 
C          SEGACT,IPT2
C          WRITE(IOIMP,*)'Valeurs IPT2 :'
C          WRITE(IOIMP,*)' NBSOUS :',IPT2.LISOUS(/1)
C          DO iii=1,IPT2.LISOUS(/1)
C            WRITE(IOIMP,*)'  IPT1 :',IPT2.LISOUS(iii)
C            IPT1=IPT2.LISOUS(iii)
C            SEGACT,IPT1
C            DO jjj=1,IPT1.NUM(/1)
C              DO kkk=1,IPT1.NUM(/2)
C
C                WRITE(IOIMP,*)'Connectivite :',IPT1.NUM(jjj,kkk)
C              ENDDO
C            ENDDO
C            SEGDES,IPT1
C          ENDDO
C          SEGDES,IPT2
 
C         Ecriture dans la table de Sortie du MELEME SIMPLE ou COMPLEXE
          CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,COLO80    ,.FALSE.,0,
     &                       'MAILLAGE',0,0.d0,'RIEN',.FALSE.,IPT2)
          IF (IERR.NE.0) THEN
            CALL ERREUR(IERR)
            RETURN
          ENDIF
 
 
        ENDIF
      ENDDO
C     Fin de la boucle sur les SETS
 
 
 
 
C***********************************************************************
C     Création des maillages COMPLEXES composés des MELEME SIMPLES
C***********************************************************************
      DO 230 IDCOMP = 1,NBCOMP
        IDCOLU = ICOCOR(IDCOMP)
        COLO80 = NAMECO(IDCOLU)
        NBSOUS = NBTYPE(IDCOLU,NBGEOM+1)
C        IF (DEBCB) THEN
C          WRITE(IOIMP,*)
C          WRITE(IOIMP,*) 'IDCOLU',IDCOLU,'NBSOUS',NBSOUS
C        ENDIF
 
        ICOMPT = 0
        DO 231 IDTYPE = 1,NBGEOM
C         Parcours du tableau des MELEME SIMPLES
 
          IF (NBSOUS.EQ.0) THEN
C           Création d'un MELEME SIMPLE vide
            IPT1   = 0
            NBNN   = 1
            NBELEM = 0
            NBSOUS = 0
            NBREF  = 0
            SEGINI,IPT1
          ELSEIF (NBSOUS.EQ.1) THEN
            IF (NBTYPE(IDCOLU,IDTYPE).EQ.1) THEN
C             Création d'un MELEME SIMPLE à partir du premier pointeur de MELEME SIMPLE rencontré (le seul en théorie car NBSOUS=1)
              IPT1=NPOINT(IDCOLU,IDTYPE)
              SEGACT,IPT1
            ENDIF
          ELSE
            IF (NBTYPE(IDCOLU,IDTYPE).EQ.1) THEN
              IF (NPOINT(IDCOLU,NBGEOM+1).EQ.0) THEN
C               Création Initiale du MELEME COMPLEXE
                IPT1   = 0
                NBREF  = 0
                NBNN   = 0
                NBELEM = 0
                SEGINI,IPT1
                NPOINT(IDCOLU,NBGEOM+1) = IPT1
              ELSE
C               Chargement du MELEME COMPLEXE et complétion avec les MELEME SIMPLES rencontrés
                IPT1 = NPOINT(IDCOLU,NBGEOM+1)
                SEGACT,IPT1*MOD
              ENDIF
 
              ICOMPT = ICOMPT + 1
              IPT1.LISOUS(ICOMPT)=NPOINT(IDCOLU,IDTYPE)
C              IF (DEBCB) THEN
C                WRITE(IOIMP,*) 'ICOMPT',ICOMPT,'IDTYPE',IDTYPE
C                WRITE(IOIMP,*) 'Pointeur:',NPOINT(IDCOLU,IDTYPE)
C                WRITE(IOIMP,*) 'IPT1',IPT1
C              ENDIF
            ENDIF
          ENDIF
 231    CONTINUE
 
C       Ecriture dans la table de Sortie du MELEME COMPLEXE
        CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,COLO80    ,.FALSE.,0,
     &                     'MAILLAGE',0,0.d0,'RIEN',.FALSE.,IPT1)
        SEGDES,IPT1
 230  CONTINUE
 
 
C     A la fin on passe au Label 991 pour le ménage final
      GOTO 991
 
 
 989  CONTINUE
C       IF (DEBCB) THEN
C         WRITE(IOIMP,*) 'Erreur READ Wrong FORMAT (Lbl 989) : '
C       ENDIF
      CLOSE(UNIT=IUFEM,ERR=990)
      GOTO 991
 
 
 990  CONTINUE
C       IF (DEBCB) THEN
C         WRITE(IOIMP,*) 'Erreur OPEN/CLOSE (Lbl 990) : '
C       ENDIF
      GOTO 991
 
 
 991  CONTINUE
 
C Traitement des erreurs
      IF (IERR.NE.0) THEN
        CALL ERREUR(IERR)
        RETURN
      ENDIF
 
C***********************************************************************
C     Un peu de ménage dans la mémoire
C***********************************************************************
      SEGSUP,SREDLE
      SEGSUP,MLINOE
      SEGSUP,MLIELE
      SEGSUP,MELEQU
      SEGSUP,MCOMP
      SEGSUP,MSET
      SEGSUP,MLOCOL
      SEGDES,MTABLE
 
      END