Télécharger la plaquette Cast3M


fr en

Télécharger femv12.eso

Retour à la liste

Numérotation des lignes : 

femv12

  1. C FEMV12    SOURCE    PV        20/03/24    21:17:19     10554
  2.       SUBROUTINE FEMV12(IUFEM,NBLIGN,MTABLE)
  3.  
  4. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  5. C
  6. C BUT: Lecture des fichiers .fem du profil OptiStruct de HyperMesh.
  7. C      Les données sont rendues dans une table.
  8. C
  9. C Auteur : Clément BERTHINIER
  10. C          Novembre 2013
  11. C
  12. C Liste des Corrections :
  13. C  26/11/2013
  14. C  Clément B. : Anomalie lors de l'import de coordonnées corrigée
  15. C
  16. C Appele par : LIRFEM
  17. C
  18. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  19.  
  20.  
  21.       IMPLICIT INTEGER(I-N)
  22.       IMPLICIT REAL*8 (A-H,O-Z)
  23.  
  24. C Définition des COMMON utiles
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. -INC CCREDLE
  28. -INC CCGEOME
  29.  
  30. C Définition des OBJETS utiles
  31. C SMCOORD : à ne jamais désactiver contenant les coordonnées des points
  32. C SMELEME : objet MAILLAGE
  33. C SMTABLE : objet TABLE
  34. -INC SMCOORD
  35. -INC SMELEME
  36. -INC SMTABLE
  37.  
  38.  
  39. C***********************************************************************
  40. C Définition des différents segments et de leur contenu
  41. C***********************************************************************
  42.       SEGMENT MLINOE
  43. C       JGNOLO   : ID du noeud dans la numérotation LOCALE
  44. C       JGNOLU   : ID du noeud lu dans le fichier
  45. C       INOC3M   : Numéro du noeud dans la numérotation absolue de Cast3M
  46. C       INOEHM   : Numéro du JGième noeud lu dans le fichier .fem
  47. C       ICORNO   : Correspondance depuis la numérotation lue vers la numérotation LOCALE des noeuds
  48.         INTEGER INOC3M(JGNOLO)
  49.         INTEGER INOEHM(JGNOLO)
  50.         INTEGER ICORNO(JGNOLU)
  51.       ENDSEGMENT
  52.  
  53.       SEGMENT MLIELE
  54. C       JGELLO   : ID de l'élément dans la numérotation LOCALE
  55. C       JGELLU   : ID de l'élément lu dans le fichier
  56. C       JELCON   : Nombre total connectivité lues
  57. C       IELCON   : Ou aller lire le début de la connectivité dans ICONTO
  58. C       IELNBN   : Nombre de noeuds de connectivité à lire dans ICONTO
  59. C       IELTYP   : Type de l'élément lu pour Cast3M
  60. C       IELPRO   : ID de la propriété dans HM (Valeur lue pour IVALU = 2)
  61. C       IELCOM   : ID du component    dans HM dans lequel est rangé cet élément
  62. C       ICONTO   : Tableau dans lequel sont placées toutes les connectivités les unes après les autres
  63. C       ICOREL   : Correspondance depuis la numérotation LOCALE vers la numérotation lue des ELEMENTS
  64.         INTEGER IELCON(JGELLU)
  65.         INTEGER IELNBN(JGELLU)
  66.         INTEGER IELTYP(JGELLU)
  67.         INTEGER IELPRO(JGELLU)
  68.         INTEGER IELCOM(JGELLU)
  69.         INTEGER ICONTO(JELCON)
  70.         INTEGER ICOREL(JGELLO)
  71.       ENDSEGMENT
  72.  
  73.  
  74.       SEGMENT MELEQU
  75. C       Dans ce tableau dynamique sera stoquée la place dans NOMS (voir bdata.eso) des éléments équivalents Cast3M
  76.         INTEGER IELEQU(NBGEOM)
  77.       ENDSEGMENT
  78.  
  79. C     Segment contenant tout ce qui sera utile pour définir un component au sens HM
  80.       SEGMENT MCOMP
  81. C       JGCOLO   : Indice du composant dans la numérotation LOCALE
  82. C       JGCOLU   : ID lu dans le fichier
  83. C       NBGEOM   : Nombre de types d'éléments relu dans HM
  84. C       NAMECO   : Nom     des components
  85. C       ICOULC   : Couleur des components
  86. C       NBTYPE   : Nombre de types d'éléments dans le component + le nombre total de sous type (NBSOUS) dans la dernière case
  87. C       NBELCO   : Nombre d'éléments de chaque type dans le component (NBELEM)
  88. C       NBELC2   : Nombre d'éléments de chaque type dans le component a mesure qu'ils sont triés (à la fin)
  89. 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
  90. C       ICOCOR   : Correspondance entre la numérotation LOCALE et HM des components
  91.         CHARACTER*80 NAMECO(JGCOLU)
  92.         INTEGER      ICOULC(JGCOLU)
  93.         INTEGER      NBTYPE(JGCOLU,NBGEOM+1)
  94.         INTEGER      NBELCO(JGCOLU,NBGEOM)
  95.         INTEGER      NBELC2(JGCOLU,NBGEOM)
  96.         INTEGER      NPOINT(JGCOLU,NBGEOM+1)
  97.         INTEGER      ICOCOR(JGCOLO)
  98.       ENDSEGMENT
  99.  
  100. C     Segment contenant tout le necessaire pour reconstituer les SETS de noeuds et d'elements
  101.       SEGMENT MSET
  102. C       JGSELU   : ID  du SET lu
  103. C       JGSELO   : ID  du SET incrémenté à chaque nouveau set (Numérotation Locale)
  104. C       JGNBEL   : Nombre d'entité maximum lues pour un SET
  105. C       NOMSET   : Nom du SET lu
  106. C       ITYSET   : Type de SET lu (1 noeud, 2 element)
  107. C       ILISTE   : Liste des ID des entités lues pour chaque SET LU(Noeuds ou Elements)
  108. C       NBENTI   : Nombre d'entité lues Pour chaque SET
  109. C       NBTYPS   : Nombre de types d'éléments dans le SET + le nombre total de sous type (NBSOUS) dans la dernière case
  110. C       NBELSE   : Nombre d'éléments de chaque type dans le SET a mesure qu'ils sont triés (à la fin)
  111. 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
  112. C       ISECOR   : Correspondance entre la numérotation LOCALE et HM (Lu) des Sets
  113.         CHARACTER*80 NOMSET(JGSELU)
  114.         INTEGER      ITYSET(JGSELU)
  115.         INTEGER      ILISTE(JGNBEL,JGSELU)
  116.         INTEGER      NBENTI(JGSELO)
  117.         INTEGER      NBTYPS(JGSELU,NBGEOM+1)
  118.         INTEGER      NBELSE(JGSELU,NBGEOM)
  119.         INTEGER      NPOINS(JGSELU,NBGEOM+1)
  120.         INTEGER      ISECOR(JGSELO)
  121.       ENDSEGMENT
  122.  
  123. C     Segment contenant tout le necessaire pour reconstituer les LOADCOL (SPC, FORCE, MOMENT, PRESSION, TEMPERATURE)
  124.       SEGMENT MLOCOL
  125. C       JGLCLU   : ID  du LOADCOL lu
  126. C       JGLCLO   : ID  du LOADCOL incrémenté à chaque nouveau LOADCOL (Numérotation Locale)
  127. C       JGNBEN   : Nombre d'entité maximum lues pour un LOADCOL
  128. C       NOMLOC   : Nom du LOADCOL lu
  129. C       ILOCNO   : Liste des ID des noeuds lus pour chaque LOADCOL LU
  130. C       ISPC     : Liste des blocages sous la forme d'un entier pour les SPC
  131. C       TEMP     : Liste des températures sous la forme d'un flottant
  132. C       FORCX    : Valeur de la force lue suivant X
  133. C       FORCY    : Valeur de la force lue suivant Y
  134. C       FORCZ    : Valeur de la force lue suivant Z
  135. C       MOMX     : Valeur du moment lu suivant X
  136. C       MOMY     : Valeur du moment lu suivant Y
  137. C       MOMZ     : Valeur du moment lu suivant Z
  138. C       NBENLC   : Nombre d'entité lues Pour chaque LOADCOL
  139. C       ITYLOC   : Type de LOADCOL lu
  140. C                  1- SPC
  141. C                  2- TEMP
  142. C                  3- FORCE
  143. C                  4- MOMENT
  144. C                  5- PRESSION Normale
  145. C                  6- PRESSION Directionnelle (Vecteur contrainte)
  146. C       ILCCOR   : Correspondance entre la numérotation LOCALE et HM (Lu) des LOADCOL
  147.         CHARACTER*80 NOMLOC(JGLCLU)
  148.         INTEGER      ITYLOC(JGLCLU)
  149.         INTEGER      ILOCNO(JGNBEN,JGLCLU)
  150.         INTEGER      ISPC(JGNBEN,JGLCLU)
  151.         REAL*8       TEMP(JGNBEN,JGLCLU)
  152.         REAL*8       FORCX(JGNBEN,JGLCLU)
  153.         REAL*8       FORCY(JGNBEN,JGLCLU)
  154.         REAL*8       FORCZ(JGNBEN,JGLCLU)
  155.         REAL*8       MOMX(JGNBEN,JGLCLU)
  156.         REAL*8       MOMY(JGNBEN,JGLCLU)
  157.         REAL*8       MOMZ(JGNBEN,JGLCLU)
  158.         INTEGER      NBENLC(JGLCLU)
  159.         INTEGER      ILCCOR(JGLCLO)
  160.       ENDSEGMENT
  161.  
  162. C***********************************************************************
  163. C Définition des DATA et déclarations diverses
  164. C***********************************************************************
  165.       PARAMETER (NBNGEO=9)
  166.       PARAMETER (NBREPR=3)
  167.       PARAMETER (NBGEOM=16)
  168.       PARAMETER (LONOBJ=1+NBGEOM+1)
  169.  
  170. C Déclaration des chaines de caractères
  171.       CHARACTER*80  LIGNE
  172.       CHARACTER*4   COLO4
  173.       CHARACTER*8   MOTCL8
  174.       CHARACTER*8   COLO8
  175.       CHARACTER*9   COLO9
  176.       CHARACTER*16  COLO16
  177.       CHARACTER*17  COLO17
  178.       CHARACTER*80  COLO80
  179.  
  180. C Déclaration de tableaux de chaines de caractères
  181.       CHARACTER*8 NGTYPE(NBNGEO)
  182.       CHARACTER*8 NREPRI(NBREPR)
  183.       CHARACTER*8 GETYPE(NBGEOM)
  184.       CHARACTER*4 GELEQU(NBGEOM)
  185.  
  186. C Décalration des Boleens
  187. C      LOGICAL DEBCB
  188.       LOGICAL PRECID
  189.  
  190.       LOGICAL BSPC
  191.       LOGICAL BFORC
  192.       LOGICAL BMOM
  193.       LOGICAL BPRES
  194.       LOGICAL BTEMP
  195.  
  196.  
  197.  
  198.       INTEGER GECONN(NBGEOM)
  199.       INTEGER IORDCO(NBGEOM*20)
  200.       INTEGER NOBJ(LONOBJ)
  201. C     NOBJ( 1 ) : Nbr d'objets géométriques différents lus
  202. C     NOBJ( n ) : Nombre d'objets géométriques de chaque type Lus
  203. C     NOBJ(end) : Nombre d'éléments lu au total
  204.  
  205.  
  206.  
  207. C     Liste des mots clé non Géométrique en début de ligne d'un fichier .fem
  208.       DATA NGTYPE / '$HMMOVE ',
  209.      &              '$HMNAME ',
  210.      &              '$HWCOLOR',
  211.      &              '$HMSET  ',
  212.      &              'SPC     ',
  213.      &              'TEMP    ',
  214.      &              'FORCE   ',
  215.      &              'MOMENT  ',
  216.      &              'PLOAD4  ' /
  217.  
  218. C     Liste des mots clé non Géométrique en début de ligne d'un fichier .fem
  219.       DATA NREPRI / '+       ',
  220.      &              '*       ',
  221.      &              '$       ' /
  222.  
  223. C Liste des mots clé de Géométrie en début de ligne d'un fichier .fem
  224.       DATA GETYPE / 'GRID    ','GRID*   ',
  225.      &              'RBE2    ','RBE3    ',
  226.      &              'CTRIA3  ','CTRIA6  ',
  227.      &              'CQUAD4  ','CQUAD8  ',
  228.      &              'CTETRA  ','CTETRA10',
  229.      &              'CPYRA   ','CPYRA13 ',
  230.      &              'CPENTA  ','CPENTA15',
  231.      &              'CHEXA   ','CHEXA20 ' /
  232.  
  233. C Elements equivalents dans Cast3M
  234.       DATA GELEQU / 'POI1','POI1',
  235.      &              'SEG2','SEG3',
  236.      &              'TRI3','TRI6',
  237.      &              'QUA4','QUA8',
  238.      &              'TET4','TE10',
  239.      &              'PYR5','PY13',
  240.      &              'PRI6','PR15',
  241.      &              'CUB8','CU20' /
  242.  
  243. C     Data indiquant le nombre de noeud de connectivité pour chaque Elements
  244.       DATA GECONN / 1,1 ,
  245.      &              2,3 ,
  246.      &              3,6 ,
  247.      &              4,8 ,
  248.      &              4,10,
  249.      &              5,13,
  250.      &              6,15,
  251.      &              8,20 /
  252.  
  253.  
  254. C     Data permettrant de mettre le bon ordre dans la connectivité des éléments
  255. C     Le facteur 20 de ce DATA vient du fait que l'élément le plus
  256. C     Complexe a une connectivité à 20 éléments (CU20 ou HEXA 2nd Ordre)
  257.       DATA IORDCO /
  258.      &     1,0,0,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         POI1
  259.      &     1,0,0,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         POI1
  260.      &     1,2,0,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         SEG2
  261.      &     3,1,2,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         SEG3
  262.      &     1,2,3,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         TRI3
  263.      &     1,4,2,5 ,3,6 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         TRI6
  264.      &     1,2,3,4 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         QUA4
  265.      &     1,5,2,6 ,3,7 ,4 ,8 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         QUA8
  266.      &     1,2,3,4 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         TET4
  267.      &     1,5,2,6 ,3,7 ,8 ,9 ,10,4 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         TE10
  268.      &     1,2,3,4 ,5,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         PYR5
  269.      &     2,7,3,8 ,4,9 ,1 ,6 ,11,12,13,10,5 ,0 ,0 ,0 ,0,0 ,0,0 ,         PY13
  270.      &     1,2,3,4 ,5,6 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         PRI6
  271.      &     1,7,2,8 ,3,9 ,10,11,12,4 ,13,5 ,14,6 ,15,0 ,0,0 ,0,0 ,         PR15
  272.      &     1,2,3,4 ,5,6 ,7 ,8 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 ,         CUB8
  273.      &     1,9,2,10,3,11,4 ,12,13,14,15,16,5 ,17,6 ,18,7,19,8,20 /        CU20
  274.  
  275. C Option de Débuggage par Clément BERTHINIER
  276. C      DEBCB = .TRUE.
  277. C      DEBCB = .FALSE.
  278.  
  279.  
  280. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  281. C      IF (DEBCB) THEN
  282. C        WRITE(IOIMP,*)'Entree dans la Subroutine LIRFEM '
  283. C      ENDIF
  284.  
  285. C Création de la table VIDE de sortie
  286.       M=0
  287.       SEGINI,MTABLE
  288.  
  289. C Format de lecture d'un fichier .fem
  290. C 10 fois 8  caractères par ligne en simple précision
  291. C 5  fois 16 caractères par ligne en double précision
  292.  
  293.  1000 FORMAT(A80)
  294.  
  295. C Initialisation des Segments
  296.       MLINOE = 0
  297.       MLIELE = 0
  298.       MELEQU = 0
  299.       MCOMP  = 0
  300.       MSET   = 0
  301.  
  302. C Initialisations autres
  303.       INCJGN = 5000                                                      C Incrément de NOEUD
  304.       INCJGE = 5000                                                      C Incrément d' ELEMENT
  305.       INCJCO = 5000                                                      C Incrément de CONNECTIVITE
  306.       INCCOM = 10                                                        C Incrément de COMPONENT
  307.       INCSET = 10                                                        C Incrément de SETS
  308.       INCLOC = 10                                                        C Incrément de LOADCOL
  309.  
  310.       IRETO1 = 0
  311.       IRETO2 = 0
  312.       IRETO3 = 0
  313.       IRETO4 = 0
  314.       IVALU  = 0
  315.       IDLU   = 0
  316.       IDLU0  = 0
  317.       IDLU1  = 0
  318.       IDCOMP = 0
  319.       IDTYPE = 0
  320.       IDELEM = 0
  321.       IDCONN = 0
  322.       IDCOCA = 0
  323.       IDCOLU = 0
  324.       IDMAIL = 0
  325.       INDICE = 0
  326.       JNDICE = 0
  327.       ICOL   = 0
  328.       ITEST  = 0
  329.       IADD   = 0
  330.       IENTLU = 0
  331.  
  332.       IPT1   = 0
  333.       IPT2   = 0
  334.  
  335.       LCOL   = 0
  336.       NCOLOL = 0
  337.       NBCONN = 0
  338.       NBCOMP = 0
  339.       NBSETS = 0
  340.       NBLOCO = 0
  341.  
  342.       NBNPTS = 0
  343.       NELTOT = 0
  344.       NENTIT = 0
  345.  
  346.       XNCJG  = REAL(2.0D0)
  347.  
  348.       PRECID = .FALSE.
  349.       BSPC   = .FALSE.
  350.       BFORC  = .FALSE.
  351.       BMOM   = .FALSE.
  352.       BPRES  = .FALSE.
  353.       BTEMP  = .FALSE.
  354. C Tableau NOBJ initialisé à 0
  355.       DO 1 INDICE = 1, LONOBJ
  356.         NOBJ(INDICE)=0
  357.  1    CONTINUE
  358.  
  359. C Segment de lecture d'une ligne ...
  360.       SEGINI,sredle
  361.       SEPARA=.FALSE.
  362.       MOT=' '
  363.  
  364. C Initialisation des segments
  365.       JGNOLU=INCJGN
  366.       JGNOLO=INCJGN
  367.       SEGINI,MLINOE
  368.  
  369.       JGELLU=INCJGE
  370.       JGELLO=INCJGE
  371.       JELCON=INCJCO
  372.       SEGINI,MLIELE
  373.  
  374.       SEGINI,MELEQU
  375.  
  376.       JGCOLU=INCCOM
  377.       JGCOLO=INCCOM
  378.       SEGINI,MCOMP
  379.  
  380.       JGNBEL=INCJGE
  381.       JGSELU=INCSET
  382.       JGSELO=INCSET
  383.       SEGINI,MSET
  384.  
  385.  
  386. C      JGENLU=INCJGE
  387.       JGNBEN=INCJGE
  388.       JGLCLU=INCLOC
  389.       JGLCLO=INCLOC
  390.       SEGINI,MLOCOL
  391.  
  392.       segact mcoord*mod
  393.       NBANC=nbpts
  394.       idimp1=IDIM+1
  395.       NBPTS=NBANC+JGNOLO
  396.       SEGADJ,MCOORD
  397.  
  398. C     Remplissage du tableau d'entier représentant la place dans NOMS (Type d'élément selon CastM3)
  399. C     La taille de NOMS est spécifiée maximum égale à 100 dans CCGEOME.INC
  400.       DO 9 INDICE = 1, NBGEOM
  401.         COLO4=GELEQU(INDICE)
  402.         CALL PLACE(NOMS,100,IRETO3,COLO4)
  403.         IELEQU(INDICE)=IRETO3
  404.  9    CONTINUE
  405.  
  406.  10   CONTINUE
  407. C     Lecture de la ligne complete (80 caracteres)
  408.       READ(IUFEM,1000,ERR=989,END=100) LIGNE
  409.       NBLIGN = NBLIGN + 1
  410. C       IF (DEBCB) THEN
  411. C         WRITE(IOIMP,*) 'Nombre de LIGNES : ',NBLIGN
  412. C       ENDIF
  413.  
  414. C     Premier mot de la ligne
  415.       COLO8=LIGNE(1:LEN(COLO8))
  416.  
  417. C     Largeur des colonnes à lire par défaut en Simple Précision
  418.       PRECID = .FALSE.
  419.  
  420. C     Recherche si balise de suite d'instruction
  421.       CALL PLACE(NREPRI,NBREPR,IRETO4,COLO8)
  422.       IF (IRETO4.NE.0) THEN
  423.         IF (IRETO4.EQ.2) THEN
  424.           PRECID = .TRUE.
  425.         ENDIF
  426.         GOTO 12
  427.       ENDIF
  428.  
  429. C     Recherche dans le DATA des mots-clés non géométriques
  430.       CALL PLACE(NGTYPE,NBNGEO,IRETO2,COLO8)
  431.       IF (IRETO2.NE.0) THEN
  432.         IVALU = 0
  433.       ENDIF
  434.  
  435. C     Recherche dans le DATA des éléments géométriques
  436.       CALL PLACE(GETYPE,NBGEOM,IRETO1,COLO8)
  437.       IF (IRETO1.NE.0) THEN
  438.         IF (IRETO1.EQ.2) THEN
  439.           PRECID = .TRUE.
  440.         ENDIF
  441.         IVALU = 0
  442.  
  443. C       Si le type rencontré n'avait pas été rencontré alors j'incrémente le nombre d'objet de ce type
  444.         IF ( NOBJ(1+IRETO1).EQ.0) THEN
  445.           NOBJ(1) = NOBJ(1) + 1
  446.         ENDIF
  447.  
  448. C       Incrémente le nombre total d'éléments lus dans la dernière case de NOBJ
  449.         IF (IRETO1.GT.2) THEN
  450.            NOBJ(LONOBJ) = NOBJ(LONOBJ) + 1
  451.         ENDIF
  452.  
  453.         NOBJ(1+IRETO1) = NOBJ(1+IRETO1)+1
  454.         NBNPTS = NOBJ(2)+NOBJ(3)
  455.         NELTOT = NOBJ(LONOBJ)
  456.       ENDIF
  457.  
  458.  12   CONTINUE
  459.  
  460. C     Détermination du Format de Lecture des colonnes
  461.       IF (PRECID) THEN
  462.         NCOLOL = 4
  463.         LCOL   = LEN(COLO16)
  464.       ELSE
  465.         NCOLOL = 9
  466.         LCOL   = LEN(COLO8)
  467.       ENDIF
  468.  
  469. C     Boucle pour lire les Colonnes qui suivent :
  470.       DO 11 ICOL = 1, NCOLOL
  471.         IDCOL = LEN(COLO8) + 1 + (ICOL - 1) * LCOL
  472.         IFCOL = IDCOL + LCOL
  473. C        IF (DEBCB) THEN
  474. C          WRITE(IOIMP,*) 'IDCOL : ',IDCOL
  475. C          WRITE(IOIMP,*) 'IFCOL : ',IFCOL
  476. C          WRITE(IOIMP,*) 'LCOL  : ',LCOL
  477. C        ENDIF
  478.  
  479.         TEXT = LIGNE(IDCOL:IFCOL)
  480.         IF (PRECID) THEN
  481.           COLO16 = LIGNE(IDCOL:IFCOL)
  482.         ELSE
  483.           COLO8 = LIGNE(IDCOL:IFCOL)
  484.         ENDIF
  485.  
  486.         ICOUR = LCOL
  487.         IFINAN= ICOUR+1
  488.  
  489. C       Correction à la volée d'une caractéristique du format .fem le 'E' n'est pas toujours mis pour les puissances négatives
  490.         IF ((IRETO1.EQ.1).AND.(IVALU.GE.1)) THEN
  491. C         Cas de la lecture des coordonnées d'un noeud simple precision
  492.           IF(COLO8(1:1).EQ.'-')THEN
  493.             IADD = 1
  494.           ELSE
  495.             IADD = 0
  496.           ENDIF
  497.  
  498.           DO 15 ICHAR1 = 1+IADD, LCOL
  499.             IF((COLO8(ICHAR1:ICHAR1).EQ.'-').AND.
  500.      &         (COLO8(ICHAR1-1:ICHAR1-1).NE.'e').AND.
  501.      &         (COLO8(ICHAR1-1:ICHAR1-1).NE.'E').AND.
  502.      &         (COLO8(ICHAR1-1:ICHAR1-1).NE.'d').AND.
  503.      &         (COLO8(ICHAR1-1:ICHAR1-1).NE.'D').AND.
  504.      &         (COLO8(ICHAR1-1:ICHAR1-1).NE.' '))THEN
  505.               COLO9 =COLO8(1:ICHAR1-1)//'E-'//COLO8(ICHAR1+1:LCOL)
  506.               TEXT  = COLO9
  507.               ICOUR =LEN(COLO9)
  508.               IFINAN=ICOUR+1
  509. C              WRITE(IOIMP,*) 'Nouvelle COLO9 : ',COLO9
  510.               GOTO 15
  511.             ENDIF
  512.  15       CONTINUE
  513.         ELSEIF ((IRETO1.EQ.2).AND.(IVALU.GE.1)) THEN
  514. C         Cas de la lecture des coordonnées d'un noeud double precision
  515.           IF(COLO16(1:1).EQ.'-')THEN
  516.             IADD = 1
  517.           ELSE
  518.             IADD = 0
  519.           ENDIF
  520.  
  521.           DO 16 ICHAR1 = 1+IADD, LCOL
  522.             IF((COLO16(ICHAR1:ICHAR1).EQ.'-').AND.
  523.      &         (COLO16(ICHAR1-1:ICHAR1-1).NE.'e').AND.
  524.      &         (COLO16(ICHAR1-1:ICHAR1-1).NE.'E').AND.
  525.      &         (COLO16(ICHAR1-1:ICHAR1-1).NE.'d').AND.
  526.      &         (COLO16(ICHAR1-1:ICHAR1-1).NE.'D').AND.
  527.      &         (COLO16(ICHAR1-1:ICHAR1-1).NE.' '))THEN
  528.               COLO17 =COLO16(1:ICHAR1-1)//'E-'//
  529.      &                COLO16(ICHAR1+1:LCOL)
  530.               TEXT  = COLO17
  531.               ICOUR = LEN(COLO17)
  532.               IFINAN=ICOUR+1
  533. C              WRITE(IOIMP,*) 'Nouvelle COLO17 : ',COLO17
  534.               goto 16
  535.             ENDIF
  536.  16       CONTINUE
  537.         ENDIF
  538.  
  539.         NRAN  = 0
  540.         CALL REDLEC(sredle)
  541.  
  542. C       Poursuite dans le cas ou quelque chose a été lue
  543.         IF (IRE.NE.0) THEN
  544.           IVALU  = IVALU + 1
  545.  
  546. C          IF (DEBCB) THEN
  547. C           WRITE(IOIMP,*) 'TEXT          :',TEXT(1:ICOUR)
  548. C           WRITE(IOIMP,*) 'IVALU         :',IVALU
  549. C            IF (IRE.EQ.1) THEN
  550. C              WRITE(IOIMP,*) 'Entier Lu   :',NFIX
  551. C            ENDIF
  552. C           IF (IRE.EQ.2) THEN
  553. C             WRITE(IOIMP,*) 'Flottant Lu :',FLOT
  554. C           ENDIF
  555. C          ENDIF
  556.  
  557.  
  558. C***********************************************************************
  559. C           Traitement des des coordonnées des Noeuds
  560. C***********************************************************************
  561.           IF ((IRETO1.EQ.1).OR.(IRETO1.EQ.2)) THEN
  562. C           Ajustement du segment MCOORD
  563.             IF (NBNPTS.GT.JGNOLO) THEN
  564.               INCJGN = INT(REAL(INCJGN) * XNCJG)
  565.               JGNOLO    = JGNOLO + INCJGN
  566.               NBPTS = JGNOLO + NBANC
  567.               SEGADJ,MLINOE
  568.               SEGADJ,MCOORD
  569. C              IF (DEBCB) THEN
  570. C                WRITE(IOIMP,*) 'Segment MCOORD Ajuste'
  571. C                WRITE(IOIMP,*) 'INCJGN : ',INCJGN
  572. C                WRITE(IOIMP,*) '   JGNOLO  : ',JGNOLO
  573. C                WRITE(IOIMP,*) 'NBPTS  : ',NBPTS
  574. C              ENDIF
  575.             ENDIF
  576.  
  577.             j=(NBANC+NBNPTS-1)*idimp1
  578.  
  579. C           Lecture du numéro du noeud (TYPE ENTIER)
  580.             IF (IVALU.EQ.1) THEN
  581. C             Prévoir erreur si pas entier lu
  582.               INOC3M(NBNPTS)=NBANC+NBNPTS
  583.               INOEHM(NBNPTS)=NFIX
  584.  
  585. C             Ajustement du segment MLINOE pour le tableau ICORNO(JGNOLU)
  586.               IF(NFIX.GT.JGNOLU) THEN
  587.                 INCJGN = INT(REAL(INCJGN) * XNCJG)
  588.                 JGNOLU = NFIX + INCJGN
  589.                 SEGADJ,MLINOE
  590.               ENDIF
  591.               ICORNO(NFIX)=NBNPTS
  592.  
  593. C           Lecture des 3 Coordonnées qui suivent le numéro du noeud (TYPE FLOT)
  594.             ELSEIF((IVALU.GT.1).AND.(IVALU.LE.4)) THEN
  595.               IF (IRE.EQ.1) THEN
  596.                 XCOOR(j+(IVALU-1))=NFIX
  597. C               IF (DEBCB) THEN
  598. C                 WRITE(IOIMP,*) 'Entier   Lu :',NFIX
  599. C                 WRITE(IOIMP,*) 'ICOL-3  :',ICOL-3
  600. C                 WRITE(IOIMP,*) 'IVALU-1 :',IVALU-1
  601. C               ENDIF
  602.               ELSEIF (IRE.EQ.2) THEN
  603.                 XCOOR(j+(IVALU-1))=FLOT
  604. C                IF (DEBCB) THEN
  605. C                 WRITE(IOIMP,*) ' Flottant Lu :',FLOT
  606. C                 WRITE(IOIMP,*) 'ICOL-3  :',ICOL-3
  607. C                 WRITE(IOIMP,*) 'IVALU-1 :',IVALU-1
  608. C                ENDIF
  609.               ENDIF
  610.             ELSEIF (IVALU.GT.4) THEN
  611.               WRITE(IOIMP,*) 'ERREUR, IVALU > 4 pour des Coordonnées'
  612.             ENDIF
  613. C           La densité n'a pas d'équivalent dans Hyper Mesh, elle est à 0.D0 par défaut
  614. C            XCOOR(j+idimp1)=REAL(0.D0)
  615.  
  616.  
  617. C***********************************************************************
  618. C           Traitement des ELEMENTS et de leur CONNECTIVITE
  619. C***********************************************************************
  620.           ELSEIF (IRETO1.GE.2) THEN
  621. C           Ajustement du segment MLIELE
  622.             IF(NELTOT.GT.JGELLO) THEN
  623.               INCJGE = INT(REAL(INCJGE) * XNCJG)
  624.               JGELLO = NELTOT + INCJGE
  625.               SEGADJ,MLIELE
  626.             ENDIF
  627.  
  628.             IF (IVALU.EQ.1) THEN
  629. C             Lecture de l'ID de l'élément
  630.               IDLU = NFIX
  631.  
  632. C             Enregistrement de la correspondance
  633.               ICOREL(NELTOT)=IDLU
  634.  
  635. C             Ajustement du segment MLIELE
  636.               IF (IDLU.GT.JGELLU) THEN
  637.                 INCJGE = INT(REAL(INCJGE) * XNCJG)
  638.                 JGELLU = IDLU + INCJGE
  639.                 SEGADJ,MLIELE
  640.               ENDIF
  641.  
  642.               IELTYP(IDLU) = IRETO1
  643.  
  644. C              IF(DEBCB) THEN
  645. C                WRITE(IOIMP,*) 'IDLU',IELTYP(IDLU),'IRETO1',IRETO1
  646. C              ENDIF
  647.  
  648.             ELSEIF (IRE.EQ.1) THEN
  649.               IF (IRETO1.EQ.3) THEN
  650. C               Cas particulier des RBE2
  651.                 IF (IVALU.EQ.3) THEN
  652. 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)
  653. C                 Je ne m'occupe pour l'instant que des supports géométriques des éléments
  654. C                  IF (DEBCB) THEN
  655. C                    WRITE(IOIMP,*) 'Degres bloques RBE2',COLO8
  656. C                  ENDIF
  657.                 ELSE
  658.                   NBCONN = NBCONN + 1
  659.                   IF (IVALU.EQ.2) THEN
  660. C                   Enregistrer ou débute la lecture de la connectivité
  661.                     IELCON(IDLU)=NBCONN
  662.                   ENDIF
  663. C                 Ajustement du segment MLIELE
  664.                   IF (NBCONN.GT.JELCON) THEN
  665.                     INCJCO = INT(REAL(INCJCO) * XNCJG)
  666.                     JELCON = NBCONN + INCJCO
  667.                     SEGADJ,MLIELE
  668.                   ENDIF
  669.  
  670. C                 Enregistrer la connectivité de l'élément
  671.                   ICONTO(NBCONN)=NFIX
  672.                   IELNBN(IDLU)=IELNBN(IDLU)+1
  673. C                  IF (DEBCB) THEN
  674. C                    WRITE(IOIMP,*) 'IVALU:',IVALU
  675. C                    WRITE(IOIMP,*) 'REB2 Connectivite :',NFIX
  676. C                  ENDIF
  677.                 ENDIF
  678.  
  679.               ELSEIF (IRETO1.EQ.4) THEN
  680. C               Cas particulier des RBE3
  681.                 IF ((IVALU.EQ.3).OR.(IVALU.EQ.4).OR.(IVALU.EQ.5)) THEN
  682. 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)
  683. C                 Je ne m'occupe pour l'instant que des supports géométriques des éléments
  684. C                  IF (DEBCB) THEN
  685. C                    WRITE(IOIMP,*) 'Degres bloques RBE2',COLO8
  686. C                  ENDIF
  687.                 ELSE
  688.                   NBCONN = NBCONN + 1
  689.                   IF (IVALU.EQ.2) THEN
  690. C                   Enregistrer ou débute la lecture de la connectivité
  691.                     IELCON(IDLU)=NBCONN
  692.                   ENDIF
  693. C                 Ajustement du segment MLIELE
  694.                   IF (NBCONN.GT.JELCON) THEN
  695.                     INCJCO = INT(REAL(INCJCO) * XNCJG)
  696.                     JELCON = NBCONN + INCJCO
  697.                     SEGADJ,MLIELE
  698.                   ENDIF
  699.  
  700. C                 Enregistrer la connectivité de l'élément
  701.                   ICONTO(NBCONN)=NFIX
  702.                   IELNBN(IDLU)=IELNBN(IDLU)+1
  703. C                  IF (DEBCB) THEN
  704. C                    WRITE(IOIMP,*) 'IVALU:',IVALU
  705. C                    WRITE(IOIMP,*) 'REB3 Connectivite :',NFIX
  706. C                  ENDIF
  707.                 ENDIF
  708.               ELSE
  709. C               Cas de tous les autres éléments
  710.                 IF (IVALU.EQ.2) THEN
  711. C                 Lecture de la Property à laquelle appartient l'élément
  712.                   IELPRO(IDLU)=NFIX
  713.  
  714.                 ELSE
  715.                   NBCONN = NBCONN + 1
  716.                   IF (IVALU.EQ.3) THEN
  717. C                   Enregistrer ou débute la lecture de la connectivité
  718.                     IELCON(IDLU)=NBCONN
  719.                   ENDIF
  720.  
  721. C                 Ajustement du segment MLIELE
  722.                   IF (NBCONN.GT.JELCON) THEN
  723.                     INCJCO = INT(REAL(INCJCO) * XNCJG)
  724.                     JELCON = NBCONN + INCJCO
  725.                     SEGADJ,MLIELE
  726.                   ENDIF
  727.  
  728. C                 Enregistrer la connectivité de l'élément
  729.                   ICONTO(NBCONN)=NFIX
  730.                   IELNBN(IDLU)=IELNBN(IDLU)+1
  731. C                  IF (DEBCB) THEN
  732. C                    WRITE(IOIMP,*) 'IVALU:',IVALU
  733. C                    WRITE(IOIMP,*) 'Entier Lu :',NFIX
  734. C                    WRITE(IOIMP,*) 'IELNBN(IDLU):',IELNBN(IDLU),
  735. C     &                             'IDLU:',IDLU
  736. C                  ENDIF
  737.  
  738. C                 Détection d'éléments d'ordre 2 par le nombre de noeuds dans la connectivité
  739. C                 Pour [IRETO1 >= 9] Exception car les éléments ont des noms identiques pour HM...
  740.                   IF ((IRETO1.GE.9).AND.
  741.      &                (IELNBN(IDLU).EQ.GECONN(IRETO1+1))) THEN
  742.                     IELTYP(IDLU) = IRETO1+1
  743. C                    IF (DEBCB) THEN
  744. C                      WRITE(IOIMP,*) 'IDLU:',IDLU,
  745. C     &                        'Ordre 2 IELTYP(IDLU):',IELTYP(IDLU)
  746. C                    ENDIF
  747.                     NOBJ(1+IRETO1)   = NOBJ(1+IRETO1)-1
  748.                     NOBJ(1+IRETO1+1) = NOBJ(1+IRETO1+1)+1
  749.                   ENDIF
  750.                 ENDIF
  751.               ENDIF
  752.             ENDIF
  753.  
  754. C***********************************************************************
  755. C           Répartition des éléments dans les Components adéquats
  756. C***********************************************************************
  757.           ELSEIF (IRETO2.EQ.1) THEN
  758.             IF (IVALU.EQ.1) THEN
  759.               IDCOMP = NFIX
  760. C             Ajustement du segment MCOMP
  761.               IF (IDCOMP.GT.JGCOLU) THEN
  762.                 INCCOM = INT(REAL(INCCOM) * XNCJG)
  763.                 JGCOLU = IDCOMP + INCCOM
  764.                 SEGADJ,MCOMP
  765. C                IF (DEBCB) THEN
  766. C                  WRITE(IOIMP,*) 'Ajustement du segment MCOMP 1'
  767. C                  WRITE(IOIMP,*) 'JGCOLU',JGCOLU
  768. C                ENDIF
  769.               ENDIF
  770. C             IF (DEBCB) THEN
  771. C               WRITE(IOIMP,*) 'IDCOMP',IDCOMP
  772. C             ENDIF
  773.             ELSE
  774.               IF (COLO8.EQ.'THRU    ') THEN
  775.                 IDLU0 = IDELEM
  776. C                IF (DEBCB) THEN
  777. C                  WRITE(IOIMP,*) 'MOTLU:',COLO8,':'
  778. C                  WRITE(IOIMP,*) 'IDLU0: ',IDLU0
  779. C                ENDIF
  780.               ELSE
  781.                 IF (IRE.EQ.1) THEN
  782.                   IF (IDLU0.NE.0) THEN
  783.                     IDLU1 = NFIX
  784. C                    IF (DEBCB) THEN
  785. C                      WRITE(IOIMP,*) 'IDLU1: ',IDLU1
  786. C                    ENDIF
  787.  
  788. C                   BOUCLE entre (IDLU0+1) et IDLU1 (IDLU0 a déjà été traité au premier passage )
  789. C                     Enregistrement de l'ID du component auquel appartient l'element
  790. C                                     du type de l'élément lu
  791. C                                     du nombre de type d'éléments dans le component et quels types sont présents
  792. C                                     du nombre d'élément de chaque type dans le component
  793.                     DO IDELEM=(IDLU0+1),IDLU1
  794.                       IELCOM(IDELEM) = IDCOMP
  795.                       IDTYPE = IELTYP(IDELEM)
  796.                       IF (NBELCO(IDCOMP,IDTYPE).EQ.0) THEN
  797.                         NBTYPE(IDCOMP,IDTYPE) = 1
  798.                         NBTYPE(IDCOMP,NBGEOM+1) =
  799.      &                         NBTYPE(IDCOMP,NBGEOM+1) + 1
  800.                       ENDIF
  801.                       NBELCO(IDCOMP,IDTYPE) = NBELCO(IDCOMP,IDTYPE)+1
  802.  
  803. C                      IF (DEBCB) THEN
  804. C                        WRITE(IOIMP,*) 'IDELEM THRU',IDELEM,
  805. C     &                                 'IDCOMP',IDCOMP,
  806. C     &                                 'IDTYPE',IDTYPE,
  807. C     &                                 'NBNO  ',GECONN(IDTYPE)
  808. C                      ENDIF
  809.                     ENDDO
  810.  
  811. C                   Remise à zéro de IDLU0
  812.                     IDLU0 = 0
  813.  
  814.                   ELSE
  815. C                   Enregistrement de l'ID du component auquel appartient l'element
  816. C                                du type de l'élément lu
  817. C                                du nombre de type d'éléments dans le component et quels types sont présents
  818. C                                du nombre d'élément de chaque type dans le component
  819.                     IDELEM = NFIX
  820.                     IELCOM(IDELEM) = IDCOMP
  821.                     IDTYPE = IELTYP(IDELEM)
  822.                     IF (NBELCO(IDCOMP,IDTYPE).EQ.0) THEN
  823.                       NBTYPE(IDCOMP,IDTYPE) = 1
  824.                       NBTYPE(IDCOMP,NBGEOM+1) =
  825.      &                       NBTYPE(IDCOMP,NBGEOM+1) + 1
  826.                     ENDIF
  827.                     NBELCO(IDCOMP,IDTYPE) = NBELCO(IDCOMP,IDTYPE) + 1
  828.  
  829. C                    IF (DEBCB) THEN
  830. C                      WRITE(IOIMP,*) 'IDELEM THRU',IDELEM,
  831. C     &                               'IDCOMP',IDCOMP,
  832. C     &                               'IDTYPE',IDTYPE,
  833. C     &                               'NBNO  ',GECONN(IDTYPE)
  834. C                    ENDIF
  835.                   ENDIF
  836.                 ENDIF
  837.               ENDIF
  838.             ENDIF
  839.  
  840. C***********************************************************************
  841. C           Traitement des noms de COMPONENT ET LOADCOL
  842. C***********************************************************************
  843.           ELSEIF (IRETO2.EQ.2) THEN
  844.             IF (IVALU.EQ.1) THEN
  845. C             Lecture du deuxième mot clé
  846.               MOTCL8 = COLO8
  847.  
  848.               IF (MOTCL8.EQ.'COMP    ') THEN
  849. C               Incrémentation du nombre de COMPONENT
  850.                 NBCOMP = NBCOMP + 1
  851. C               Ajustement du segment MCOMP
  852.                 IF (NBCOMP.GT.JGCOLO) THEN
  853.                   INCCOM = INT(REAL(INCCOM) * XNCJG)
  854.                   JGCOLO = NBCOMP + INCCOM
  855.                   SEGADJ,MCOMP
  856.                 ENDIF
  857.  
  858.               ELSEIF (MOTCL8.EQ.'LOADCOL ') THEN
  859. C               Incrémentation du nombre de LOADCOL
  860.                 NBLOCO = NBLOCO + 1
  861. C               Ajustement du segment MCOMP
  862.                 IF (NBLOCO.GT.JGLCLO) THEN
  863.                   INCLOC = INT(REAL(INCLOC) * XNCJG)
  864.                   JGLCLO = NBLOCO + INCLOC
  865.                   SEGADJ,MLOCOL
  866.                 ENDIF
  867.  
  868.               ELSE
  869.                 WRITE(IOIMP,*) '       Carte non lue : ',MOTCL8
  870.               ENDIF
  871.  
  872. C           Lecture de d'ID
  873.             ELSEIF (IVALU.EQ.2) THEN
  874.               IDLU = NFIX
  875.  
  876.               IF (MOTCL8.EQ.'COMP    ') THEN
  877. C               Ajustement du segment MCOMP
  878.                 IF (IDLU.GT.JGCOLU) THEN
  879.                   INCCOM = INT(REAL(INCCOM) * XNCJG)
  880.                   JGCOLU = IDLU + INCCOM
  881.                   SEGADJ,MCOMP
  882. C                   IF (DEBCB) THEN
  883. C                     WRITE(IOIMP,*) 'Ajustement du segment MCOMP 2'
  884. C                     WRITE(IOIMP,*) 'JGCOLU',JGCOLU
  885. C                   ENDIF
  886.                 ENDIF
  887.                 ICOCOR(NBCOMP)=IDLU
  888. C                IF (DEBCB) THEN
  889. C                  WRITE(IOIMP,*) 'ID lu noms :',IDLU,'LIGNE : ',NBLIGN
  890. C                ENDIF
  891.  
  892.               ELSEIF (MOTCL8.EQ.'LOADCOL ') THEN
  893. C               Ajustement du segment MLOCOL
  894.                 IF (IDLU.GT.JGLCLU) THEN
  895.                   INCLOC = INT(REAL(INCLOC) * XNCJG)
  896.                   JGLCLU = IDLU + INCLOC
  897.                   SEGADJ,MLOCOL
  898. C                   IF (DEBCB) THEN
  899. C                     WRITE(IOIMP,*) 'Ajustement du segment MLOCOL 2'
  900. C                     WRITE(IOIMP,*) 'JGLCLU',JGLCLU
  901. C                   ENDIF
  902.                 ENDIF
  903.                 ILCCOR(NBLOCO)=IDLU
  904. C                 IF (DEBCB) THEN
  905. C                   WRITE(IOIMP,*) 'ID lu noms :',IDLU,'LIGNE : ',NBLIGN
  906. C                 ENDIF
  907.  
  908.               ENDIF
  909.  
  910. C           Lecture du MOT représentant le nom du COMPONENT
  911.             ELSEIF (IVALU.EQ.3) THEN
  912.               COLO80 = LIGNE(IDCOL+1:80)
  913.  
  914. C             Retrait de la double côte représentant la fin du nom lu
  915.               DO INDICE=2,LEN(COLO80)
  916.                 IF ((COLO80(INDICE:INDICE)).EQ.'"') THEN
  917.                   COLO80 = COLO80(1:INDICE-1)
  918.                   GOTO 320
  919.                 ENDIF
  920.               ENDDO
  921.  
  922.  320          CONTINUE
  923.               IF (MOTCL8.EQ.'COMP    ') THEN
  924.                 NAMECO(IDLU) = COLO80
  925. C                 IF (DEBCB) THEN
  926. C                   WRITE(IOIMP,*) 'NAMECO(IDLU):',NAMECO(IDLU)
  927. C      &                          ,':','LIGNE : ',NBLIGN
  928. C                 ENDIF
  929.  
  930.               ELSEIF (MOTCL8.EQ.'LOADCOL ') THEN
  931.                 NOMLOC(IDLU) = COLO80
  932. C                 IF (DEBCB) THEN
  933. C                   WRITE(IOIMP,*) 'NOMLOC(IDLU):',NOMLOC(IDLU)
  934. C      &                          ,':','LIGNE : ',NBLIGN
  935. C                 ENDIF
  936.  
  937.               ENDIF
  938.             ENDIF
  939.  
  940. C***********************************************************************
  941. C           Traitement des couleurs
  942. C***********************************************************************
  943.           ELSEIF (IRETO2.EQ.3) THEN
  944.             IF (IVALU.EQ.1) THEN
  945. C             Lecture du deuxième mot clé
  946.               MOTCL8 = COLO8
  947.  
  948. C           Lecture de d'ID
  949.             ELSEIF (IVALU.EQ.2) THEN
  950.               IDLU = NFIX
  951. C              IF (DEBCB) THEN
  952. C                WRITE(IOIMP,*) 'ID lu couleurs :',IDLU
  953. C              ENDIF
  954.  
  955. C           Lecture de l'entier représentant la couleur
  956.             ELSEIF (IVALU.EQ.3) THEN
  957.               IF (MOTCL8.EQ.' COMP   ') THEN
  958. C               Cas du sous mot clé ' COMP   '
  959.                 ICOULC(IDLU) = NFIX
  960. C                IF (DEBCB) THEN
  961. C                  WRITE(IOIMP,*) 'Couleur lue :',NFIX
  962. C                ENDIF
  963.               ENDIF
  964.             ENDIF
  965.  
  966.  
  967. C***********************************************************************
  968. C           Traitement des SETS lus dans le fichier .fem
  969. C***********************************************************************
  970.           ELSEIF (IRETO2.EQ.4) THEN
  971. C           Lecture de d'ID du SET
  972.             IF (IVALU.EQ.1) THEN
  973. C             Incrémentation du nombre de sets
  974.               NBSETS = NBSETS + 1
  975.  
  976. C             Ajustement du segment MSET
  977.               IF (NBSETS.GT.JGSELO) THEN
  978.                 INCSET = INT(REAL(INCSET) * XNCJG)
  979.                 JGSELO = NBSETS + INCSET
  980.                 SEGADJ,MSET
  981. C                IF (DEBCB) THEN
  982. C                  WRITE(IOIMP,*) 'Ajustement du segment MSET 1',JGSELU
  983. C                ENDIF
  984.               ENDIF
  985.  
  986.               IDLU = NFIX
  987.  
  988.               ISECOR(NBSETS)=IDLU
  989. C              IF (DEBCB) THEN
  990. C                WRITE(IOIMP,*)'ID du set Lu : ',IDLU
  991. C              ENDIF
  992.  
  993. C             Ajustement du segment MSET
  994.               IF (IDLU.GT.JGSELU) THEN
  995.                 INCSET = INT(REAL(INCSET) * XNCJG)
  996.                 JGSELU = IDLU + INCSET
  997.                 SEGADJ,MSET
  998. C                IF (DEBCB) THEN
  999. C                  WRITE(IOIMP,*) 'Ajustement du segment MSET 1',JGSELU
  1000. C                ENDIF
  1001.               ENDIF
  1002.             ELSEIF (IVALU.EQ.2) THEN
  1003. C             Type de set lu On s'en sert pour créer des maillages SIMPLES ou COMPLEXES
  1004. C             1 ==> Noeuds
  1005. C             2 ==> Elements
  1006. C              IF (DEBCB) THEN
  1007. C                WRITE(IOIMP,*)'Type de SET Lu : ',NFIX
  1008. C              ENDIF
  1009.               ITYSET(IDLU)=NFIX
  1010.  
  1011. C           Lecture du MOT représentant le nom du SET
  1012.             ELSEIF (IVALU.EQ.3) THEN
  1013.               COLO80 = LIGNE(IDCOL+2:80)
  1014.  
  1015. C             Retrait de la double côte représentant la fin du nom lu
  1016.               DO 330 INDICE=2,LEN(COLO80)
  1017.                 IF ((COLO80(INDICE:INDICE)).EQ.'"') THEN
  1018.                   COLO80 = COLO80(1:INDICE-1)
  1019.                 ENDIF
  1020.  330          CONTINUE
  1021.  
  1022.               NOMSET(IDLU)=COLO80
  1023. C              IF (DEBCB) THEN
  1024. C                WRITE(IOIMP,*) 'Nom du SET = ',NOMSET(IDLU)
  1025. C              ENDIF
  1026.  
  1027.  
  1028. C*******************************************
  1029. C  LECTURE du format d'écriture des SETS
  1030. C*******************************************
  1031.               NENTIT = 0
  1032.  
  1033. C             Lecture de la première ligne après la détection d'un SET
  1034.               READ(IUFEM,1000,ERR=989,END=100) COLO80
  1035.               NBLIGN = NBLIGN + 1
  1036.  
  1037.               DO INDICE=1,LEN(COLO80)
  1038.                 IF ((COLO80(INDICE:INDICE)).EQ.'=') THEN
  1039. C                 Format à vigule rencontré pour cette ligne
  1040.                   COLO80=COLO80(INDICE+2:(LEN(COLO80)))
  1041.                   IDINI=1
  1042.                   IDFIN=1
  1043. C                   IF (DEBCB) THEN
  1044. C                     WRITE(IOIMP,*)'Format a VIRGULE'
  1045. C                     WRITE(IOIMP,*)'Ligne a analyser :',COLO80
  1046. C                   ENDIF
  1047.                   GOTO 331
  1048.                 ENDIF
  1049.               ENDDO
  1050.  
  1051. C             Format Standard attendu lecture de la ligne suivante
  1052. C               IF (DEBCB) THEN
  1053. C                 WRITE(IOIMP,*)'Format STANDARD'
  1054. C               ENDIF
  1055.               GOTO 334
  1056.  
  1057. C*******************************************
  1058. C  LECTURE du format avec le séparateur ','
  1059. C*******************************************
  1060.  331          CONTINUE
  1061.               DO INDICE=IDINI,(LEN(COLO80)-1)
  1062. C                 IF (DEBCB) THEN
  1063. C                   WRITE(IOIMP,*)'Lettre:',COLO80(INDICE:INDICE),':'
  1064. C                 ENDIF
  1065.                 IF ((COLO80(INDICE:INDICE)).EQ.',') THEN
  1066.                   IDFIN=INDICE-1
  1067.                   NENTIT = NENTIT + 1
  1068.                   READ (COLO80(IDINI:IDFIN),*) IENTLU
  1069. C                   IF (DEBCB) THEN
  1070. C                     WRITE(IOIMP,*)'NOMBRE =',IENTLU
  1071. C                   ENDIF
  1072.  
  1073. C                 Ajustement du segment MSET
  1074.                   IF (IENTLU.GT.JGELLU) THEN
  1075.                     INCJGE = INT(REAL(INCJGE) * XNCJG)
  1076.                     JGELLU = IENTLU + INCJGE
  1077.                     SEGADJ,MSET
  1078.                   ENDIF
  1079.                   IF (NENTIT.GT.JGNBEL) THEN
  1080.                     INCJGE = INT(REAL(INCJGE) * XNCJG)
  1081.                     JGNBEL = NENTIT + INCJGE
  1082.                     SEGADJ,MSET
  1083.                   ENDIF
  1084.  
  1085. C                 Sauvegarde de l'entité lue
  1086.                   ILISTE(NENTIT,IDLU)=IENTLU
  1087.  
  1088.                   IDINI=INDICE+1
  1089.                   IF ((COLO80(INDICE+1:INDICE+1)).EQ.' ') THEN
  1090. C                   Lecture de la ligne suivante
  1091.                     GOTO 332
  1092.                   ENDIF
  1093.  
  1094.                 ELSEIF ((COLO80(INDICE:INDICE)).EQ.' ') THEN
  1095.                   NENTIT = NENTIT + 1
  1096.                   IDFIN=INDICE-1
  1097.                   READ (COLO80(IDINI:IDFIN),*) IENTLU
  1098. C                   IF (DEBCB) THEN
  1099. C                     WRITE(IOIMP,*)'NOMBRE =',IENTLU
  1100. C                   ENDIF
  1101.  
  1102. C                 Ajustement du segment MSET
  1103.                   IF (IENTLU.GT.JGELLU) THEN
  1104.                     INCJGE = INT(REAL(INCJGE) * XNCJG)
  1105.                     JGELLU = IENTLU + INCJGE
  1106.                     SEGADJ,MSET
  1107.                   ENDIF
  1108.                   IF (NENTIT.GT.JGNBEL) THEN
  1109.                     INCJGE = INT(REAL(INCJGE) * XNCJG)
  1110.                     JGNBEL = NENTIT + INCJGE
  1111.                     SEGADJ,MSET
  1112.                   ENDIF
  1113.  
  1114. C                 Sauvegarde de l'entité lue et du nombre d'entité lues
  1115.                   NBENTI(NBSETS)=NENTIT
  1116.                   ILISTE(NENTIT,IDLU)=IENTLU
  1117. C                 Fin de lecture du SET, retour en 10
  1118.                   GOTO 10
  1119.                 ENDIF
  1120.               ENDDO
  1121.  
  1122.  332          CONTINUE
  1123. C             Lecture des lignes incrémentale
  1124.               READ(IUFEM,1000,ERR=989,END=100) COLO80
  1125.               NBLIGN = NBLIGN + 1
  1126.  
  1127.               DO INDICE=6,LEN(COLO80)
  1128.                 IF ((COLO80(INDICE:INDICE)).NE.' ') THEN
  1129.                  COLO80=COLO80(INDICE:(LEN(COLO80)))
  1130.                   IDINI=1
  1131.                   IDFIN=1
  1132. C                   IF (DEBCB) THEN
  1133. C                     WRITE(IOIMP,*)'Ligne a analyser :',COLO80
  1134. C                   ENDIF
  1135.                 GOTO 331
  1136.                 ENDIF
  1137.               ENDDO
  1138.  
  1139. C**********************************************************************************
  1140. C  LECTURE des lignes formatées avec les balises THRU et les EXCEPT et les ENDTHRU
  1141. C**********************************************************************************
  1142.  333          CONTINUE
  1143. C              IF (DEBCB) THEN
  1144. C                WRITE(IOIMP,*)'MOT LU :',COLO80(IDINI:IDINI+7),':'
  1145. C              ENDIF
  1146.               IF ((COLO80(IDINI:IDINI+7)).EQ.'        ') THEN
  1147. C               Lecture de la ligne suivante
  1148.                 GOTO 334
  1149.  
  1150.               ELSEIF ((COLO80(IDINI:IDINI+7)).EQ.'  THRU  ') THEN
  1151.                 IDINI=IDINI+8
  1152. C                IF (DEBCB) THEN
  1153. C                  WRITE(IOIMP,*)'MOT LU :',COLO80(IDINI:IDINI+7),':'
  1154. C                ENDIF
  1155.                 READ (COLO80(IDINI:IDINI+7),*) IENTFI
  1156.                 IDINI=IDINI+8
  1157. C                 IF (DEBCB) THEN
  1158. C                   WRITE(IOIMP,*)'INITIAL =',IENTLU,'FINAL =',IENTFI
  1159. C                 ENDIF
  1160.  
  1161. C               Ajustement du segment MSET
  1162.                 IF (IENTFI.GT.JGELLU) THEN
  1163.                   INCJGE = INT(REAL(INCJGE) * XNCJG)
  1164.                   JGELLU = IENTFI + INCJGE
  1165.                   SEGADJ,MSET
  1166.                 ENDIF
  1167.  
  1168.                 DO JNDICE=(IENTLU+1),IENTFI
  1169. C                 Sauvegarde de l'entité lue
  1170.                   NENTIT = NENTIT + 1
  1171.  
  1172. C                 Ajustement du segment MSET
  1173.                   IF (NENTIT.GT.JGNBEL) THEN
  1174.                     INCJGE = INT(REAL(INCJGE) * XNCJG)
  1175.                     JGNBEL = NENTIT + INCJGE
  1176.                     SEGADJ,MSET
  1177.                   ENDIF
  1178.  
  1179.                   ILISTE(NENTIT,ISECOR(NBSETS))=JNDICE
  1180.                 ENDDO
  1181.  
  1182. C               Lecture de l'entité suivante
  1183.                 GOTO 333
  1184.  
  1185.               ELSE
  1186.                 NENTIT = NENTIT + 1
  1187.                 READ (COLO80(IDINI:IDINI+7),*) IENTLU
  1188.                 IDINI=IDINI+8
  1189. C                 IF (DEBCB) THEN
  1190. C                   WRITE(IOIMP,*)'NOMBRE =',IENTLU
  1191. C                 ENDIF
  1192.  
  1193. C               Ajustement du segment MSET
  1194.                 IF (IENTLU.GT.JGELLU) THEN
  1195.                   INCJGE = INT(REAL(INCJGE) * XNCJG)
  1196.                   JGELLU = IENTLU + INCJGE
  1197.                   SEGADJ,MSET
  1198.                 ENDIF
  1199.                 IF (NENTIT.GT.JGNBEL) THEN
  1200.                   INCJGE = INT(REAL(INCJGE) * XNCJG)
  1201.                   JGNBEL = NENTIT + INCJGE
  1202.                   SEGADJ,MSET
  1203.                 ENDIF
  1204.  
  1205. C               Sauvegarde de l'entité lue et du nombre d'entité lues
  1206.                 NBENTI(NBSETS)=NENTIT
  1207.                 ILISTE(NENTIT,ISECOR(NBSETS))=IENTLU
  1208.  
  1209. C               Lecture de l'entité suivante
  1210.                 GOTO 333
  1211.  
  1212.               ENDIF
  1213.  
  1214.  334          CONTINUE
  1215. C             Lecture des lignes incrémentale
  1216.               READ(IUFEM,1000,ERR=989,END=100) COLO80
  1217.               NBLIGN = NBLIGN + 1
  1218.  
  1219.               DO INDICE=1,LEN(COLO80)
  1220.                 IF ((COLO80(1:1)).NE.'+') THEN
  1221. C                 Fin de lecture du SET, retour en 10
  1222.                   NBENTI(NBSETS)=NENTIT
  1223. C                  IF (DEBCB) THEN
  1224. C                    WRITE(IOIMP,*)'Fin Set, NENTIT = :',NENTIT,':'
  1225. C                  ENDIF
  1226.                   GOTO 10
  1227.                 ELSE
  1228.                   COLO80=COLO80(9:(LEN(COLO80)))
  1229.                   IDINI=1
  1230. C                  IF (DEBCB) THEN
  1231. C                    WRITE(IOIMP,*)'Ligne a analyser :',COLO80,':'
  1232. C                  ENDIF
  1233.                   GOTO 333
  1234.                 ENDIF
  1235.               ENDDO
  1236.  
  1237.             ENDIF
  1238.  
  1239.  
  1240. C***********************************************************************
  1241. C           Traitement des LOAD COLLECTORS lus dans le fichier .fem
  1242. C***********************************************************************
  1243.           ELSEIF (IRETO2.EQ.5) THEN
  1244. C         Cas des SPC
  1245.             IF (BSPC .EQV. .FALSE.) THEN
  1246.               BSPC = .TRUE.
  1247.               WRITE(IOIMP,*)'       Carte non lue : ',NGTYPE(IRETO2)
  1248.             ENDIF
  1249.  
  1250.             IF (IVALU.EQ.1) THEN
  1251. C             Récupération de l'ID du LOADCOL
  1252.               IDLU = NFIX
  1253.               NBENLC(IDLU)=NBENLC(IDLU)+1
  1254.               ITYLOC(IDLU)=1
  1255.  
  1256.               NBRENT = NBENLC(IDLU)
  1257.               NUMLOC = IDLU
  1258.  
  1259.             ELSEIF (IVALU.EQ.2) THEN
  1260. C             Lecture de l'ID de l'entité LU
  1261.               IDLU = NFIX
  1262. C               IF (DEBCB) THEN
  1263. C                 WRITE(IOIMP,*) 'LOADCOL n:',NUMLOC,'NBR',NBRENT,
  1264. C      &                         'Entite',IDLU
  1265. C               ENDIF
  1266.  
  1267. C             Ajustement du segment MLOCOL
  1268.               IF (IDLU.GT.JGNBEN) THEN
  1269.                 JGNBEN = IDLU + MAX(INCJGN,INCJGE)
  1270.                 SEGADJ,MLOCOL
  1271. C                     IF (DEBCB) THEN
  1272. C                       WRITE(IOIMP,*) 'Ajustement du segment MLOCOL 3'
  1273. C                       WRITE(IOIMP,*) 'JGNBEN',JGNBEN
  1274. C                     ENDIF
  1275.               ENDIF
  1276.  
  1277. C             Sauvgarde de l'entité lue
  1278.               ILOCNO(NBRENT,NUMLOC)=IDLU
  1279.  
  1280.             ELSEIF (IVALU.EQ.3) THEN
  1281. C           Lecture des degrés de liberté bloqués
  1282.  
  1283.             ENDIF
  1284.  
  1285.           ELSEIF (IRETO2.EQ.6) THEN
  1286. C         Cas des TEMPERATURES
  1287.             IF (BTEMP .EQV. .FALSE.) THEN
  1288.               BTEMP = .TRUE.
  1289.               WRITE(IOIMP,*)'       Carte non lue : ',NGTYPE(IRETO2)
  1290.             ENDIF
  1291.  
  1292. C           Lecture de d'ID du LOAD COLLECTOR
  1293.  
  1294.           ELSEIF (IRETO2.EQ.7) THEN
  1295. C         Cas des FORCES
  1296.             IF (BFORC .EQV. .FALSE.) THEN
  1297.               BFORC = .TRUE.
  1298.               WRITE(IOIMP,*)'       Carte non lue : ',NGTYPE(IRETO2)
  1299.             ENDIF
  1300.  
  1301. C           Lecture de d'ID du LOAD COLLECTOR
  1302.  
  1303.           ELSEIF (IRETO2.EQ.8) THEN
  1304. C         Cas des MOMENTS
  1305.             IF (BMOM .EQV. .FALSE.) THEN
  1306.               BMOM = .TRUE.
  1307.               WRITE(IOIMP,*)'       Carte non lue : ',NGTYPE(IRETO2)
  1308.             ENDIF
  1309.  
  1310. C           Lecture de d'ID du LOAD COLLECTOR
  1311.  
  1312.           ELSEIF (IRETO2.EQ.9) THEN
  1313. C         Cas des PRESSIONS (Normales ou directionnelles)
  1314.             IF (BPRES .EQV. .FALSE.) THEN
  1315.               BPRES = .TRUE.
  1316.               WRITE(IOIMP,*)'       Carte non lue : ',NGTYPE(IRETO2)
  1317.             ENDIF
  1318.  
  1319. C           Lecture de d'ID du LOAD COLLECTOR
  1320.  
  1321.           ENDIF
  1322.         ENDIF
  1323.  11   CONTINUE
  1324.  
  1325. C      IF (DEBCB) THEN
  1326. C        WRITE(IOIMP,*) 'IVALU :',IVALU
  1327. C      ENDIF
  1328.  
  1329.       GOTO 10
  1330.  
  1331.  100  CONTINUE
  1332.  
  1333. C     Ajustement des segments à la fin
  1334.       IF (NBNPTS .LT. JGNOLO) THEN
  1335.         JGNOLO=NBNPTS
  1336.         NBPTS=NBANC+JGNOLO
  1337.         SEGADJ,MLINOE
  1338.         SEGADJ,MCOORD
  1339.       ENDIF
  1340.  
  1341.       IF (NELTOT .LT. JGELLO) THEN
  1342.         JGELLO = NELTOT
  1343.         JELCON = NBCONN
  1344.         SEGADJ,MLIELE
  1345.       ENDIF
  1346.  
  1347.       IF (NBCOMP .LT. JGCOLO) THEN
  1348.         JGCOLO = NBCOMP
  1349.         SEGADJ,MCOMP
  1350.       ENDIF
  1351.  
  1352.       IF (NBSETS .LT. JGSELO) THEN
  1353.         JGSELO = NBSETS
  1354.         SEGADJ,MSET
  1355.       ENDIF
  1356.  
  1357.       IF (NBLOCO .LT. JGLCLO) THEN
  1358.         JGLCLO = NBLOCO
  1359.         SEGADJ,MLOCOL
  1360.       ENDIF
  1361.  
  1362.  
  1363. CC       Affichage des nombre d'objets lus selon leur Type :
  1364. C        DO 111 INDICE = 1, LONOBJ
  1365. C          IF(INDICE.EQ.1) THEN
  1366. C            WRITE(IOIMP,*)   'Objets Geom        :',
  1367. C     &                        NOBJ(INDICE)
  1368. C          ELSEIF (INDICE.LT.LONOBJ) THEN
  1369. C            WRITE(IOIMP,*)   'Nombre de ',GETYPE(INDICE-1),' :',
  1370. C     &                       NOBJ(INDICE)
  1371. C          ELSE
  1372. C            WRITE(IOIMP,*)   'Elements total     :',
  1373. C     &                        NOBJ(INDICE)
  1374. C          ENDIF
  1375. C 111    CONTINUE
  1376. C      ENDIF
  1377.  
  1378.  
  1379.  
  1380. C***********************************************************************
  1381. C     Création du tableau des pointeurs qui vont accueillir les MELEME
  1382. C     De chaque COMPONENT pour chaque TYPE d'élément lu
  1383. C***********************************************************************
  1384. C      IF (DEBCB) THEN
  1385. C        WRITE(IOIMP,*) 'NBCOMP',NBCOMP
  1386. C      ENDIF
  1387.       DO 210 INDICE = 1, NBCOMP
  1388.         IDCOMP = ICOCOR(INDICE)
  1389.         NBSOUS = NBTYPE(IDCOMP,NBGEOM+1)
  1390. C        IF (DEBCB) THEN
  1391. C          WRITE(IOIMP,*)
  1392. C          WRITE(IOIMP,*) 'IDCOMP     :',IDCOMP
  1393. C          WRITE(IOIMP,*) 'NBSOUS',NBSOUS
  1394. C        ENDIF
  1395.         IF (NBSOUS.GT.0) THEN
  1396. C         Construction des pointeurs des MELEME : OBJETS GEOMETRIQUES SIMPLE
  1397.           DO 211 IDTYPE = 1,NBGEOM
  1398.             IF (NBELCO(IDCOMP,IDTYPE).GT.0) THEN
  1399.               IPT2   = 0
  1400.               NBSOUS = 0
  1401.               NBREF  = 0
  1402.               NBNN   = GECONN(IDTYPE)
  1403.               NBELEM = NBELCO(IDCOMP,IDTYPE)
  1404.               SEGINI,IPT2
  1405.               IPT2.ITYPEL = IELEQU(IDTYPE)
  1406.  
  1407. C             Enregistrement dans un tableau du numéro de pointeur vers le MELEME non renseigné
  1408.               NPOINT(IDCOMP,IDTYPE) = IPT2
  1409.               SEGDES,IPT2
  1410.  
  1411. C              IF (DEBCB) THEN
  1412. C                WRITE(IOIMP,*) 'IDTYPE  :',IDTYPE
  1413. C                WRITE(IOIMP,*) 'NBNN    :',GECONN(IDTYPE)
  1414. C                WRITE(IOIMP,*) 'NB_ELEM :',NBELCO(IDCOMP,IDTYPE)
  1415. C                WRITE(IOIMP,*) 'Pointeur:',IPT2
  1416. C              ENDIF
  1417.             ENDIF
  1418.  211      CONTINUE
  1419.         ENDIF
  1420.  210  CONTINUE
  1421.  
  1422.  
  1423. C***********************************************************************
  1424. C     Relecture de tous les éléments du maillage
  1425. C     pour les placer dans le bon MELEME SIMPLE
  1426. C***********************************************************************
  1427. C     Cas des éléments lus appartenant aux COMPONENT
  1428.       DO 220 INDICE = 1,NELTOT
  1429.         IDELEM = ICOREL(INDICE)
  1430.         NBNN   = IELNBN(IDELEM)
  1431.         IDCONN = IELCON(IDELEM)
  1432.         IDCOMP = IELCOM(IDELEM)
  1433.         IDTYPE = IELTYP(IDELEM)
  1434.  
  1435. C       On incrémente le nombre d'élément placés dans le MELEME
  1436.         NBELC2(IDCOMP,IDTYPE) = NBELC2(IDCOMP,IDTYPE) + 1
  1437.         IELEME = NBELC2(IDCOMP,IDTYPE)
  1438.         IDMAIL = NPOINT(IDCOMP,IDTYPE)
  1439.  
  1440. C        IF (DEBCB) THEN
  1441. C          WRITE(IOIMP,*)
  1442. C          WRITE(IOIMP,*) 'INDICE   :',INDICE
  1443. C          WRITE(IOIMP,*) 'IDELEM      :',IDELEM
  1444. C          WRITE(IOIMP,*) 'IDCOMP:',IDCOMP
  1445. C          WRITE(IOIMP,*) 'IDTYPE:',IDTYPE
  1446. C          WRITE(IOIMP,*) 'NBNN  :',NBNN
  1447. C          WRITE(IOIMP,*) 'IELEME:',IELEME
  1448. C          WRITE(IOIMP,*) 'IDMAIL:',IDMAIL
  1449. C        ENDIF
  1450.  
  1451. C       Rechargement du pointeur du bon MELEME à remplir
  1452.         IPT2   = IDMAIL
  1453.         SEGACT,IPT2*MOD
  1454. C        IPT2.ICOLOR(IELEME) = ICOULC(IDCOMP)
  1455.         IPT2.ICOLOR(IELEME) = 0
  1456.  
  1457.         DO 221 JNDICE = 1,NBNN
  1458. C         Reconstitution de la connectivité dans l'ordre Cast3M
  1459.           ITEST  = IORDCO(20* (IDTYPE-1) + JNDICE)
  1460.           IDCOLU = ICONTO(IDCONN+(ITEST-1))
  1461.           IDCOCA = ICORNO(IDCOLU)+NBANC
  1462.           IPT2.NUM(JNDICE,IELEME) = IDCOCA
  1463.  
  1464. C          IF (DEBCB) THEN
  1465. C            WRITE(IOIMP,*) 'ITEST',ITEST
  1466. C            WRITE(IOIMP,*) 'ConLU :',IDCOLU,'ConC3M:',IDCOCA
  1467. C          ENDIF
  1468.  221    CONTINUE
  1469.       SEGDES,IPT2
  1470.  220  CONTINUE
  1471.  
  1472. C***********************************************************************
  1473. C     Traitement des SETS
  1474. C***********************************************************************
  1475.       DO INDICE=1,NBSETS
  1476.         IDSET =ISECOR(INDICE)
  1477.         COLO80=NOMSET(IDSET)
  1478. C        IF (DEBCB) THEN
  1479. C          WRITE(IOIMP,*) ' '
  1480. C          WRITE(IOIMP,*) 'Nom du Set :',COLO80,':'
  1481. C          WRITE(IOIMP,*) '(ID Set,Type Set     ,Nbr Entite)',
  1482. C     &                     IDSET ,ITYSET(IDSET),NBENTI(INDICE)
  1483. C        ENDIF
  1484.  
  1485.  
  1486. C       Cas des SETS de NOEUDS
  1487.         IF (ITYSET(IDSET) .EQ. 1) THEN
  1488. C          WRITE(IOIMP,*) 'Traitement d''un SET de NOEUDS'
  1489. C          WRITE(IOIMP,*)'Indice_SET : ',INDICE
  1490. C          WRITE(IOIMP,*) 'Nombre de noeuds : ',NBENTI(INDICE)
  1491.  
  1492. C          IF (DEBCB) THEN
  1493. C            WRITE(IOIMP,*) ' '
  1494. C            WRITE(IOIMP,*) 'Nom du Set :',COLO80,':'
  1495. C            WRITE(IOIMP,*) '(ID Set,Type Set     ,Nbr Entite)',
  1496. C     &                       IDSET ,ITYSET(IDSET),NBENTI(INDICE)
  1497. C            WRITE(IOIMP,*) 'GECONN(1) = ',GECONN(1)
  1498. C          ENDIF
  1499.           IPT2   = 0
  1500.           NBSOUS = 0
  1501.           NBREF  = 0
  1502.           NBNN   = GECONN(1)
  1503.           NBELEM = NBENTI(INDICE)
  1504.           SEGINI,IPT2
  1505.           IPT2.ITYPEL = IELEQU(1)
  1506.  
  1507.           DO JNDICE=1,NBENTI(INDICE)
  1508. C             IF (DEBCB) THEN
  1509. C               WRITE(IOIMP,*) 'LISTE DES NOEUDS',ILISTE(JNDICE,INDICE)
  1510. C             ENDIF
  1511.               IPT2.NUM(1,JNDICE)=ILISTE(JNDICE,IDSET)+NBANC
  1512.  
  1513.           ENDDO
  1514.  
  1515. C         Ecriture dans la table de Sortie du MELEME SIMPLE
  1516.           CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,COLO80    ,.FALSE.,0,
  1517.      &                       'MAILLAGE',0,0.d0,'RIEN',.FALSE.,IPT2)
  1518.           IF (IERR.NE.0) THEN
  1519.             CALL ERREUR(IERR)
  1520.             RETURN
  1521.           ENDIF
  1522.           SEGDES,IPT2
  1523.  
  1524. C       Cas des SETS d'elements
  1525.         ELSEIF (ITYSET(IDSET) .EQ. 2) THEN
  1526. C          IF (DEBCB) THEN
  1527. C            WRITE(IOIMP,*) 'Traitement d''un SET d''ELEMENT'
  1528. C            WRITE(IOIMP,*)'Indice_SET : ',INDICE
  1529. C            WRITE(IOIMP,*) '(ID Set,Type Set     ,Nbr Entite)',
  1530. C     &                       IDSET ,ITYSET(IDSET),NBENTI(INDICE)
  1531. C          ENDIF
  1532.           IPT1=0
  1533.           IPT2=0
  1534.           NBELEM = NBENTI(INDICE)
  1535.  
  1536.           DO JNDICE=1,NBELEM
  1537. C           Boucle sur tous les éléments du SET
  1538.             IDELEM = ILISTE(JNDICE,IDSET)
  1539.             NBNN   = IELNBN(IDELEM)
  1540.             IDCONN = IELCON(IDELEM)
  1541.             IDTYPE = IELTYP(IDELEM)
  1542.  
  1543. C            IF (DEBCB) THEN
  1544. C              WRITE(IOIMP,*) 'LISTE DES ELEMENTS',IDELEM
  1545. C              WRITE(IOIMP,*) 'Type d''element  :',IDTYPE
  1546. C              WRITE(IOIMP,*) 'Nombre Noeuds    :',NBNN
  1547. C              WRITE(IOIMP,*) 'IDCONN           :',IDCONN
  1548. C            ENDIF
  1549.  
  1550. C           Incrément du nombre d'élément de ce TYPE pour ce SET
  1551.             NBELSE(IDSET,IDTYPE) = NBELSE(IDSET,IDTYPE) + 1
  1552.  
  1553.             IF (NBTYPS(IDSET,IDTYPE) .EQ. 0) THEN
  1554. C             Cas d'un nouveau type d'élément rencontré
  1555.  
  1556.               IF (IPT1 .NE. 0) THEN
  1557.                 SEGDES,IPT1
  1558.                 IPT1 = 0
  1559.               ENDIF
  1560.  
  1561.               NBSOUS = 0
  1562.               NBREF  = 0
  1563.               SEGINI,IPT1
  1564.               IPT1.ITYPEL=IELEQU(IDTYPE)
  1565.  
  1566. C              WRITE(IOIMP,*) 'Nouveau MELEME SIMPLE :',IDTYPE,
  1567. C     &         GELEQU(IDTYPE), IPT1
  1568.  
  1569. C             Sauvegarde du pointeur
  1570.               NPOINS(IDSET,IDTYPE)   = IPT1
  1571.  
  1572. C             Incrément du nombre de types d'éléments dans le SET
  1573.               NBTYPS(IDSET,IDTYPE)   = 1
  1574.               NBTYPS(IDSET,NBGEOM+1) = NBTYPS(IDSET,NBGEOM+1) + 1
  1575.  
  1576.               IF(NBTYPS(IDSET,NBGEOM+1) .EQ. 1) THEN
  1577. C               Cas du premier MELEME SIMPLE rencontré
  1578.                 NPOINS(IDSET,NBGEOM+1)   = IPT1
  1579. C                WRITE(IOIMP,*) 'Premier MELEME SIMPLE :',IDTYPE,
  1580. C     &         GELEQU(IDTYPE), IPT1
  1581.  
  1582.               ELSEIF (NBTYPS(IDSET,NBGEOM+1) .EQ. 2) THEN
  1583. C               Création d'un MELEME COMPLEXE
  1584.                 NBNN   = 0
  1585.                 NBELEM = 0
  1586.                 NBSOUS = 2
  1587.                 SEGINI,IPT2
  1588.                 IPT2.LISOUS(1)=NPOINS(IDSET,NBGEOM+1)
  1589.                 IPT2.LISOUS(2)=IPT1
  1590. C                WRITE(IOIMP,*) 'MELEME COMPLEXE Création :',IPT2, IPT1
  1591.  
  1592. C               Sauvegarde du MELEME COMPLEXE
  1593.                 NPOINS(IDSET,NBGEOM+1)=IPT2
  1594.  
  1595.               ELSEIF(NBTYPS(IDSET,NBGEOM+1) .GT. 2) THEN
  1596. C               Ajout au MELEME COMPLEXE du nouveau MELEME SIMPLE
  1597.                 NBNN   = 0
  1598.                 NBELEM = 0
  1599.                 NBSOUS = NBTYPS(IDSET,NBGEOM+1)
  1600.                 SEGADJ,IPT2
  1601.                 IPT2.LISOUS(NBSOUS)=IPT1
  1602.  
  1603. C                WRITE(IOIMP,*) 'MELEME COMPLEXE ajout :',IPT2, IPT1
  1604.               ENDIF
  1605.  
  1606.             ELSE
  1607. C             Cas d'un type d'élément déjà créé
  1608.               IF (NPOINS(IDSET,IDTYPE) .NE. IPT1) THEN
  1609. C               Cas ou le MELEME SIMPLE IPT1 actif n'est pas le bon
  1610.                 SEGDES,IPT1
  1611.                 IPT1 = NPOINS(IDSET,IDTYPE)
  1612.                 WRITE(IOIMP,*)'   IPT1 Charge :',IPT1
  1613.                 SEGACT,IPT1*MOD
  1614.               ENDIF
  1615.             ENDIF
  1616.  
  1617. C            WRITE(IOIMP,*)'NBNN :', IELNBN(IDELEM)
  1618. C            WRITE(IOIMP,*)'IPT1 INFO:',IPT1.NUM(/1),IPT1.NUM(/2)
  1619. C            WRITE(IOIMP,*)'Element LU :',IDELEM,'TYPE :',IDTYPE
  1620.  
  1621.             DO KNDICE=1,IELNBN(IDELEM)
  1622. C             Boucle sur la connectivité des éléments
  1623.               ITEST  = IORDCO(20* (IDTYPE-1) + KNDICE)
  1624.               IDCOLU = ICONTO(IDCONN+(ITEST-1))
  1625.               IDCOCA = ICORNO(IDCOLU)+NBANC
  1626.               IPT1.NUM(KNDICE,NBELSE(IDSET,IDTYPE)) = IDCOCA
  1627. C             WRITE(IOIMP,*)'  Connecti  LU / Cast3M:',IDCOLU,IDCOCA,
  1628. C     &                     'ITEST :',ITEST
  1629.             ENDDO
  1630.  
  1631. C            WRITE(IOIMP,*)'IPT1 :',IPT1.NUM(/1)
  1632. C            WRITE(IOIMP,*)'IPT1 :',IPT1.NUM(/2)
  1633. C            DO jjj=1,IPT1.NUM(/1)
  1634. C              DO kkk=1,IPT1.NUM(/2)
  1635. C
  1636. C                WRITE(IOIMP,*)'Connectivite :',IPT1.NUM(jjj,kkk)
  1637. C              ENDDO
  1638. C            ENDDO
  1639. C            SEGDES,IPT1
  1640.  
  1641.           ENDDO
  1642. C         Fin de la boucle sur les ELEMENTS d'un SET
  1643.  
  1644. C          WRITE(IOIMP,*)' '
  1645.  
  1646. C         Désactivation des SEGMENTS des MELEME encore ACTIFS
  1647.           IF (IPT1 .NE. 0) THEN
  1648.             SEGDES,IPT1
  1649.             IPT1 = 0
  1650.           ENDIF
  1651.           IF (IPT2 .NE. 0) THEN
  1652.             SEGDES,IPT2
  1653.             IPT2 = 0
  1654.           ENDIF
  1655.  
  1656.           DO JNDICE=1,NBGEOM
  1657. C           Ajustement de la taille des MELEME SIMPLES
  1658.             IF ( NBELSE(IDSET,JNDICE) .NE. 0 ) THEN
  1659.               IPT1 = NPOINS(IDSET,JNDICE)
  1660.               SEGACT,IPT1
  1661.  
  1662.               NBSOUS = 0
  1663.               NBREF  = 0
  1664.               NBELEM = NBELSE(IDSET,JNDICE)
  1665.               NBNN   = IPT1.NUM(/1)
  1666.               SEGADJ,IPT1
  1667.               SEGDES,IPT1
  1668. C              WRITE(IOIMP,*)'AJUSTEMENT IPT1 :',IPT1.NUM(/2),NBNN
  1669.             ENDIF
  1670.           ENDDO
  1671.  
  1672.           IPT2=NPOINS(IDSET,NBGEOM+1)
  1673. C          WRITE(IOIMP,*)'IPT2 TABLE :',IPT2
  1674.  
  1675. C          SEGACT,IPT2
  1676. C          WRITE(IOIMP,*)'Valeurs IPT2 :'
  1677. C          WRITE(IOIMP,*)' NBSOUS :',IPT2.LISOUS(/1)
  1678. C          DO iii=1,IPT2.LISOUS(/1)
  1679. C            WRITE(IOIMP,*)'  IPT1 :',IPT2.LISOUS(iii)
  1680. C            IPT1=IPT2.LISOUS(iii)
  1681. C            SEGACT,IPT1
  1682. C            DO jjj=1,IPT1.NUM(/1)
  1683. C              DO kkk=1,IPT1.NUM(/2)
  1684. C
  1685. C                WRITE(IOIMP,*)'Connectivite :',IPT1.NUM(jjj,kkk)
  1686. C              ENDDO
  1687. C            ENDDO
  1688. C            SEGDES,IPT1
  1689. C          ENDDO
  1690. C          SEGDES,IPT2
  1691.  
  1692. C         Ecriture dans la table de Sortie du MELEME SIMPLE ou COMPLEXE
  1693.           CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,COLO80    ,.FALSE.,0,
  1694.      &                       'MAILLAGE',0,0.d0,'RIEN',.FALSE.,IPT2)
  1695.           IF (IERR.NE.0) THEN
  1696.             CALL ERREUR(IERR)
  1697.             RETURN
  1698.           ENDIF
  1699.  
  1700.  
  1701.         ENDIF
  1702.       ENDDO
  1703. C     Fin de la boucle sur les SETS
  1704.  
  1705.  
  1706.  
  1707.  
  1708. C***********************************************************************
  1709. C     Création des maillages COMPLEXES composés des MELEME SIMPLES
  1710. C***********************************************************************
  1711.       DO 230 IDCOMP = 1,NBCOMP
  1712.         IDCOLU = ICOCOR(IDCOMP)
  1713.         COLO80 = NAMECO(IDCOLU)
  1714.         NBSOUS = NBTYPE(IDCOLU,NBGEOM+1)
  1715. C        IF (DEBCB) THEN
  1716. C          WRITE(IOIMP,*)
  1717. C          WRITE(IOIMP,*) 'IDCOLU',IDCOLU,'NBSOUS',NBSOUS
  1718. C        ENDIF
  1719.  
  1720.         ICOMPT = 0
  1721.         DO 231 IDTYPE = 1,NBGEOM
  1722. C         Parcours du tableau des MELEME SIMPLES
  1723.  
  1724.           IF (NBSOUS.EQ.0) THEN
  1725. C           Création d'un MELEME SIMPLE vide
  1726.             IPT1   = 0
  1727.             NBNN   = 1
  1728.             NBELEM = 0
  1729.             NBSOUS = 0
  1730.             NBREF  = 0
  1731.             SEGINI,IPT1
  1732.           ELSEIF (NBSOUS.EQ.1) THEN
  1733.             IF (NBTYPE(IDCOLU,IDTYPE).EQ.1) THEN
  1734. C             Création d'un MELEME SIMPLE à partir du premier pointeur de MELEME SIMPLE rencontré (le seul en théorie car NBSOUS=1)
  1735.               IPT1=NPOINT(IDCOLU,IDTYPE)
  1736.               SEGACT,IPT1
  1737.             ENDIF
  1738.           ELSE
  1739.             IF (NBTYPE(IDCOLU,IDTYPE).EQ.1) THEN
  1740.               IF (NPOINT(IDCOLU,NBGEOM+1).EQ.0) THEN
  1741. C               Création Initiale du MELEME COMPLEXE
  1742.                 IPT1   = 0
  1743.                 NBREF  = 0
  1744.                 NBNN   = 0
  1745.                 NBELEM = 0
  1746.                 SEGINI,IPT1
  1747.                 NPOINT(IDCOLU,NBGEOM+1) = IPT1
  1748.               ELSE
  1749. C               Chargement du MELEME COMPLEXE et complétion avec les MELEME SIMPLES rencontrés
  1750.                 IPT1 = NPOINT(IDCOLU,NBGEOM+1)
  1751.                 SEGACT,IPT1*MOD
  1752.               ENDIF
  1753.  
  1754.               ICOMPT = ICOMPT + 1
  1755.               IPT1.LISOUS(ICOMPT)=NPOINT(IDCOLU,IDTYPE)
  1756. C              IF (DEBCB) THEN
  1757. C                WRITE(IOIMP,*) 'ICOMPT',ICOMPT,'IDTYPE',IDTYPE
  1758. C                WRITE(IOIMP,*) 'Pointeur:',NPOINT(IDCOLU,IDTYPE)
  1759. C                WRITE(IOIMP,*) 'IPT1',IPT1
  1760. C              ENDIF
  1761.             ENDIF
  1762.           ENDIF
  1763.  231    CONTINUE
  1764.  
  1765. C       Ecriture dans la table de Sortie du MELEME COMPLEXE
  1766.         CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,COLO80    ,.FALSE.,0,
  1767.      &                     'MAILLAGE',0,0.d0,'RIEN',.FALSE.,IPT1)
  1768.         SEGDES,IPT1
  1769.  230  CONTINUE
  1770.  
  1771.  
  1772. C     A la fin on passe au Label 991 pour le ménage final
  1773.       GOTO 991
  1774.  
  1775.  
  1776.  989  CONTINUE
  1777. C       IF (DEBCB) THEN
  1778. C         WRITE(IOIMP,*) 'Erreur READ Wrong FORMAT (Lbl 989) : '
  1779. C       ENDIF
  1780.       CLOSE(UNIT=IUFEM,ERR=990)
  1781.       GOTO 991
  1782.  
  1783.  
  1784.  990  CONTINUE
  1785. C       IF (DEBCB) THEN
  1786. C         WRITE(IOIMP,*) 'Erreur OPEN/CLOSE (Lbl 990) : '
  1787. C       ENDIF
  1788.       GOTO 991
  1789.  
  1790.  
  1791.  991  CONTINUE
  1792.  
  1793. C Traitement des erreurs
  1794.       IF (IERR.NE.0) THEN
  1795.         CALL ERREUR(IERR)
  1796.         RETURN
  1797.       ENDIF
  1798.  
  1799. C***********************************************************************
  1800. C     Un peu de ménage dans la mémoire
  1801. C***********************************************************************
  1802.       SEGSUP,SREDLE
  1803.       SEGSUP,MLINOE
  1804.       SEGSUP,MLIELE
  1805.       SEGSUP,MELEQU
  1806.       SEGSUP,MCOMP
  1807.       SEGSUP,MSET
  1808.       SEGSUP,MLOCOL
  1809.       SEGDES,MTABLE
  1810.  
  1811.       END
  1812.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales