Télécharger lirnas.eso

Retour à la liste

lirnas
C LIRNAS    SOURCE    PV        20/08/31    21:15:05     10703          
      SUBROUTINE LIRNAS
 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C BUT: Lecture des données au format NASTRAN sous forme de
C      fichier NAS (ASCII). Les données sont logées dans une table
C      qui est renvoyée comme résultat.
C
C Auteur : Clément BERTHINIER
C          Mai 2016
C
C Liste des Corrections :
C  CB215821 : Ajout des cartes de PROPERTY lors de la lecture
C  CB215821 : Correction d'un MELEME mal defini
C  CB215821 : Sur SEMT2, si une chaine de caractere contient le retour
C             chariot, le READ sort sur ERR=
C
C Appelé par : LIREFI
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
 
C Déclarations
      CHARACTER*256 FicNAS
      CHARACTER*80  LIGNE,COLO80
      CHARACTER*17  COLO17
      CHARACTER*16  COLO16
      CHARACTER*9   COLO9
      CHARACTER*8   COLO8
      CHARACTER*4   COLO4
 
      LOGICAL BEGIN, PRECID
 
C     Unite logique du fichier d'impression au format .nas et nom du fichier
      PARAMETER (IUNAS=68)
 
C Définition des COMMON utiles
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
-INC SMCOORD
-INC CCGEOME
-INC SMELEME
-INC TMTRAV
-INC SMTABLE
 
C Déclaration de tableaux
 
      PARAMETER (NBFLO=3   )
      REAL*8     XFL(NBFLO )
 
      PARAMETER (NBGEO1=32 )
      PARAMETER (NBSY  =6  )
      PARAMETER (NBCART=20 )
      PARAMETER (NPROPE=3  )
      CHARACTER*8 GETYPE(NBGEO1+NBSY+NBCART),PROTYP(NPROPE)
      INTEGER     NONLUE(NBGEO1+NBSY+NBCART)
      CHARACTER*4 ELCAS1(NBGEO1)
      CHARACTER*4 ELCAS2(NBGEO1)
 
C     IELEQ1   : Place dans NOMS des elements equivalents dans Cast3M d'ordre 1
C     IELEQ2   : Place dans NOMS des elements equivalents dans Cast3M d'ordre 2
C     NBNOE1   : Nombre de noeuds pour l'element concerne d'ordre 1
C     NBNOE2   : Nombre de noeuds pour l'element concerne d'ordre 2
      INTEGER IELEQ1(NBGEO1)
      INTEGER IELEQ2(NBGEO1)
      INTEGER NBNOE1(NBGEO1)
      INTEGER NBNOE2(NBGEO1)
 
 
      PARAMETER (NBGEO2=15)
      INTEGER     IORDCO(NBGEO2*20)
      CHARACTER*4 CTYPE(NBGEO2)
 
C     Liste des CARACTERES RECONNUS pour détecter les CR et LF
      CHARACTER*76 CARAOK
      DATA CARAOK /'0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOP
     &QRSTUVWXYZ+-/*=.,:;=?&_#'/
 
C Liste des mots clés en début de ligne d'un fichier .nas
      DATA GETYPE / 'GRID    ','GRID*   ',
     &              'RBE2    ','RBE2*   ','RBE3    ','RBE3*   ',
     &              'CTRIA3  ','CTRIA3* ',
     &              'CTRIA6  ','CTRIA6* ',
     &              'CQUAD4  ','CQUAD4* ',
     &              'CQUAD8  ','CQUAD8* ',
     &              'CTETRA  ','CTETRA* ',
     &              'CPYRA   ','CPYRA*  ',
     &              'CPENTA  ','CPENTA* ',
     &              'CHEXA   ','CHEXA*  ',
     &              'CBAR    ','CBAR*   ','CBEAM   ','CBEAM*  ',
     &              'CONM2   ','CONM2*  ','RBAR    ','RBAR*   ',
     &              'CELAS2  ','CELAS2* ',
     &              'CORD2R  ','CORD2R* ','CORD2C  ','CORD2C* ',
     &              'CORD2S  ','CORD2S* ',
     &              'SPC     ','SPC*    ','SPCD    ','SPCD*   ',
     &              'LOAD    ','LOAD*   ','PLOAD   ','PLOAD*  ',
     &              'PLOAD1  ','PLOAD1* ','PLOAD2  ','PLOAD2* ',
     &              'PLOAD4  ','PLOAD4* ','FORCE   ','FORCE*  ',
     &              'MOMENT  ','MOMENT* ','TEMP    ','TEMP*   ' /
 
      DATA PROTYP / 'PROD    ','PSHELL  ','PSOLID  ' /
 
C Elements equivalents dans Cast3M
      DATA ELCAS1 / 'POI1','POI1',
     &              'SEG2','SEG2',
     &              'SEG3','SEG3',
     &              'TRI3','TRI3',
     &              'TRI6','TRI6',
     &              'QUA4','QUA4',
     &              'QUA8','QUA8',
     &              'TET4','TET4',
     &              'PYR5','PYR5',
     &              'PRI6','PRI6',
     &              'CUB8','CUB8',
     &              'SEG2','SEG2',
     &              'SEG2','SEG2',
     &              'POI1','POI1',
     &              'SEG2','SEG2',
     &              'SEG2','SEG2' /
 
C Elements alternatifs equivalents dans Cast3M (Meme nom entre ordre 1 et ordre 2)
C pour les éléments CTETRA, CPYRA, CPENTA, CHEXA
      DATA ELCAS2 / 'POI1','POI1',
     &              'SEG2','SEG2',
     &              'SEG3','SEG3',
     &              'TRI3','TRI3',
     &              'TRI6','TRI6',
     &              'QUA4','QUA4',
     &              'QUA8','QUA8',
     &              'TE10','TE10',
     &              'PY13','PY13',
     &              'PR15','PR15',
     &              'CU20','CU20',
     &              'SEG2','SEG2',
     &              'SEG2','SEG2',
     &              'POI1','POI1',
     &              'SEG2','SEG2',
     &              'SEG2','SEG2' /
 
C     Le nombre de noeuds est lu dans NBNNE(i)           (bdata.eso)
C     'i' est l''index de l''élément de Cast3M dans NOMS (bdata.eso)
 
C    Data indiquant le nom de l'element auquel correspond IORDCO
      DATA CTYPE /
     & 'POI1',
     & 'SEG2',
     & 'SEG3',
     & 'TRI3',
     & 'TRI6',
     & 'QUA4',
     & 'QUA8',
     & 'TET4',
     & 'TE10',
     & 'PYR5',
     & 'PY13',
     & 'PRI6',
     & 'PR15',
     & 'CUB8',
     & 'CU20' /
 
 
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,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***********************************************************************
C Définition des différents segments et de leur contenu
C***********************************************************************
C     Enregistrement des POINTS du MODELE
      SEGMENT MLINOE
C       JGNOLU   : ID du noeud lu dans le fichier
C       ICORNO   : Correspondance depuis la numérotation lue vers la numérotation LOCALE des noeuds
C       ISYSTE   : Entier valant 0 pour le systeme global et l'ID du systeme sinon
C       XCOLU    : FLOTTANTS indiquant les coordonnées non transformées par les systèmes
        INTEGER ICORNO(JGNOLU)
        INTEGER ISYSTE(JGNOLU)
        REAL*8  XCOLU (3,JGNOLU)
      ENDSEGMENT
 
C     Enregistrement des ELEMENTS du MODELE
      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 MLIELE.ICONTO
C       IELNBN   : Nombre de noeuds de connectivité à lire dans MLIELE.ICONTO
C       IELTYP   : Type de l''élément lu pour Cast3M
C       IDPROP   : ID de la propriété
C       IRBE2    : Code du bloquage pour RBE2
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 IDPROP(JGELLU)
        INTEGER IRBE2 (JGELLU)
        INTEGER ICONTO(JELCON)
        INTEGER ICOREL(JGELLO)
      ENDSEGMENT
 
C     Enregistrement des PROPERTY du MODELE
      SEGMENT MPROP
C       NBPROP   : Nombre de Property dans le MODELE
C       ICOPRO   : Correspondance entre le numéro d''ordre de lecture et l''ID de la propriete lue
C       ITYPRO   : Type de MELEME presents dans la Property (taille de NOMS est spécifiée maximum égale à 100 dans CCGEOME.INC)
C       IMELSI   : Pointeur MELEME SIMPLE du TYPE en question
C       NBELPR   : Nombre d''element a mesure qu''ils sont triés (à la fin)
C       IMELCO   : Pointeur MELEME COMPLEXE
        INTEGER ICOPRO(NBPROP)
        INTEGER ITYPRO(100,NBPROP)
        INTEGER IMELSI(100,NBPROP)
        INTEGER NBELPR(100,NBPROP)
        INTEGER IMELCO(NBPROP)
      ENDSEGMENT
 
C     Enregistrement des SYSTEME du MODELE
      SEGMENT MSYSTE
C       JGSYST   : Nombre de systemes dans le MODELE
C       ITYSYS   : Type du systeme 1 Cartesien, 2 Cylindrique, 3 Spherique
C       IDSYST   : Tableau contenant les ID des systemes dans l''ordre de lecture
C       INOSYS   : Numéro des 4 noeuds du systeme dans la numérotation absolue de Cast3M
C       SYSCOR   : 12 Coordonnees des noeuds du systeme 9 suffisent les 3 dernières sont calculées par produit vectoriel
C       SCOOR2   : matrice de passage du repère local au repere global
        INTEGER IDSYST(JGSYST)
        INTEGER ITYSYS(JGSYST)
        INTEGER INOSYS(4,JGSYST)
        REAL*8  SYSCOR(12,JGSYST)
        REAL*8  SCOOR2(9,JGSYST)
      ENDSEGMENT
 
C     Enregistrement des RBE2 (Rigid Body)
      SEGMENT MRBE2
C       JGRBE2   : Nombre de RBE2 de type differents dans le MODELE
C       NELRBE   : Tableau indiquant combient de RBE de ce type il faut creer
C       IBLRBE   : Code du bloquage pour ce RBE2
C       IMELRB   : Pointeur MELEME SIMPLE du TYPE en question
        INTEGER NELRBE(JGRBE2)
        INTEGER IBLRBE(JGRBE2)
        INTEGER IMELRB(JGRBE2)
      ENDSEGMENT
 
C     Enregistrement des SPC (Blocages)
      SEGMENT MSPC
C       JGSPC    : Nombre de SPC dans le MODELE
C       NBSDIF   : Nombre d''ID de SPC
C       IDSPC    : ID lue pour ce SPC
C       ILISPC   : Liste des ID de SPC differents
C       NBESPC   : nombre d''elements PO1I dans cet ID de SPC
C       INOSPC   : ID lue du noeud  pour ce SPC
C       IBLOLU   : Code du blocage  pour ce SPC
C       IHASHS   : HashCode (numero unique) du code du blocage
C       ICOSPC   : Correspondance entre le numéro du SPC et la position de son ID dans liste ILISPC
C       XSPC     : Flottant lue     pour ce SPC
C       IMELSP   : Pointeur MELEME SIMPLE pour cet ID de SPC
        INTEGER IDSPC (JGSPC )
        INTEGER ILISPC(NBSDIF)
        INTEGER NBESPC(NBSDIF)
        INTEGER INOSPC(JGSPC )
        INTEGER IBLOLU(JGSPC )
        INTEGER IHASHS(JGSPC )
        INTEGER ICOSPC(JGSPC )
        REAL*8  XSPC  (JGSPC )
        INTEGER IMELSP(NBSDIF)
      ENDSEGMENT
 
C     Enregistrement des TEMPERATURES
      SEGMENT MTEMP
C       JGTEMP   : Nombre de TEMPERATURE dans le MODELE
C       NBTDIF   : Nombre d''ID de TEMPERATURE
C       IDTEMP   : ID lue pour cette TEMPERATURE
C       ILITEM   : Liste des ID de TEMPERATURE differentes
C       NBETEM   : nombre d''elements PO1I dans cet ID de TEMPERATURE
C       INOTEM   : ID lue du noeud  pour cet ID de TEMPERATURE
C       ICOTEM   : Correspondance entre le numéro de la carte TEMPERATURE et la position de son ID dans liste ILITEM
C       XTEMP    : Flottant lue     pour la TEMPERATURE
        INTEGER IDTEMP(JGTEMP )
        INTEGER ILITEM(NBTDIF)
        INTEGER NBETEM(NBTDIF)
        INTEGER INOTEM(JGTEMP )
        INTEGER ICOTEM(JGTEMP )
        REAL*8  XTEMP (JGTEMP )
      ENDSEGMENT
 
C     Enregistrement des FORCES
      SEGMENT MFORCE
C       JGFORC   : Nombre de FORCES dans le MODELE
C       NBFDIF   : Nombre d''ID de FORCES
C       IDFORC   : ID lue pour cette FORCES
C       ILIFOR   : Liste des ID de FORCES differentes
C       NBEFOR   : nombre d''elements PO1I dans cet ID de FORCES
C       INOFOR   : ID lue du noeud  pour cet ID de FORCES
C       ICOFOR   : Correspondance entre le numéro de la carte FORCES et la position de son ID dans liste ILIFOR
C       XFORCE   : Flottants lus pour la FORCES
        INTEGER IDFORC(JGFORC)
        INTEGER ILIFOR(NBFDIF)
        INTEGER NBEFOR(NBFDIF)
        INTEGER INOFOR(JGFORC)
        INTEGER ICOFOR(JGFORC)
        REAL*8  XFORCE(3,JGFORC)
      ENDSEGMENT
 
 
C     Enregistrement des MOMENTS
      SEGMENT MMOMEN
C       JGMOME  : Nombre de MOMENTS dans le MODELE
C       NBMDIF   : Nombre d''ID de MOMENTS
C       IDMOME   : ID lue pour cette MOMENTS
C       ILIMOM  : Liste des ID de MOMENTS differentes
C       NBEMOM   : nombre d''elements PO1I dans cet ID de MOMENTS
C       INOMOM   : ID lue du noeud  pour cet ID de MOMENTS
C       ICOMOM   : Correspondance entre le numéro de la carte MOMENTS et la position de son ID dans liste ILIFOR
C       XMOMEN   : Flottants lus pour la MOMENTS
        INTEGER IDMOME(JGMOME)
        INTEGER ILIMOM(NBMDIF)
        INTEGER NBEMOM(NBMDIF)
        INTEGER INOMOM(JGMOME)
        INTEGER ICOMOM(JGMOME)
        REAL*8  XMOMEN(3,JGMOME)
      ENDSEGMENT
 
C***********************************************************************
C Début du programme
C***********************************************************************
C Création de la table VIDE de sortie
      M=0
      SEGINI,MTABLE
 
C Initialisation des Segments
      NBNPTS = 0
      NELTOT = 0
      NBCONN = 0
      NBSYST = 0
      NBRBE2 = 0
      NBSPC  = 0
      NBTEMP = 0
      NBFORC = 0
      NBMOME = 0
 
      INCJGN = 50                                                        C Incrément de NOEUD
      INCJGE = 50                                                        C Incrément d' ELEMENT
      INCJCO = 50                                                        C Incrément de CONNECTIVITE
      INCJSY = 50                                                        C Incrément de SYSTEME
      INCJGR = 50                                                        C Incrément de RBE2 de type different
      INCSPC = 50                                                        C Incrément de SPC
      INCTEM = 50                                                        C Incrément de TEMPERATURE
      INCFOR = 50                                                        C Incrément de FORCES
      INCMOM = 50                                                        C Incrément de MOMENTS
 
      JGNOLO=INCJGN
      JGNOLU=INCJGN
      SEGINI,MLINOE
 
      JGELLU=INCJGE
      JGELLO=INCJGE
      JELCON=INCJCO
      SEGINI,MLIELE
 
      NBPROP = 0
      SEGINI,MPROP
 
      JGSYST = 0
      SEGINI,MSYSTE
 
      JGRBE2 = 0
      SEGINI,MRBE2
 
      JGSPC  = 0
      NBSDIF = 0
      SEGINI,MSPC
 
      JGTEMP = 0
      NBTDIF = 0
      SEGINI,MTEMP
 
      JGFORC = 0
      NBFDIF = 0
      SEGINI,MFORCE
 
      JGMOME = 0
      NBMDIF = 0
      SEGINI,MMOMEN
 
      NBLIGN = 0
      BEGIN  = .FALSE.
      PRECID = .FALSE.
 
C     Remplissage de IELEQ1, IELEQ2, NBNOE1, NBNOE2
      DO 9 INDICE = 1, NBGEO1
        COLO4=ELCAS1(INDICE)
        CALL PLACE(NOMS,100,IRETO3,COLO4)
        IELEQ1(INDICE)=IRETO3
        NBNOE1(INDICE)=NBNNE(IRETO3)
 
        COLO4=ELCAS2(INDICE)
        CALL PLACE(NOMS,100,IRETO3,COLO4)
        IELEQ2(INDICE)=IRETO3
        NBNOE2(INDICE)=NBNNE(IRETO3)
 9    CONTINUE
 
C     Mise à zéro de NONLUE
      DO INDICE=1,NBGEO1+NBSY+NBCART
        NONLUE(INDICE)=0
      ENDDO
 
 
C Lecture des arguments : Nom du fichier à lire (toto.nas)
      CALL LIRCHA(FicNAS,1,IRETO1)
      IF (IERR.NE.0) RETURN
 
C Par defaut, Erreur Cast3M numero 424
C     Erreur 424 : Problème %i1 en ouvrant le fichier : %m1:40
      iOK=424
      L=LEN(FicNAS)
      MOTERR=FicNAS(1:L)
      INTERR(1)=0
 
C Ouverture du fichier .nas
      CLOSE(UNIT=IUNAS,ERR=991)
      OPEN (UNIT=IUNAS,STATUS='OLD',FILE=FicNAS(1:L),
     &     IOSTAT=IOS,FORM='FORMATTED')
 
C Traitement des erreurs d'ouverture des fichiers
      IF (IOS.NE.0) THEN
        INTERR(1)=IOS
C           IF (DEBCB) THEN
C             WRITE(IOIMP,*) 'Fichier introuvable : ',FicNAS
C           ENDIF
        CALL ERREUR(424)
        RETURN
      ELSE
C        IF (DEBCB) THEN
C          WRITE(IOIMP,*) 'Ouverture OK du fichier NAS'
C        ENDIF
 
C       Changement de dimension (si necessaire)
        iOK=0
        IDIMI=IDIM
        IDIMF=3
        IF (IDIMF.NE.IDIMI) THEN
          CALL ECRENT(IDIMF)
          CALL ECRCHA('DIME')
          CALL OPTION(1)
          IF (IERR.NE.0) THEN
            CALL ERREUR(IERR)
            RETURN
          ENDIF
          WRITE(IOIMP,*) ' '
          WRITE(IOIMP,*) '     Passage en DIMEnsion 3'
          WRITE(IOIMP,*) ' '
        ENDIF
      ENDIF
      idimp1=IDIM+1
      segact mcoord*mod
      NBANC=nbpts
      NBPTS=NBANC+JGNOLO
      SEGADJ,MCOORD
 
 10   CONTINUE
C     Lecture de la ligne complete (80 caracteres)
 1000 FORMAT(A80)
      READ(IUNAS,1000,ERR=990,END=100) LIGNE
      ITLIGN = 80
      CALL LENCHA(LIGNE,ITLIGN)
      INDXE=INDEX(CARAOK,LIGNE(ITLIGN:ITLIGN))
      IF (INDXE .EQ. 0) LIGNE(ITLIGN:ITLIGN)=' '
      NBLIGN = NBLIGN + 1
C       IF (DEBCB) THEN
C         WRITE(IOIMP,*),NBLIGN,LIGNE
C       ENDIF
 
C     Detection de la ligne BEGIN BULK
      IF (LIGNE(1:10) .EQ. 'BEGIN BULK') THEN
C        WRITE(IOIMP,*),'BEGIN BULK, LIGNE',NBLIGN
        BEGIN=.TRUE.
        GOTO 100
      ENDIF
      GOTO 10
 
 100  CONTINUE
 
C Cas ou BEGIN BULK n'a pas ete lu...
      IF (BEGIN .EQV. .FALSE.) THEN
        CALL ERREUR(21)
        RETURN
      ENDIF
 
C***********************************************************************
C      Lecture des cartes NASTRAN dans le fichier
C***********************************************************************
C     Boucle "infinie" sur la lecture des lignes
 11   CONTINUE
C     Acquisition d''une nouvelle ligne
      READ(IUNAS,1000,ERR=990,END=990) LIGNE
      CALL LENCHA(LIGNE,ITLIGN)
      INDXE=INDEX(CARAOK,LIGNE(ITLIGN:ITLIGN))
      IF (INDXE .EQ. 0) LIGNE(ITLIGN:ITLIGN)=' '
      NBLIGN = NBLIGN + 1
 
C     Premiere lettre de la ligne
      IF ((LIGNE(1:1) .EQ. ' ') .OR. (LIGNE(1:1) .EQ. '$')) GOTO 11
 
C     Premier mot de la ligne
      IDEB = 1
      IFIN = MIN(IDEB + 8 - 1,ITLIGN)
      COLO8=LIGNE(IDEB:IFIN)
 
      IRETO1 = 0
C     Recherche dans le DATA des PROPERTY
      CALL PLACE(PROTYP,NPROPE            ,IRETO1,COLO8)
      IF (IRETO1 .NE. 0) THEN
        WRITE(IOIMP,*) 'PROPERTY non traitee : ',PROTYP(IRETO1)
        GOTO 11
      ENDIF
 
      IRETO1 = 0
      IRETO2 = 0
C     Recherche dans le DATA des éléments géométriques
      CALL PLACE(GETYPE,NBGEO1+NBSY+NBCART,IRETO1 ,COLO8)
      IF (IRETO1 .EQ. 0) GOTO 11
 
 12   CONTINUE
 
C     Lecture simple ou double precision
      IF ((MOD(IRETO1,2)) .EQ. 0) THEN
        PRECID = .TRUE.
        NCOLOL = 4
        LCOL   = LEN(COLO16)
C        PRINT *,'Lecture en double precision ',GETYPE(IRETO1)
      ELSE
        PRECID = .FALSE.
        NCOLOL = 8
        LCOL   = LEN(COLO8)
C        PRINT *,'Lecture en simple precision ',GETYPE(IRETO1)
      ENDIF
 
      IDEB = 8 + 1
      IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
 
C     Cas des POINTS
      IF ((IRETO1 .EQ. 1) .OR. (IRETO1 .EQ. 2)) THEN
C        PRINT *,':',GETYPE(IRETO1),':',LIGNE(IDEB:IFIN),':',IDEB
        READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IDLU
        IF (IOSTA1 .NE. 0) THEN
          moterr    ='READ (IOSTAT)'
          interr(1) = IOSTA1
          CALL ERREUR(873)
          RETURN
        ENDIF
 
C        PRINT *,'ID Noeud :',IDLU
        NBNPTS = NBNPTS + 1
 
C       Ajustement des SEGMENTS MLINOE et MCOORD
        IF( NBNPTS .GT. JGNOLO) THEN
          INCJGN = 2 * INCJGN
          JGNOLO = JGNOLO + INCJGN
          NBPTS  = JGNOLO + NBANC
          SEGADJ,MLINOE,MCOORD
C          PRINT * ,'MLINOE Ajustement intermediaire'
        ENDIF
 
        IF(IDLU.GT.JGNOLU) THEN
          INCJGN = 2 * INCJGN
          JGNOLU = IDLU + INCJGN
          SEGADJ,MLINOE
        ENDIF
        MLINOE.ICORNO(IDLU)  =NBNPTS
 
C       Lecture d''un ID de systeme local (COLONNE 2)
        IDEB = IFIN + 1
        IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
        READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSSY1) IDSYS
        IF (IOSSY1 .NE. 0) IDSYS = 0
        MLINOE.ISYSTE(IDLU) = IDSYS
 
C       Lecture des Coordonnees
        DO IFLOT=1,3
          IF ((IFLOT .EQ.3) .AND. (PRECID)) THEN
C           Lecture de la ligne suivante
            READ(IUNAS,1000,ERR=990,END=990) LIGNE
            CALL LENCHA(LIGNE,ITLIGN)
            INDXE=INDEX(CARAOK,LIGNE(ITLIGN:ITLIGN))
            IF (INDXE .EQ. 0) LIGNE(ITLIGN:ITLIGN)=' '
            NBLIGN = NBLIGN + 1
            IDEB = 8 + 1
            IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
          ELSE
            IDEB = IFIN + 1
            IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
          ENDIF
 
C         Correction à la volée d'une caractéristique du format .nas le 'E' n'est pas toujours mis pour les puissances négatives
          IF (PRECID) THEN
            COLO16= LIGNE(IDEB:IFIN)
            COLO17= COLO16//' '
            IF(COLO16(1:1).EQ.'-')THEN
              IADD = 1
            ELSE
              IADD = 0
            ENDIF
 
            DO 16 ICHARA = 1+IADD, LCOL
              IF((COLO16(ICHARA:ICHARA).EQ.'-').AND.
     &           (COLO16(ICHARA-1:ICHARA-1).NE.'e').AND.
     &           (COLO16(ICHARA-1:ICHARA-1).NE.'E').AND.
     &           (COLO16(ICHARA-1:ICHARA-1).NE.'d').AND.
     &           (COLO16(ICHARA-1:ICHARA-1).NE.'D').AND.
     &           (COLO16(ICHARA-1:ICHARA-1).NE.' '))THEN
                COLO17 =COLO16(1:ICHARA-1)//'E-'//
     &                  COLO16(ICHARA+1:LCOL)
C               PRINT*, 'Nouvelle COLO17 : ',COLO17
              ENDIF
 16         CONTINUE
 
            READ(COLO17,*,ERR=11,IOSTAT=IOSTA1) Flot1
            IF (IOSTA1 .NE. 0) THEN
              moterr    ='READ (IOSTAT)'
              interr(1) = IOSTA1
              CALL ERREUR(873)
              RETURN
            ENDIF
 
          ELSE
            COLO8 = LIGNE(IDEB:IFIN)
            COLO9 = COLO8//' '
            IF(COLO8(1:1).EQ.'-')THEN
              IADD = 1
            ELSE
              IADD = 0
            ENDIF
 
            DO 15 ICHARA = 1+IADD, LCOL
              IF((COLO8(ICHARA:ICHARA).EQ.'-').AND.
     &           (COLO8(ICHARA-1:ICHARA-1).NE.'e').AND.
     &           (COLO8(ICHARA-1:ICHARA-1).NE.'E').AND.
     &           (COLO8(ICHARA-1:ICHARA-1).NE.'d').AND.
     &           (COLO8(ICHARA-1:ICHARA-1).NE.'D').AND.
     &           (COLO8(ICHARA-1:ICHARA-1).NE.' '))THEN
                COLO9 =COLO8(1:ICHARA-1)//'E-'//COLO8(ICHARA+1:LCOL)
C               PRINT *, 'Nouvelle COLO9 : ',COLO9
              ENDIF
 15         CONTINUE
 
            READ(COLO9,*,ERR=11,IOSTAT=IOSTA1) Flot1
            IF (IOSTA1 .NE. 0) THEN
              moterr    ='READ (IOSTAT)'
              interr(1) = IOSTA1
              CALL ERREUR(873)
              RETURN
            ENDIF
          ENDIF
 
          j=(NBANC+NBNPTS-1)*idimp1
          MCOORD.XCOOR(j+IFLOT)   =Flot1
          MLINOE.XCOLU(IFLOT,IDLU)=Flot1
C          PRINT *,IDLU,Flot1
        ENDDO
 
CC       Lecture d''un ID de systeme local (COLONNE 2 de la LIGNE 2)
C        IDEB = IFIN + 1
C        IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
C        READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSSY2) IDSYS2
C        IF (IOSSY2 .EQ. 0) THEN
C          IF ((IOSSY1 .EQ. 0) .AND. (IDSYS .NE. IDSYS2)) THEN
CC           Lecture de 2 systemes differents pour ce noeud
C            WRITE(IOIMP,*) '2 systeme different pour le noeud',IDLU
C            CALL ERREUR(21)
C            RETURN
C          ENDIF
C
CC          PRINT *, IDLU, 'Systeme ID :',IDSYS2,'COLONNE 2 LIGNE 2'
C          MLINOE.ISYSTE(IDLU) = IDSYS2
C          IDSYS = IDSYS2
C        ENDIF
 
C       Conversion à la volée des coordonnées en fonction du type de repère
        IF (IDSYS .NE. 0) THEN
          DO NUMSYS=1,NBSYST
            IF(MSYSTE.IDSYST(NUMSYS) .EQ. IDSYS) GOTO 160
          ENDDO
          WRITE(IOIMP,*) 'On n''a pas lu le repere d''ID:',IDSYS
          CALL ERREUR(21)
          RETURN
 
 160      CONTINUE
          ITYPES = MSYSTE.ITYSYS(NUMSYS)
C          PRINT *,'Type de repere', ITYPES, NUMSYS
          XFL(1) = REAL(0.D0)
          XFL(2) = REAL(0.D0)
          XFL(3) = REAL(0.D0)
          j=(NBANC+NBNPTS-1)*idimp1
          IF     (ITYPES .EQ. 1) THEN
C           Transformation Cartesienne
C           Le X lu devient mon Y
            XLU=MCOORD.XCOOR(j+1)
            MCOORD.XCOOR(j+1)=MCOORD.XCOOR(j+2)
            MCOORD.XCOOR(j+2)=XLU
 
          ELSEIF (ITYPES .EQ. 2) THEN
C           Transformation Cylindrique
C           Passage en Cartesien Local X', Y', Z'
            RFLO = MCOORD.XCOOR(j+1)
            TETA = MCOORD.XCOOR(j+2) * (2.D0*XPI) / 360.D0
 
            MCOORD.XCOOR(j+1) =  RFLO * COS(TETA)
            MCOORD.XCOOR(j+2) = -RFLO * SIN(TETA)
 
C           Le X calculé devient mon -Z
            XLU=MCOORD.XCOOR(j+1)
            MCOORD.XCOOR(j+1)=MCOORD.XCOOR(j+3)
            MCOORD.XCOOR(j+3)=-XLU
 
          ELSEIF (ITYPES .EQ. 3) THEN
C           Transformation Spherique
C           Passage en Cartesien Local X', Y', Z'
            RFLO = MCOORD.XCOOR(j+1)
            PHI  = MCOORD.XCOOR(j+2) * (2.D0*XPI) / 360.D0
            TETA = MCOORD.XCOOR(j+3) * (2.D0*XPI) / 360.D0
 
            MCOORD.XCOOR(j+1) =  RFLO * SIN(PHI) * COS(TETA)
            MCOORD.XCOOR(j+2) =  RFLO * SIN(PHI) * SIN(TETA)
            MCOORD.XCOOR(j+3) =  RFLO * COS(PHI)
 
C           Le X calculé devient mon Y
            XLU=MCOORD.XCOOR(j+1)
            MCOORD.XCOOR(j+1)=MCOORD.XCOOR(j+2)
            MCOORD.XCOOR(j+2)=XLU
          ELSE
            WRITE(IOIMP,*) 'Systeme de type inconnu :',ITYPES
            CALL ERREUR(21)
            RETURN
          ENDIF
 
C         Passage en coordonnées X,Y,Z centrées sur le repère Local
          DO III=1,3
            DO IFLOT=1,3
              Flot = MCOORD.XCOOR(j+IFLOT)
              INDICE=(III-1)*3 + IFLOT
              XFL(III)=XFL(III)+ MSYSTE.SCOOR2(INDICE,NUMSYS)*Flot
C              PRINT *,INDICE,SYSCOR(INDICE,NUMSYS),Flot,XFL(III)
            ENDDO
          ENDDO
 
C         Remplacement dans MCOORD
          DO IFLOT=1,3
C           Translation dans le repere X,Y,Z général & Remplacement dans MCOORD
            XFL(IFLOT) = XFL(IFLOT) + MSYSTE.SYSCOR(IFLOT,NUMSYS)
C            PRINT *,IFLOT,NUMSYS, MSYSTE.SYSCOR(IFLOT,NUMSYS)
            MCOORD.XCOOR(j+IFLOT)=XFL(IFLOT)
          ENDDO
        ENDIF
 
        GOTO 11
 
      ELSEIF (IRETO1 .LE. NBGEO1) THEN
        IF     ((IRETO1 .EQ. 3) .OR. (IRETO1 .EQ. 4)) THEN
C         Cas des ELEMENTS RBE2
          NELTOT = NELTOT + 1
C         Ajustement du segment MLIELE
          IF(NELTOT .GT. JGELLO) THEN
            INCJGE = 2 * INCJGE
            JGELLO = NELTOT + INCJGE
            SEGADJ,MLIELE
          ENDIF
 
C         Lecture du numero d'element
          READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IDLU
          IF (IOSTA1 .NE. 0) THEN
            moterr    ='READ (IOSTAT)'
            interr(1) = IOSTA1
            CALL ERREUR(873)
            RETURN
          ENDIF
C          PRINT *,' '
C          PRINT *,'ELEMENT :',IDLU, GETYPE(IRETO1),NELTOT
 
          IF (IDLU .GT. JGELLU) THEN
            INCJGE = 2 * INCJGE
            JGELLU = IDLU + INCJGE
            SEGADJ,MLIELE
          ENDIF
 
C         Enregistrement de la correspondance
          MLIELE.ICOREL(NELTOT)= IDLU
          MLIELE.IELTYP(IDLU)  = IELEQ1(IRETO1)
 
          IDEB = IFIN + 1
          IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
 
C         Lecture du Noeud Maitre
C          PRINT *,'LIGNE(IDEB:IFIN):',LIGNE(IDEB:IFIN),':'
          READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) INOEMA
          IF (IOSTA1 .NE. 0) THEN
            moterr    ='READ (IOSTAT)'
            interr(1) = IOSTA1
            CALL ERREUR(873)
            RETURN
          ENDIF
C         Enregistrer ou débute la lecture de la connectivité
          MLIELE.IELCON(IDLU)=NBCONN+1
          NBCONN = NBCONN + 1
 
C         Ajustement du segment MLIELE
          IF (NBCONN .GT. JELCON) THEN
            INCJCO = 2 * INCJCO
            JELCON = NBCONN + INCJCO
            SEGADJ,MLIELE
          ENDIF
          MLIELE.ICONTO(NBCONN)=INOEMA
          MLIELE.IELNBN(IDLU)  =MLIELE.IELNBN(IDLU) + 1
 
          IDEB = IFIN + 1
          IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
 
C         Lecture du code de bloquage
C          PRINT *,'LIGNE(IDEB:IFIN):',LIGNE(IDEB:IFIN),':'
          READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IBLOQ
          IF (IOSTA1 .NE. 0) THEN
            moterr    ='READ (IOSTAT)'
            interr(1) = IOSTA1
            CALL ERREUR(873)
            RETURN
          ENDIF
          MLIELE.IRBE2(IDLU)=IBLOQ
 
          NBRBE2=NBRBE2 + 1
 
          IF (NBRBE2 .GT. JGRBE2) THEN
            INCJGR = 2 * INCJGR
            JGRBE2 = JGRBE2 + INCJGR
            SEGADJ,MRBE2
          ENDIF
          MRBE2.IBLRBE(NBRBE2) = IBLOQ
          MLIELE.IDPROP(IDLU)  = NBRBE2
 
C         Lecture de la connectivite
C          PRINT *, 'IBLOQ',IBLOQ,NBRBE2
          NUMCOL = 3
 170      CONTINUE
          IRETO2 = 0
          NUMCOL = NUMCOL + 1
          IDEB   = IFIN + 1
          IFIN   = MIN(IDEB + LCOL - 1,ITLIGN)
C          PRINT *,MLIELE.IELNBN(IDLU)+1,':',LIGNE(IDEB:IFIN),':'
          READ(LIGNE(IDEB:IFIN),*,ERR=170,IOSTAT=IOSTA1) INOELU
          IF (IOSTA1 .NE. 0) GOTO 11
 
          NBCONN = NBCONN + 1
 
C         Ajustement du segment MLIELE
          IF (NBCONN .GT. JELCON) THEN
            INCJCO = 2 * INCJCO
            JELCON = NBCONN + INCJCO
            SEGADJ,MLIELE
          ENDIF
 
C         Enregistrer la connectivité de l'élément et le nombre de noeuds
          MLIELE.ICONTO(NBCONN)= INOELU
          MLIELE.IELNBN(IDLU)  = MLIELE.IELNBN(IDLU)  + 1
          MRBE2.NELRBE(NBRBE2) = MRBE2.NELRBE(NBRBE2) + 1
 
          IF (NUMCOL .EQ. NCOLOL) THEN
 
C           Lecture d'une nouvelle ligne pour savoir si on continue a lire
            READ(IUNAS,1000,ERR=990,END=990) LIGNE
C            PRINT * ,'Nouvelle ligne : NBLIGN,'
            CALL LENCHA(LIGNE,ITLIGN)
            INDXE=INDEX(CARAOK,LIGNE(ITLIGN:ITLIGN))
            IF (INDXE .EQ. 0) LIGNE(ITLIGN:ITLIGN)=' '
            NBLIGN = NBLIGN + 1
 
C           Premiere lettre de la ligne
            IF ((LIGNE(1:1).EQ.' ') .OR. (LIGNE(1:1).EQ.'$')) GOTO 11
 
C           Premier mot de la ligne
            COLO8=LIGNE(1:8)
 
            IRETO2=0
C           Recherche dans le DATA des PROPERTY
            CALL PLACE(PROTYP,NPROPE            ,IRETO2,COLO8)
            IF (IRETO2 .NE. 0) THEN
              WRITE(IOIMP,*) 'PROPERTY non traitee : ',PROTYP(IRETO1)
              GOTO 11
            ENDIF
 
            IRETO2=0
C           Recherche dans le DATA des éléments géométriques
            CALL PLACE(GETYPE,NBGEO1,IRETO2,COLO8)
            IF (IRETO2.NE.0) GOTO 12
 
            IFIN   = 8
            NUMCOL = 0
          ENDIF
          GOTO 170
 
        ELSEIF ((IRETO1 .EQ. 5) .OR. (IRETO1 .EQ. 6)) THEN
C         Cas des ELEMENTS RBE3
          IF (NONLUE(IRETO1) .EQ. 0) THEN
            WRITE(IOIMP,*) 'Elements non traites : ',GETYPE(IRETO1)
            NONLUE(IRETO1)=1
          ENDIF
 
        ELSEIF ((IRETO1 .GE. 27) .AND. (IRETO1 .LE. 32)) THEN
C         Cas des ELEMENTS RBAR, CELAS2
          IF (NONLUE(IRETO1) .EQ. 0) THEN
            WRITE(IOIMP,*) 'Elements non traites : ',GETYPE(IRETO1)
            NONLUE(IRETO1)=1
          ENDIF
 
        ELSE
C         Cas des ELEMENTS Classiques
          NELTOT = NELTOT + 1
C         Ajustement du segment MLIELE
          IF(NELTOT .GT. JGELLO) THEN
            INCJGE = 2 * INCJGE
            JGELLO = NELTOT + INCJGE
            SEGADJ,MLIELE
          ENDIF
 
C         Lecture du numero d'element
C          PRINT *,'LIGNE(IDEB:IFIN):',LIGNE(IDEB:IFIN),':'
          READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IDLU
          IF (IOSTA1 .NE. 0) THEN
            moterr    ='READ (IOSTAT)'
            interr(1) = IOSTA1
            CALL ERREUR(873)
            RETURN
          ENDIF
 
C          PRINT *,' '
C          PRINT *,'ELEMENT :',IDLU, GETYPE(IRETO1),NELTOT
 
          IF (IDLU .GT. JGELLU) THEN
            INCJGE = 2 * INCJGE
            JGELLU = IDLU + INCJGE
            SEGADJ,MLIELE
          ENDIF
 
C         Enregistrement de la correspondance
          MLIELE.ICOREL(NELTOT)= IDLU
 
          IDEB = IFIN + 1
          IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
 
C         Lecture de la Property à laquelle appartient l'élément
C          PRINT *,'LIGNE(IDEB:IFIN):',LIGNE(IDEB:IFIN),':'
          READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IPLU
          IF (IOSTA1 .NE. 0) THEN
            moterr    ='READ (IOSTAT)'
            interr(1) = IOSTA1
            CALL ERREUR(873)
            RETURN
          ENDIF
          MLIELE.IDPROP(IDLU)=IPLU
 
C         Ajustement du SEGMENT MPROP
          DO IP=1,NBPROP
            IF (MPROP.ICOPRO(IP) .EQ. IPLU) GOTO 190
          ENDDO
          NBPROP = NBPROP + 1
          IP = NBPROP
          SEGADJ, MPROP
C          PRINT *,'NBR PROP =',NBPROP,IPLU
          SEGADJ,MLIELE
          MPROP.ICOPRO(NBPROP) = IPLU
 190      CONTINUE
 
C         Lecture de la connectivite
          NUMCOL = 2
C         Enregistrer ou débute la lecture de la connectivité
          MLIELE.IELCON(IDLU)=NBCONN+1
 200      CONTINUE
          IRETO2 = 0
          NUMCOL = NUMCOL + 1
          IDEB   = IFIN + 1
          IFIN   = IDEB + LCOL - 1
C          PRINT *,MLIELE.IELNBN(IDLU)+1,':',LIGNE(IDEB:IFIN),':'
          READ(LIGNE(IDEB:IFIN),*,ERR=200,IOSTAT=IOSTA1) INOELU
          IF (IOSTA1 .NE. 0) GOTO 13
 
          NBCONN = NBCONN + 1
 
C         Ajustement du segment MLIELE
          IF (NBCONN .GT. JELCON) THEN
            INCJCO = 2 * INCJCO
            JELCON = NBCONN + INCJCO
            SEGADJ,MLIELE
          ENDIF
 
C         Enregistrer la connectivité de l'élément et le nombre de noeuds
          MLIELE.ICONTO(NBCONN)=INOELU
          MLIELE.IELNBN(IDLU)  =MLIELE.IELNBN(IDLU) + 1
 
          IF (NUMCOL .EQ. NCOLOL) THEN
 
C           Lecture d'une nouvelle ligne pour savoir si on continue a lire
            READ(IUNAS,1000,ERR=990,END=990) LIGNE
C            PRINT * ,'Nouvelle ligne : NBLIGN,'
            CALL LENCHA(LIGNE,ITLIGN)
            INDXE=INDEX(CARAOK,LIGNE(ITLIGN:ITLIGN))
            IF (INDXE .EQ. 0) LIGNE(ITLIGN:ITLIGN)=' '
            NBLIGN = NBLIGN + 1
 
C           Premiere lettre de la ligne
            IF ((LIGNE(1:1).EQ.' ') .OR. (LIGNE(1:1).EQ.'$')) GOTO 13
 
C           Premier mot de la ligne
            COLO8=LIGNE(1:8)
 
            IRETO2 =0
            IRETO21=0
C           Recherche dans le DATA des PROPERTY
            CALL PLACE(PROTYP,NPROPE            ,IRETO21,COLO8)
            IF (IRETO21 .NE. 0) THEN
              WRITE(IOIMP,*) 'PROPERTY non traitee : ',PROTYP(IRETO21)
              GOTO 13
            ENDIF
 
C           Recherche dans le DATA des éléments géométriques
            CALL PLACE(GETYPE,NBGEO1,IRETO2,COLO8)
            IF (IRETO2.NE.0) GOTO 13
 
            IFIN   = 8
            NUMCOL = 0
          ENDIF
          GOTO 200
 
 13       CONTINUE
 
          IF (MLIELE.IELNBN(IDLU) .EQ. NBNOE1(IRETO1)) THEN
            MPROP.ITYPRO(IELEQ1(IRETO1),IP)=
     &         MPROP.ITYPRO(IELEQ1(IRETO1),IP) + 1
            MLIELE.IELTYP(IDLU)  = IELEQ1(IRETO1)
C            PRINT *,'Nombre de Noeuds :',MLIELE.IELNBN(IDLU),
C     &              IELEQ1(IRETO1),IP,MPROP.ITYPRO(IELEQ1(IRETO1),IP)
          ELSEIF(MLIELE.IELNBN(IDLU) .EQ. NBNOE2(IRETO1)) THEN
            MPROP.ITYPRO(IELEQ2(IRETO1),IP)=
     &         MPROP.ITYPRO(IELEQ2(IRETO1),IP) + 1
            MLIELE.IELTYP(IDLU)  = IELEQ2(IRETO1)
C            PRINT *,'Nombre de Noeuds :',MLIELE.IELNBN(IDLU),
C     &              IELEQ2(IRETO1),IP,MPROP.ITYPRO(IELEQ1(IRETO1),IP)
          ELSE
            CALL ERREUR(21)
            RETURN
          ENDIF
 
          IF (IRETO2 .NE. 0) THEN
            GOTO 12
          ELSE
            GOTO 11
          ENDIF
        ENDIF
 
      ELSEIF ((IRETO1 .GE. 33) .AND. (IRETO1 .LE. 38)) THEN
C       Cas des systemes de coordonnees locales
        IF    ((IRETO1 .EQ. 33) .OR. (IRETO1 .EQ. 34)) THEN
C         Repere Cartesien
          ITYPES=1
        ELSEIF((IRETO1 .EQ. 35) .OR. (IRETO1 .EQ. 36)) THEN
C         Repere Cylindrique
          ITYPES=2
        ELSEIF((IRETO1 .EQ. 37) .OR. (IRETO1 .EQ. 38)) THEN
C         Repere Spherique
          ITYPES=3
        ENDIF
 
C        PRINT *,':',GETYPE(IRETO1),':',LIGNE(IDEB:IFIN),':',IDEB
        READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IDLU
        IF (IOSTA1 .NE. 0) THEN
          moterr    ='READ (IOSTAT)'
          interr(1) = IOSTA1
          CALL ERREUR(873)
          RETURN
        ENDIF
 
        NBSYST = NBSYST + 1
 
C       Ajustement des SEGMENTS MLINOE et MCOORD
        IF( NBSYST .GT. JGSYST) THEN
          INCJSY = 2 * INCJSY
          JGSYST = JGSYST + INCJSY
          SEGADJ,MSYSTE
C          PRINT * ,'MSYSTE Ajustement intermediaire'
        ENDIF
 
        MSYSTE.IDSYST(NBSYST)=IDLU
        MSYSTE.ITYSYS(NBSYST)=ITYPES
 
C        PRINT *,IDLU,ITYPES,NBSYST
C       Lecture des 9 coordonnees du systeme
        NUMCOL = 1
        IDEB = IFIN + 1
        IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
        DO IFLOT=1,9
          NUMCOL = NUMCOL + 1
          IF (NUMCOL .EQ. NCOLOL) THEN
C           Lecture de la ligne suivante
            READ(IUNAS,1000,ERR=990,END=990) LIGNE
            CALL LENCHA(LIGNE,ITLIGN)
            INDXE=INDEX(CARAOK,LIGNE(ITLIGN:ITLIGN))
            IF (INDXE .EQ. 0) LIGNE(ITLIGN:ITLIGN)=' '
            NBLIGN = NBLIGN + 1
            IDEB = 8 + 1
            IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
            NUMCOL = 0
          ELSE
            IDEB = IFIN + 1
            IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
          ENDIF
 
C          PRINT *,':',LIGNE(IDEB:IFIN),':'
          READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) Flot1
          IF (IOSTA1 .NE. 0) THEN
            moterr    ='READ (IOSTAT)'
            interr(1) = IOSTA1
            CALL ERREUR(873)
            RETURN
          ENDIF
          MSYSTE.SYSCOR(IFLOT,NBSYST) = Flot1
 
C         Ajout du troisieme point par produit vectoriel
          IF (IFLOT .EQ. 9) THEN
            F11 = MSYSTE.SYSCOR(1,NBSYST)
            F12 = MSYSTE.SYSCOR(2,NBSYST)
            F13 = MSYSTE.SYSCOR(3,NBSYST)
 
            F21 = MSYSTE.SYSCOR(4,NBSYST)
            F22 = MSYSTE.SYSCOR(5,NBSYST)
            F23 = MSYSTE.SYSCOR(6,NBSYST)
 
            F31 = MSYSTE.SYSCOR(7,NBSYST)
            F32 = MSYSTE.SYSCOR(8,NBSYST)
            F33 = MSYSTE.SYSCOR(9,NBSYST)
 
            u1  = F21 - F11
            u2  = F22 - F12
            u3  = F23 - F13
 
            v1  = F31 - F11
            v2  = F32 - F12
            v3  = F33 - F13
 
            w1= u2*v3 - u3*v2
            w2= u3*v1 - u1*v3
            w3= u1*v2 - u2*v1
 
C           Je norme les vecteurs
            XL1  = SQRT(u1**2 + u2**2 + u3**2)
            XL2  = SQRT(v1**2 + v2**2 + v3**2)
            XL3  = SQRT(w1**2 + w2**2 + w3**2)
 
            MSYSTE.SCOOR2(7,NBSYST)  = u1/XL1
            MSYSTE.SCOOR2(8,NBSYST)  = u2/XL1
            MSYSTE.SCOOR2(9,NBSYST)  = u3/XL1
 
            MSYSTE.SCOOR2(4,NBSYST)  = v1/XL2
            MSYSTE.SCOOR2(5,NBSYST)  = v2/XL2
            MSYSTE.SCOOR2(6,NBSYST)  = v3/XL2
 
            MSYSTE.SCOOR2(1,NBSYST)  = w1/XL3
            MSYSTE.SCOOR2(2,NBSYST)  = w2/XL3
            MSYSTE.SCOOR2(3,NBSYST)  = w3/XL3
 
C            F21 = (u1/XL1) + F11
C            F22 = (u2/XL1) + F12
C            F23 = (u3/XL1) + F13
C
C            F31 = (v1/XL2) + F11
C            F32 = (v2/XL2) + F12
C            F33 = (v3/XL2) + F13
C
            F41 = (w1/(MAX(XL1,XL2))) + F11
            F42 = (w2/(MAX(XL1,XL2))) + F12
            F43 = (w3/(MAX(XL1,XL2))) + F13
C
C            MSYSTE.SYSCOR(4 ,NBSYST) = F21
C            MSYSTE.SYSCOR(5 ,NBSYST) = F22
C            MSYSTE.SYSCOR(6 ,NBSYST) = F23
C
C            MSYSTE.SYSCOR(7 ,NBSYST) = F31
C            MSYSTE.SYSCOR(8 ,NBSYST) = F32
C            MSYSTE.SYSCOR(9 ,NBSYST) = F33
C
            MSYSTE.SYSCOR(10,NBSYST) = F41
            MSYSTE.SYSCOR(11,NBSYST) = F42
            MSYSTE.SYSCOR(12,NBSYST) = F43
 
C            PRINT *,u1 ,u2 ,u3
C            PRINT *,v1 ,v2 ,v3
C            PRINT *,w1 ,w2 ,w3
C
C            PRINT *,'XL1,XL2,XL3',XL1,XL2,XL3
C            PRINT *,F11 ,F12 ,F13
C            PRINT *,F21 ,F22 ,F23
C            PRINT *,F31 ,F32 ,F33
C            PRINT *,F41, F42, F43
          ENDIF
        ENDDO
      ELSEIF ((IRETO1 .GE. 39) .AND. (IRETO1 .LE. 42)) THEN
C       Cas des SPC et SPCD
        READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IDLU
        IF (IOSTA1 .NE. 0) THEN
          moterr    ='READ (IOSTAT)'
          interr(1) = IOSTA1
          CALL ERREUR(873)
          RETURN
        ENDIF
C        PRINT *, GETYPE(IRETO1),IDLU,(IRETO1 - (NBGEO1+NBSY) + 1)/2
        NBSPC = NBSPC + 1
 
        IF (NBSPC .GT. JGSPC) THEN
          INCSPC = 2 * INCSPC
          JGSPC  = JGSPC + INCSPC
          SEGADJ, MSPC
        ENDIF
 
        DO IDVU=1,NBSDIF
          IF (IDLU .EQ. MSPC.ILISPC(IDVU)) GOTO 301
        ENDDO
 
        NBSDIF = NBSDIF + 1
        IDVU   = NBSDIF
        SEGADJ,MSPC
        MSPC.ILISPC(NBSDIF)=IDLU
 
 301    CONTINUE
        MSPC.NBESPC(IDVU) =MSPC.NBESPC(IDVU) + 1
        MSPC.ICOSPC(NBSPC)=IDVU
        IDEB = IFIN + 1
        IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
        READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) INOLU
        IF (IOSTA1 .NE. 0) THEN
          moterr    ='READ (IOSTAT)'
          interr(1) = IOSTA1
          CALL ERREUR(873)
          RETURN
        ENDIF
 
C       Determination du HashCode des SPC
        IDEB = IFIN + 1
        IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
        READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IBLOQ
        IF (IOSTA1 .NE. 0) THEN
          moterr    ='READ (IOSTAT)'
          interr(1) = IOSTA1
          CALL ERREUR(873)
          RETURN
        ENDIF
        IPOS1 = MIN(MAX(INDEX(LIGNE(IDEB:IFIN),'1') - 10,0),1)
        IPOS2 = MIN(MAX(INDEX(LIGNE(IDEB:IFIN),'2') - 10,0),1)
        IPOS3 = MIN(MAX(INDEX(LIGNE(IDEB:IFIN),'3') - 10,0),1)
        IPOS4 = MIN(MAX(INDEX(LIGNE(IDEB:IFIN),'4') - 10,0),1)
        IPOS5 = MIN(MAX(INDEX(LIGNE(IDEB:IFIN),'5') - 10,0),1)
        IPOS6 = MIN(MAX(INDEX(LIGNE(IDEB:IFIN),'6') - 10,0),1)
 
        IHCODE=IPOS1*(2**5) + IPOS2*(2**4) + IPOS3*(2**3) +
     &         IPOS4*(2**2) + IPOS5*(2)    + IPOS6
 
        IDEB = IFIN + 1
        IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
        READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) FLOT1
        IF (IOSTA1 .NE. 0) THEN
          moterr    ='READ (IOSTAT)'
          interr(1) = IOSTA1
          CALL ERREUR(873)
          RETURN
        ENDIF
 
        MSPC.IDSPC (NBSPC)=IDLU
        MSPC.INOSPC(NBSPC)=INOLU
        MSPC.IBLOLU(NBSPC)=IBLOQ
        MSPC.IHASHS(NBSPC)=IHCODE
        MSPC.XSPC  (NBSPC)=FLOT1
C        PRINT *,IDLU,INOLU,IBLOQ,FLOT1,NBSDIF
 
      ELSEIF ((IRETO1 .EQ. 43) .OR.  (IRETO1 .EQ. 44)) THEN
C       Cas des LOAD
        IF (NONLUE(IRETO1) .EQ. 0) THEN
          WRITE(IOIMP,*) 'Carte Non lue : ',GETYPE(IRETO1)
          NONLUE(IRETO1)=1
        ENDIF
 
      ELSEIF ((IRETO1 .EQ. 45) .OR.  (IRETO1 .EQ. 46)) THEN
C       Cas des PLOAD
        IF (NONLUE(IRETO1) .EQ. 0) THEN
          WRITE(IOIMP,*) 'Carte Non lue : ',GETYPE(IRETO1)
          NONLUE(IRETO1)=1
        ENDIF
 
      ELSEIF ((IRETO1 .EQ. 47) .OR.  (IRETO1 .EQ. 48)) THEN
C       Cas des PLOAD1
        IF (NONLUE(IRETO1) .EQ. 0) THEN
          WRITE(IOIMP,*) 'Carte Non lue : ',GETYPE(IRETO1)
          NONLUE(IRETO1)=1
        ENDIF
 
      ELSEIF ((IRETO1 .EQ. 49) .OR.  (IRETO1 .EQ. 50)) THEN
C       Cas des PLOAD2
        IF (NONLUE(IRETO1) .EQ. 0) THEN
          WRITE(IOIMP,*) 'Carte Non lue : ',GETYPE(IRETO1)
          NONLUE(IRETO1)=1
        ENDIF
 
      ELSEIF ((IRETO1 .EQ. 51) .OR.  (IRETO1 .EQ. 52)) THEN
C       Cas des PLOAD4
        IF (NONLUE(IRETO1) .EQ. 0) THEN
          WRITE(IOIMP,*) 'Carte Non lue : ',GETYPE(IRETO1)
          NONLUE(IRETO1)=1
        ENDIF
 
      ELSEIF ((IRETO1 .EQ. 53) .OR.  (IRETO1 .EQ. 54)) THEN
C       Cas des FORCE
        READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IDLU
        IF (IOSTA1 .NE. 0) THEN
          moterr    ='READ (IOSTAT)'
          interr(1) = IOSTA1
          CALL ERREUR(873)
          RETURN
        ENDIF
C        PRINT *, GETYPE(IRETO1),IDLU,(IRETO1 - (NBGEO1+NBSY) + 1)/2
        NBFORC = NBFORC + 1
 
        IF (NBFORC .GT. JGFORC) THEN
          INCFOR = 2 * INCFOR
          JGFORC  = JGFORC + INCFOR
          SEGADJ, MFORCE
        ENDIF
 
        DO IDVU=1,NBFDIF
          IF (IDLU .EQ. MFORCE.ILIFOR(IDVU)) GOTO 303
        ENDDO
 
        NBFDIF = NBFDIF + 1
        IDVU   = NBFDIF
        SEGADJ,MFORCE
        MFORCE.ILIFOR(NBFDIF)=IDLU
 
 303    CONTINUE
        MFORCE.NBEFOR(IDVU  )=MFORCE.NBEFOR(IDVU) + 1
        MFORCE.ICOFOR(NBFORC)=IDVU
        IDEB = IFIN + 1
        IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
        READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) INOLU
        IF (IOSTA1 .NE. 0) THEN
          moterr    ='READ (IOSTAT)'
          interr(1) = IOSTA1
          CALL ERREUR(873)
          RETURN
        ENDIF
 
        IDEB = IFIN + 1
        IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
        READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IDSYS
        IF (IOSTA1 .NE. 0) IDSYS = 0
 
        IDEB = IFIN + 1
        IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
        READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) FLOT1
        IF (IOSTA1 .NE. 0) THEN
          moterr    ='READ (IOSTAT)'
          interr(1) = IOSTA1
          CALL ERREUR(873)
          RETURN
        ENDIF
 
        IF (PRECID) THEN
C         Lecture d'une nouvelle ligne pour savoir si on continue a lire
          READ(IUNAS,1000,ERR=990,END=990) LIGNE
C          PRINT * ,'Nouvelle ligne : NBLIGN,'
          CALL LENCHA(LIGNE,ITLIGN)
          INDXE=INDEX(CARAOK,LIGNE(ITLIGN:ITLIGN))
          IF (INDXE .EQ. 0) LIGNE(ITLIGN:ITLIGN)=' '
          NBLIGN = NBLIGN + 1
          IFIN   = 8
        ENDIF
 
        MFORCE.IDFORC(NBFORC)=IDLU
        MFORCE.INOFOR(NBFORC)=INOLU
        DO IFO=1,3
          IDEB = IFIN + 1
          IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
          READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) FLOT2
          IF (IOSTA1 .NE. 0) THEN
            moterr    ='READ (IOSTAT)'
            interr(1) = IOSTA1
            CALL ERREUR(873)
            RETURN
          ENDIF
          MFORCE.XFORCE(IFO,NBFORC)=FLOT2*FLOT1
        ENDDO
C        PRINT *,IDLU,INOLU,IDSYS,NBFDIF
 
C       Passage dans le repère général
        IF (IDSYS.NE.0) THEN
          DO NUMSYS=1,NBSYST
            IF(MSYSTE.IDSYST(NUMSYS) .EQ. IDSYS) GOTO 304
          ENDDO
          WRITE(IOIMP,*) 'On n''a pas lu le repere d''ID:',IDSYS
          CALL ERREUR(21)
          RETURN
 
 304      CONTINUE
          ITYPES = MSYSTE.ITYSYS(NUMSYS)
C          PRINT *,'Type de repere', ITYPES, NUMSYS
          XFL(1) = REAL(0.D0)
          XFL(2) = REAL(0.D0)
          XFL(3) = REAL(0.D0)
          NUMPTS = MLINOE.ICORNO(INOLU)
          j=(NBANC+NUMPTS-1)*idimp1
          IF     (ITYPES .EQ. 1) THEN
C           Transformation Cartesienne
C           Le X lu devient mon Y
            XLU=MFORCE.XFORCE(1,NBFORC)
            MFORCE.XFORCE(1,NBFORC)=MFORCE.XFORCE(2,NBFORC)
            MFORCE.XFORCE(2,NBFORC)=XLU
 
          ELSEIF (ITYPES .EQ. 2) THEN
C           Transformation Cylindrique
            WRITE(IOIMP,*) 'Repere Cylindrique non supporte: IDFORCE,',
     &      ' Noeud, Ligne',IDLU,INOLU,NBLIGN
            GOTO 11
 
          ELSEIF (ITYPES .EQ. 3) THEN
C           Transformation Spherique
            WRITE(IOIMP,*) 'Repere Spherique   non supporte: IDFORCE,',
     &      ' Noeud, Ligne',IDLU,INOLU,NBLIGN
            GOTO 11
 
          ELSE
            WRITE(IOIMP,*) 'Systeme de type inconnu :',ITYPES
            CALL ERREUR(21)
            RETURN
          ENDIF
 
C         Passage en coordonnées X,Y,Z centrées sur le repère Local
          DO III=1,3
            DO IFLOT=1,3
              Flot = MFORCE.XFORCE(IFLOT,NBFORC)
              INDICE=(III-1)*3 + IFLOT
              XFL(III)=XFL(III)+ MSYSTE.SCOOR2(INDICE,NUMSYS)*Flot
C              PRINT *,INDICE,SYSCOR(INDICE,NUMSYS),Flot,XFL(III)
            ENDDO
          ENDDO
 
C         Remplacement dans MFORCE
          DO IFLOT=1,3
C           Remplacement dans MFORCE
            MFORCE.XFORCE(IFLOT,NBFORC)=XFL(IFLOT)
          ENDDO
        ENDIF
 
      ELSEIF ((IRETO1 .EQ. 55) .OR.  (IRETO1 .EQ. 56)) THEN
C       Cas des MOMENT
        READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IDLU
        IF (IOSTA1 .NE. 0) THEN
          moterr    ='READ (IOSTAT)'
          interr(1) = IOSTA1
          CALL ERREUR(873)
          RETURN
        ENDIF
C        PRINT *, GETYPE(IRETO1),IDLU,(IRETO1 - (NBGEO1+NBSY) + 1)/2
        NBMOME = NBMOME + 1
 
        IF (NBMOME .GT. JGMOME) THEN
          INCMOM = 2 * INCMOM
          JGMOME  = JGMOME + INCMOM
          SEGADJ, MMOMEN
        ENDIF
 
        DO IDVU=1,NBMDIF
          IF (IDLU .EQ. MMOMEN.ILIMOM(IDVU)) GOTO 305
        ENDDO
 
        NBMDIF = NBMDIF + 1
        IDVU   = NBMDIF
        SEGADJ,MMOMEN
        MMOMEN.ILIMOM(NBMDIF)=IDLU
 
 305    CONTINUE
        MMOMEN.NBEMOM(IDVU  )=MMOMEN.NBEMOM(IDVU) + 1
        MMOMEN.ICOMOM(NBMOME)=IDVU
        IDEB = IFIN + 1
        IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
        READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) INOLU
        IF (IOSTA1 .NE. 0) THEN
          moterr    ='READ (IOSTAT)'
          interr(1) = IOSTA1
          CALL ERREUR(873)
          RETURN
        ENDIF
 
        IDEB = IFIN + 1
        IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
        READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IDSYS
        IF (IOSTA1 .NE. 0) IDSYS = 0
 
        IDEB = IFIN + 1
        IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
        READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) FLOT1
        IF (IOSTA1 .NE. 0) THEN
          moterr    ='READ (IOSTAT)'
          interr(1) = IOSTA1
          CALL ERREUR(873)
          RETURN
        ENDIF
 
        IF (PRECID) THEN
C         Lecture d'une nouvelle ligne pour savoir si on continue a lire
          READ(IUNAS,1000,ERR=990,END=990) LIGNE
C          PRINT * ,'Nouvelle ligne : NBLIGN,'
          CALL LENCHA(LIGNE,ITLIGN)
          INDXE=INDEX(CARAOK,LIGNE(ITLIGN:ITLIGN))
          IF (INDXE .EQ. 0) LIGNE(ITLIGN:ITLIGN)=' '
          NBLIGN = NBLIGN + 1
          IFIN   = 8
        ENDIF
 
        MMOMEN.IDMOME(NBMOME)=IDLU
        MMOMEN.INOMOM(NBMOME)=INOLU
        DO IFO=1,3
          IDEB = IFIN + 1
          IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
          READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) FLOT2
          IF (IOSTA1 .NE. 0) THEN
            moterr    ='READ (IOSTAT)'
            interr(1) = IOSTA1
            CALL ERREUR(873)
            RETURN
          ENDIF
          MMOMEN.XMOMEN(IFO,NBMOME)=FLOT2*FLOT1
        ENDDO
C        PRINT *,IDLU,INOLU,IDSYS,NBMDIF
 
C       Passage dans le repère général
        IF (IDSYS.NE.0) THEN
          DO NUMSYS=1,NBSYST
            IF(MSYSTE.IDSYST(NUMSYS) .EQ. IDSYS) GOTO 306
          ENDDO
          WRITE(IOIMP,*) 'On n''a pas lu le repere d''ID:',IDSYS
          CALL ERREUR(21)
          RETURN
 
 306      CONTINUE
          ITYPES = MSYSTE.ITYSYS(NUMSYS)
C          PRINT *,'Type de repere', ITYPES, NUMSYS
          XFL(1) = REAL(0.D0)
          XFL(2) = REAL(0.D0)
          XFL(3) = REAL(0.D0)
          NUMPTS = MLINOE.ICORNO(INOLU)
          j=(NBANC+NUMPTS-1)*idimp1
          IF     (ITYPES .EQ. 1) THEN
C           Transformation Cartesienne
C           Le X lu devient mon Y
            XLU=MMOMEN.XMOMEN(1,NBMOME)
            MMOMEN.XMOMEN(1,NBMOME)=MMOMEN.XMOMEN(2,NBMOME)
            MMOMEN.XMOMEN(2,NBMOME)=XLU
 
          ELSEIF (ITYPES .EQ. 2) THEN
C           Transformation Cylindrique
            WRITE(IOIMP,*) 'Repere Cylindrique non supporte:MOMENT, ',
     &      'Noeud',IDLU,INOLU,NBLIGN
            GOTO 11
 
          ELSEIF (ITYPES .EQ. 3) THEN
C           Transformation Spherique
            WRITE(IOIMP,*) 'Repere Spherique   non supporte:MOMENT, ',
     &      'Noeud',IDLU,INOLU,NBLIGN
            GOTO 11
 
          ELSE
            WRITE(IOIMP,*) 'Systeme de type inconnu :',ITYPES
            CALL ERREUR(21)
            RETURN
          ENDIF
 
C         Passage en coordonnées X,Y,Z centrées sur le repère Local
          DO III=1,3
            DO IFLOT=1,3
              Flot = MMOMEN.XMOMEN(IFLOT,NBMOME)
              INDICE=(III-1)*3 + IFLOT
              XFL(III)=XFL(III)+ MSYSTE.SCOOR2(INDICE,NUMSYS)*Flot
C              PRINT *,INDICE,SYSCOR(INDICE,NUMSYS),Flot,XFL(III)
            ENDDO
          ENDDO
 
C         Remplacement dans MMOMEN
          DO IFLOT=1,3
C           Remplacement dans MMOMEN
            MMOMEN.XMOMEN(IFLOT,NBMOME)=XFL(IFLOT)
          ENDDO
        ENDIF
 
      ELSEIF ((IRETO1 .EQ. 57) .OR.  (IRETO1 .EQ. 58)) THEN
C       Cas des TEMPERATURES
        READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) IDLU
        IF (IOSTA1 .NE. 0) THEN
          moterr    ='READ (IOSTAT)'
          interr(1) = IOSTA1
          CALL ERREUR(873)
          RETURN
        ENDIF
C        PRINT *, GETYPE(IRETO1),IDLU,(IRETO1 - (NBGEO1+NBSY) + 1)/2
        NBTEMP = NBTEMP + 1
 
        IF (NBTEMP .GT. JGTEMP) THEN
          INCTEM = 2 * INCTEM
          JGTEMP  = JGTEMP + INCTEM
          SEGADJ, MTEMP
        ENDIF
 
        DO IDVU=1,NBTDIF
          IF (IDLU .EQ. MTEMP.ILITEM(IDVU)) GOTO 302
        ENDDO
 
        NBTDIF = NBTDIF + 1
        IDVU   = NBTDIF
        SEGADJ,MTEMP
        MTEMP.ILITEM(NBTDIF)=IDLU
 
 302    CONTINUE
        MTEMP.NBETEM(IDVU  )=MTEMP.NBETEM(IDVU) + 1
        MTEMP.ICOTEM(NBTEMP)=IDVU
        IDEB = IFIN + 1
        IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
        READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) INOLU
        IF (IOSTA1 .NE. 0) THEN
          moterr    ='READ (IOSTAT)'
          interr(1) = IOSTA1
          CALL ERREUR(873)
          RETURN
        ENDIF
 
        IDEB = IFIN + 1
        IFIN = MIN(IDEB + LCOL - 1,ITLIGN)
        READ(LIGNE(IDEB:IFIN),*,ERR=11,IOSTAT=IOSTA1) FLOT1
        IF (IOSTA1 .NE. 0) THEN
          moterr    ='READ (IOSTAT)'
          interr(1) = IOSTA1
          CALL ERREUR(873)
          RETURN
        ENDIF
 
        MTEMP.IDTEMP(NBTEMP)=IDLU
        MTEMP.INOTEM(NBTEMP)=INOLU
        MTEMP.XTEMP (NBTEMP)=FLOT1
C        PRINT *,IDLU,INOLU,FLOT1,NBTDIF
      ENDIF
      GOTO 11
 
 
C***********************************************************************
C      Fermeture du fichier en lecture
C***********************************************************************
 990  CONTINUE
      CLOSE(UNIT=IUNAS,ERR=991)
 
C     Ajustement du segment MCOORD
      IF (NBNPTS .LT. JGNOLO) THEN
        JGNOLO=NBNPTS
        NBPTS=NBANC+JGNOLO
        SEGADJ,MCOORD
      ENDIF
 
C***********************************************************************
C      Creation des MAILLAGES par ID de PROPERTY
C***********************************************************************
C      PRINT *,'RECOMPOSITION DES MAILLAGES', NBPROP
      IF (NBPROP .GT. 0) THEN
        M=NBPROP
        SEGINI,MTAB1
 
C       Ecriture dans la table de Sortie de la TABLE MAILLAGES
        COLO80='MAILLAGES'
        CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,COLO80    ,.FALSE.,0,
     &                     'TABLE   ',0,0.d0,'RIEN',.FALSE.,MTAB1)
        IF (IERR.NE.0) RETURN
      ENDIF
 
      DO IP=1,NBPROP
        NBMAIL=0
 
        NBNN  =0
        NBELEM=0
        NBSOUS=100
        NBREF =0
        SEGINI,MELEME
        MPROP.IMELCO(IP)=MELEME
        DO ITY=1,100
          IF (MPROP.ITYPRO(ITY,IP) .GT. 0) THEN
            NBMAIL= NBMAIL + 1
            NBNN  = NBNNE(ITY)
            NBELEM= MPROP.ITYPRO(ITY,IP)
            NBSOUS= 0
            NBREF = 0
            SEGINI,IPT1
            IPT1.ITYPEL=ITY
            MPROP.IMELSI(ITY,IP)=IPT1
            MELEME.LISOUS(NBMAIL)=IPT1
C            PRINT *, IP, MPROP.ITYPRO(ITY,IP), NOMS(ITY), NBNNE(ITY)
          ENDIF
        ENDDO
        III=MELEME
        NBSOUS=NBMAIL
        IF (NBSOUS .EQ. 1) THEN
          SEGSUP,MELEME
          MPROP.IMELCO(IP)=IPT1
          MELEME=IPT1
        ELSE
          NBNN  =0
          NBELEM=0
          NBREF =0
          SEGADJ,MELEME
          SEGDES,MELEME
        ENDIF
 
C       Ecriture dans la table MAILLAGES
        IPROP = MPROP.ICOPRO(IP)
        CALL ECCTAB(MTAB1 ,'ENTIER  ',IPROP,0.d0,'RIEN',.FALSE.,0,
     &                     'MAILLAGE',0    ,0.d0,'RIEN',.FALSE.,MELEME)
        IF (IERR.NE.0) RETURN
      ENDDO
 
      IF (NBPROP .GT. 0) SEGDES,MTAB1
 
C***********************************************************************
C      Creation des MAILLAGES par type de RBE2
C***********************************************************************
      IF (NBRBE2 .GT. 0) THEN
        M=NBRBE2
        SEGINI,MTAB2
 
C       Ecriture dans la table de Sortie de la TABLE RBE2
        COLO80='RBE2'
        CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,COLO80    ,.FALSE.,0,
     &                     'TABLE   ',0,0.d0,'RIEN',.FALSE.,MTAB2)
        IF (IERR.NE.0) RETURN
      ENDIF
 
      DO NURBE2=1,NBRBE2
C        PRINT *,NURBE2,MRBE2.NELRBE(NURBE2)+1
 
        NBNN  =1
        NBELEM=MRBE2.NELRBE(NURBE2)+1
        NBSOUS=0
        NBREF =0
        SEGINI,MELEME
        MELEME.ITYPEL=1
        MRBE2.IMELRB(NURBE2) = MELEME
 
C       Ecriture dans la table RBE2
        M=2
        SEGINI,MTAB3
        CALL ECCTAB(MTAB3 ,'MOT     ',0 ,0.d0,'MAILLAGE',.FALSE.,0,
     &                     'MAILLAGE',0 ,0.d0,'RIEN    ',.FALSE.,MELEME)
        IF (IERR.NE.0) RETURN
        IBLOQ = MRBE2.IBLRBE(NURBE2)
C        PRINT *,'NURBE2,IBLOQ',NURBE2,IBLOQ
        CALL ECCTAB(MTAB3 ,'MOT     ',0     ,0.d0,'HASHCODE',.FALSE.,0,
     &                     'ENTIER  ',IBLOQ ,0.d0,'RIEN    ',.FALSE.,0)
        IF (IERR.NE.0) RETURN
        SEGDES,MTAB3
 
        CALL ECCTAB(MTAB2 ,'ENTIER  ',NURBE2,0.d0,'MAILLAGE',.FALSE.,0,
     &                     'TABLE   ',0  ,0.d0,'RIEN    ',.FALSE.,MTAB3)
        IF (IERR.NE.0) RETURN
      ENDDO
      IF (NBRBE2 .GT. 0) SEGDES,MTAB2
 
C***********************************************************************
C      Remplissage des MAILLAGES
C***********************************************************************
      DO 299 IELEM=1,NELTOT
        IDELEM = MLIELE.ICOREL(IELEM)
        IDCONN = MLIELE.IELCON(IDELEM)
        IDTYPE = MLIELE.IELTYP(IDELEM)
        IPLU   = MLIELE.IDPROP(IDELEM)
 
        ITYP2 = 0
        COLO4 = NOMS(IDTYPE)
C       Recherche dans le DATA des éléments géométriques
        CALL PLACE(CTYPE,NBGEO2,ITYP2,COLO4)
 
C        PRINT *,NOMS(IDTYPE),ITYP2
        IF (MLIELE.IRBE2(IDELEM) .NE. 0) THEN
C         Traitement des RBE2
          NURBE2 = MLIELE.IDPROP(IDELEM)
          IPT1   = MRBE2.IMELRB(NURBE2)
          NBNN   = IPT1.NUM(/1)
          NBELEM = IPT1.NUM(/2)
 
C         Reconstitution de la Connectivite
          DO IEL = 1,NBELEM
            NUMEL  = NBELEM - MRBE2.NELRBE(NURBE2)
            IDCOLU = ICONTO(IDCONN+(IEL - 1))
            IDCOCA = MLINOE.ICORNO(IDCOLU)+NBANC
C            PRINT *,NUMEL,IDCOLU,NBELEM
 
            MRBE2.NELRBE(NURBE2) =  MRBE2.NELRBE(NURBE2) - 1
            IPT1.NUM(1,NUMEL) = IDCOCA
          ENDDO
          IF (NUMEL .EQ. NBELEM) THEN
            SEGDES, IPT1
C            PRINT *,'SEGDES,IPT1',IPT1
          ENDIF
 
        ELSE
C         Traitement des Elements classiques
          DO IPLO=1,NBPROP
C           Recherche de la Property qui a le même ID
            IF (MPROP.ICOPRO(IPLO) .EQ. IPLU) GOTO 300
          ENDDO
          WRITE(IOIMP,*) 'Aucune Property n''a ete trouvee...'
          CALL ERREUR(21)
          RETURN
 
 300      CONTINUE
          MELEME= MPROP.IMELCO(IPLO)
C          PRINT *,MELEME,IDTYPE,IPLO,IPLU,IDELEM
          IPT1  = MPROP.IMELSI(IDTYPE,IPLO)
          NBNN  = IPT1.NUM(/1)
          NBELEM= IPT1.NUM(/2)
          NUMEL = MPROP.NBELPR(IDTYPE,IPLO) + 1
          MPROP.NBELPR(IDTYPE,IPLO) = NUMEL
 
 
C         Reconstitution de la Connectivite
C          PRINT *,NOMS(IDTYPE),IDELEM,IPLU,IPLO
          DO INOEUD=1,NBNN
            ITEST  = IORDCO(20* (ITYP2-1) + INOEUD)
            IDCOLU = ICONTO(IDCONN+(ITEST-1))
            IDCOCA = MLINOE.ICORNO(IDCOLU)+NBANC
            IPT1.NUM(INOEUD,NUMEL) = IDCOCA
C            PRINT *,'INOEUD',IDCOLU,IDCOCA
          ENDDO
          IF (NUMEL .EQ. NBELEM) THEN
            SEGDES, IPT1
C          PRINT *,'SEGDES, MELEME classique',IPT1
          ENDIF
        ENDIF
 299  CONTINUE
 
C***********************************************************************
C      Generation des MELEME pour les SPC
C***********************************************************************
      IF (NBSDIF .GT. 0) THEN
        M=NBSDIF
        SEGINI,MTAB1
 
C       Ecriture dans la table de Sortie de la TABLE BLOCAGES
        COLO80='BLOCAGES'
        CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,COLO80    ,.FALSE.,0,
     &                     'TABLE   ',0,0.d0,'RIEN',.FALSE.,MTAB1)
        IF (IERR.NE.0) RETURN
      ENDIF
 
      DO ISPC=1,NBSDIF
        NBMAIL=0
 
        NBNN  =1
        NBELEM=MSPC.NBESPC(ISPC)
        NBSOUS=0
        NBREF =0
        SEGINI,MELEME
        MELEME.ITYPEL=1
        MSPC.IMELSP(ISPC)=MELEME
 
C       Ecriture dans la table BLOCAGES
        IDS = MSPC.ILISPC(ISPC)
        CALL ECCTAB(MTAB1 ,'ENTIER  ',IDS  ,0.d0,'RIEN',.FALSE.,0,
     &                     'MAILLAGE',0    ,0.d0,'RIEN',.FALSE.,MELEME)
        IF (IERR.NE.0) RETURN
      ENDDO
 
      IF (NBSDIF .GT. 0) SEGDES,MTAB1
 
      DO IELEM = 1,NBSPC
        IDIF   = MSPC.ICOSPC(IELEM)
        IDNOLU = MSPC.INOSPC(IELEM)
        IF(IDNOLU .EQ. 0)THEN
          CALL ERREUR(1064)
          RETURN
        ENDIF
        MELEME = MSPC.IMELSP(IDIF)
        NBNN   = MELEME.NUM(/1)
        NBELEM = MELEME.NUM(/2)
        NUMEL  = NBELEM - MSPC.NBESPC(IDIF) + 1
        MSPC.NBESPC(IDIF) = MSPC.NBESPC(IDIF) - 1
        IDCOCA = MLINOE.ICORNO(IDNOLU)+NBANC
C        PRINT *,IDIF,IDNOLU,IDCOCA,XCOOR(/1)/idimp1
        MELEME.NUM(1,NUMEL) = IDCOCA
        IF (NUMEL .EQ. NBELEM) THEN
          SEGDES, MELEME
C          PRINT *,'SEGDES, MELEME, BLOCAGES',MELEME
        ENDIF
      ENDDO
 
C***********************************************************************
C      Generation des CHPOINT pour les FORCES
C***********************************************************************
      IF (NBFDIF .GT. 0) THEN
        M=NBFDIF
        SEGINI,MTAB1
 
C       Ecriture dans la table de Sortie de la TABLE FORCES
        COLO80='FORCES'
        CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,COLO80    ,.FALSE.,0,
     &                     'TABLE   ',0,0.d0,'RIEN',.FALSE.,MTAB1)
        IF (IERR.NE.0) RETURN
      ENDIF
 
      DO IFOR=1,NBFDIF
        NNIN = 3
        NNNOE= MFORCE.NBEFOR(IFOR)
        SEGINI,MTRAV
        ITRAV = MTRAV
        MTRAV.INCO(1)='FX  '
        MTRAV.INCO(2)='FY  '
        MTRAV.INCO(3)='FZ  '
 
        DO IELEM = 1,NBFORC
          IF (MFORCE.IDFORC(IELEM) .EQ. MFORCE.ILIFOR(IFOR)) THEN
            IDNOLU = MFORCE.INOFOR(IELEM)
            IDCOCA = MLINOE.ICORNO(IDNOLU)+NBANC
            DO IVAL=1,3
              XVAL  = MFORCE.XFORCE(IVAL,IELEM)
              MTRAV.BB  (IVAL,NNNOE) = XVAL
              MTRAV.IBIN(IVAL,NNNOE) = 1
            ENDDO
            MTRAV.IGEO(  NNNOE) = IDCOCA
            NNNOE = NNNOE - 1
            IF (NNNOE .EQ. 0) THEN
              CALL CRECHP(ITRAV,ICHPO1)
C             PRINT *,'SEGSUP,MTRAV',MTRAV
              SEGSUP,MTRAV
C             Ecriture dans la table FORCES
              IDT = MFORCE.ILIFOR(IFOR)
              CALL ECCTAB(MTAB1 ,'ENTIER  ',IDT  ,0.d0,'RIEN',.FALSE.,0,
     &                      'CHPOINT ',0    ,0.d0,'RIEN',.FALSE.,ICHPO1)
              IF (IERR.NE.0) RETURN
            ENDIF
          ENDIF
        ENDDO
      ENDDO
 
      IF (NBFORC .GT. 0) SEGDES,MTAB1
 
 
C***********************************************************************
C      Generation des CHPOINT pour les MOMENTS
C***********************************************************************
      IF (NBMDIF .GT. 0) THEN
        M=NBMDIF
        SEGINI,MTAB1
 
C       Ecriture dans la table de Sortie de la TABLE MOMENTS
        COLO80='MOMENTS'
        CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,COLO80    ,.FALSE.,0,
     &                     'TABLE   ',0,0.d0,'RIEN',.FALSE.,MTAB1)
        IF (IERR.NE.0) RETURN
      ENDIF
 
      DO IMOM=1,NBMDIF
        NNIN = 3
        NNNOE= MMOMEN.NBEMOM(IMOM)
        SEGINI,MTRAV
        ITRAV = MTRAV
        MTRAV.INCO(1)='MX  '
        MTRAV.INCO(2)='MY  '
        MTRAV.INCO(3)='MZ  '
 
        DO IELEM = 1,NBFORC
          IF (MMOMEN.IDMOME(IELEM) .EQ. MMOMEN.ILIMOM(IMOM)) THEN
            IDNOLU = MMOMEN.INOMOM(IELEM)
            IDCOCA = MLINOE.ICORNO(IDNOLU)+NBANC
            DO IVAL=1,3
              XVAL  = MMOMEN.XMOMEN(IVAL,IELEM)
              MTRAV.BB  (IVAL,NNNOE) = XVAL
              MTRAV.IBIN(IVAL,NNNOE) = 1
            ENDDO
            MTRAV.IGEO(  NNNOE) = IDCOCA
            NNNOE = NNNOE - 1
            IF (NNNOE .EQ. 0) THEN
              CALL CRECHP(ITRAV,ICHPO1)
C             PRINT *,'SEGSUP,MTRAV',MTRAV
              SEGSUP,MTRAV
C             Ecriture dans la table MOMENTS
              IDT = MMOMEN.ILIMOM(IMOM)
              CALL ECCTAB(MTAB1 ,'ENTIER  ',IDT  ,0.d0,'RIEN',.FALSE.,0,
     &                      'CHPOINT ',0    ,0.d0,'RIEN',.FALSE.,ICHPO1)
              IF (IERR.NE.0) RETURN
            ENDIF
          ENDIF
        ENDDO
      ENDDO
 
      IF (NBFORC .GT. 0) SEGDES,MTAB1
 
C***********************************************************************
C      Generation des CHPOINT pour les TEMPERATURE
C***********************************************************************
      IF (NBTDIF .GT. 0) THEN
        M=NBTDIF
        SEGINI,MTAB1
 
C       Ecriture dans la table de Sortie de la TABLE TEMPERATURES
        COLO80='TEMPERATURES'
        CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,COLO80    ,.FALSE.,0,
     &                     'TABLE   ',0,0.d0,'RIEN',.FALSE.,MTAB1)
        IF (IERR.NE.0) RETURN
      ENDIF
 
      DO ITMP=1,NBTDIF
        NNIN = 1
        NNNOE= MTEMP.NBETEM(ITMP)
        SEGINI,MTRAV
        ITRAV = MTRAV
        MTRAV.INCO(1)='T   '
 
        DO IELEM = 1,NBTEMP
          IF (MTEMP.IDTEMP(IELEM) .EQ. MTEMP.ILITEM(ITMP)) THEN
            IDNOLU = MTEMP.INOTEM(IELEM)
            XVAL1  = MTEMP.XTEMP(IELEM)
            IDCOCA = MLINOE.ICORNO(IDNOLU)+NBANC
            MTRAV.BB  (1,NNNOE) = XVAL1
            MTRAV.IBIN(1,NNNOE) = 1
            MTRAV.IGEO(  NNNOE) = IDCOCA
            NNNOE = NNNOE - 1
            IF (NNNOE .EQ. 0) THEN
              CALL CRECHP(ITRAV,ICHPO1)
C             PRINT *,'SEGSUP,MTRAV',MTRAV
              SEGSUP,MTRAV
C             Ecriture dans la table TEMPERATURES
              IDT = MTEMP.ILITEM(ITMP)
              CALL ECCTAB(MTAB1 ,'ENTIER  ',IDT  ,0.d0,'RIEN',.FALSE.,0,
     &                      'CHPOINT ',0    ,0.d0,'RIEN',.FALSE.,ICHPO1)
              IF (IERR.NE.0) RETURN
            ENDIF
          ENDIF
        ENDDO
      ENDDO
 
      IF (NBTDIF .GT. 0) SEGDES,MTAB1
 
C***********************************************************************
C      Generation des trièdres pour les SYSTEMES : SEG2
C***********************************************************************
      IF (NBSYST .GT. 0) THEN
        M=NBSYST
        SEGINI,MTAB2
 
C       Ecriture dans la table de Sortie de la TABLE SYSTEMS
        COLO80='SYSTEMES'
        CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,COLO80    ,.FALSE.,0,
     &                     'TABLE   ',0,0.d0,'RIEN',.FALSE.,MTAB2)
        IF (IERR.NE.0) RETURN
 
C       Ajustement du SEGMENT MCOORD
        NBANC2=nbpts
        NBPTS=NBANC2+(4*NBSYST)
        SEGADJ,MCOORD
      ENDIF
 
      DO NUMSYS=1,NBSYST
C       Ajout au SEGMENT MCOORD des points en question
        IFLOT2 = 0
        j     =(NBANC2+(NUMSYS-1)*4)*idimp1
        DO IFLOT=1,12
          IFLOT2=IFLOT2 + 1
          IF (MOD(IFLOT2,4) .EQ. 0) THEN
C           On saute la couleur
            IFLOT2=IFLOT2 + 1
          ENDIF
          Flot1 = MSYSTE.SYSCOR(IFLOT,NUMSYS)
          MCOORD.XCOOR(j+IFLOT2)=Flot1
C          PRINT *,NUMSYS,j+IFLOT2,NBANC2+(NUMSYS-1)*4,Flot1
        ENDDO
 
        NBNN   = 2
        NBELEM = 3
        NBSOUS = 0
        NBREF  = 0
        SEGINI,IPT3
        IPT3.ITYPEL = IELEQ1(3)
 
        NUMORIG=NBANC2+(NUMSYS-1)*4 + 1
        DO IEL=1,NBELEM
          DO INN=1,NBNN
            IF (INN .EQ. 1) THEN
              IPT3.NUM(INN,IEL)=NUMORIG + INN - 1
            ELSE
              IPT3.NUM(INN,IEL)=NUMORIG + IEL
            ENDIF
C            PRINT *, IPT3.NUM(INN,IEL),nbpts
          ENDDO
        ENDDO
 
C       Ecriture dans la table SYSTEMS
        IDSYS = MSYSTE.IDSYST(NUMSYS)
        CALL ECCTAB(MTAB2 ,'ENTIER  ',IDSYS,0.d0,'RIEN',.FALSE.,0,
     &                     'MAILLAGE',0    ,0.d0,'RIEN',.FALSE.,IPT3)
        IF (IERR.NE.0) RETURN
      ENDDO
 
 
C***********************************************************************
C      FIN et sortie
C***********************************************************************
 991  CONTINUE
C Traitement des erreurs
      IF (iOK .NE.0) THEN
        CALL ERREUR(iOK)
        RETURN
 
      ELSE
        CALL ECROBJ('TABLE   ',MTABLE)
 
      ENDIF
      SEGDES,MTABLE
      SEGSUP,MLINOE, MLIELE, MPROP, MSYSTE, MRBE2, MSPC, MTEMP, MMOMEN
 
      RETURN
      END