Télécharger la plaquette Cast3M


fr en

Télécharger femv14.eso

Retour à la liste

Numérotation des lignes : 

femv14

  1. C FEMV14    SOURCE    PV        20/03/24    21:17:23     10554          
  2.       SUBROUTINE FEMV14(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          Mars 2016
  11. C
  12. C Liste des Corrections :
  13.  
  14.  
  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 Increment de NOEUD
  304.       INCJGE = 5000                                                      C Increment d' ELEMENT
  305.       INCJCO = 5000                                                      C Increment de CONNECTIVITE
  306.       INCCOM = 10                                                        C Increment de COMPONENT
  307.       INCSET = 10                                                        C Increment de SETS
  308.       INCLOC = 10                                                        C Increment 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.       ILONG  = 0
  326.       INDICE = 0
  327.       JNDICE = 0
  328.       ICOL   = 0
  329.       ITEST  = 0
  330.       IADD   = 0
  331.       IENTLU = 0
  332.  
  333.       IPT1   = 0
  334.       IPT2   = 0
  335.  
  336.       LCOL   = 0
  337.       NCOLOL = 0
  338.       NBCONN = 0
  339.       NBCOMP = 0
  340.       NBSETS = 0
  341.       NBLOCO = 0
  342.  
  343.       NBNPTS = 0
  344.       NELTOT = 0
  345.       NENTIT = 0
  346.  
  347.       XNCJG  = REAL(2.0D0)
  348.  
  349.       PRECID = .FALSE.
  350.       BSPC   = .FALSE.
  351.       BFORC  = .FALSE.
  352.       BMOM   = .FALSE.
  353.       BPRES  = .FALSE.
  354.       BTEMP  = .FALSE.
  355. C Tableau NOBJ initialisé à 0
  356.       DO 1 INDICE = 1, LONOBJ
  357.         NOBJ(INDICE)=0
  358.  1    CONTINUE
  359.  
  360. C Segment de lecture d'une ligne ...
  361.       SEGINI,sredle
  362.       SEPARA=.FALSE.
  363.       MOT=' '
  364.  
  365. C Initialisation des segments
  366.       JGNOLU=INCJGN
  367.       JGNOLO=INCJGN
  368.       SEGINI,MLINOE
  369.  
  370.       JGELLU=INCJGE
  371.       JGELLO=INCJGE
  372.       JELCON=INCJCO
  373.       SEGINI,MLIELE
  374.  
  375.       SEGINI,MELEQU
  376.  
  377.       JGCOLU=INCCOM
  378.       JGCOLO=INCCOM
  379.       SEGINI,MCOMP
  380.  
  381.       JGNBEL=INCJGE
  382.       JGSELU=INCSET
  383.       JGSELO=INCSET
  384.       SEGINI,MSET
  385.  
  386.  
  387. C      JGENLU=INCJGE
  388.       JGNBEN=INCJGE
  389.       JGLCLU=INCLOC
  390.       JGLCLO=INCLOC
  391.       SEGINI,MLOCOL
  392.  
  393.       segact mcoord*mod
  394.       NBANC=nbpts
  395.       idimp1=IDIM+1
  396.       NBPTS=NBANC+JGNOLO
  397.       SEGADJ,MCOORD
  398.  
  399. C     Remplissage du tableau d'entier représentant la place dans NOMS (Type d'élément selon CastM3)
  400. C     La taille de NOMS est spécifiée maximum égale à 100 dans CCGEOME.INC
  401.       DO 9 INDICE = 1, NBGEOM
  402.         COLO4=GELEQU(INDICE)
  403.         CALL PLACE(NOMS,100,IRETO3,COLO4)
  404.         IELEQU(INDICE)=IRETO3
  405.  9    CONTINUE
  406.  
  407.  10   CONTINUE
  408. C     Lecture de la ligne complete (80 caracteres)
  409.       READ(IUFEM,1000,ERR=989,END=100) LIGNE
  410.       NBLIGN = NBLIGN + 1
  411.       IF (IERR .NE. 0) RETURN
  412. C       IF (DEBCB) THEN
  413. C         WRITE(IOIMP,*) 'Nombre de LIGNES : ',NBLIGN
  414. C       ENDIF
  415.  
  416. C     Premier mot de la ligne
  417.       COLO8=LIGNE(1:LEN(COLO8))
  418.       IF (COLO8(1:2) .EQ.'$$') THEN
  419. C       On ne lit pas les Commentaires HM
  420.         GOTO 10
  421.       ENDIF
  422.  
  423. C     Recherche si balise de suite d'instruction
  424.       CALL PLACE(NREPRI,NBREPR,IRETO4,COLO8)
  425.       IF (IRETO4.NE.0) THEN
  426.         GOTO 12
  427.       ENDIF
  428.  
  429. C     Recherche du caractere '*' pour la lecture en 'DOUBLE PRECISION'
  430.       DO ICOL8 =2,8
  431.         IF (COLO8(ICOL8:ICOL8) .EQ. '*') THEN
  432.           IF (COLO8 .EQ. '$HMSET* ') THEN
  433.             LIGNE(ICOL8:79)=LIGNE(ICOL8+1:80)
  434.             COLO8 = '$HMSET  '
  435.             PRECID = .FALSE.
  436.           ELSE
  437.             COLO8(ICOL8:ICOL8)=' '
  438.             PRECID = .TRUE.
  439.           ENDIF
  440.         ENDIF
  441.       ENDDO
  442.  
  443.       IRETO1 = 0
  444.       IRETO2 = 0
  445. C     Recherche dans le DATA des éléments géométriques
  446.       CALL PLACE(GETYPE,NBGEOM,IRETO1,COLO8)
  447.       IF (IRETO1.NE.0) THEN
  448.         IVALU = 0
  449. C        PRINT *,'Instruction Geo :',GETYPE(IRETO1),NBLIGN
  450.  
  451. C       Si le type rencontré n'avait pas été rencontré alors j'incrémente le nombre d'objet de ce type
  452.         IF ( NOBJ(1+IRETO1).EQ.0) THEN
  453.           NOBJ(1) = NOBJ(1) + 1
  454.         ENDIF
  455.  
  456. C       Incrémente le nombre total d'éléments lus dans la dernière case de NOBJ
  457.         IF (IRETO1.GT.2) THEN
  458.            NOBJ(LONOBJ) = NOBJ(LONOBJ) + 1
  459.         ENDIF
  460.  
  461.         NOBJ(1+IRETO1) = NOBJ(1+IRETO1)+1
  462.         NBNPTS = NOBJ(2)+NOBJ(3)
  463.         NELTOT = NOBJ(LONOBJ)
  464.         GOTO 12
  465.       ENDIF
  466.  
  467. C     Recherche dans le DATA des mots-clés non géométriques
  468.       CALL PLACE(NGTYPE,NBNGEO,IRETO2,COLO8)
  469.       IF (IRETO2.NE.0) THEN
  470.         IVALU = 0
  471. C        PRINT *,'Instruction NON Geo :',NGTYPE(IRETO2),IRETO2,NBLIGN
  472.         GOTO 12
  473.       ENDIF
  474.  
  475. C     On a rien trouve d'interessant, lecture d'une nouvelle ligne
  476.       GOTO 10
  477.  
  478.  12   CONTINUE
  479. C     Détermination du Format de Lecture des colonnes
  480.       IF (PRECID) THEN
  481.         NCOLOL = 4
  482.         LCOL   = LEN(COLO16)
  483.       ELSE
  484.         NCOLOL = 9
  485.         LCOL   = LEN(COLO8)
  486.       ENDIF
  487.  
  488. C     Boucle pour lire les Colonnes qui suivent :
  489.       IDCOL = LEN(COLO8) + 1 - LCOL
  490.       DO 11 ICOL = 1, NCOLOL
  491.         IDCOL = IDCOL + LCOL
  492.         IFCOL = IDCOL + LCOL - 1
  493. C        IF (DEBCB) THEN
  494. C          WRITE(IOIMP,*) 'IDCOL,IFCOL,LCOL :',IDCOL,IFCOL,LCOL
  495. C        ENDIF
  496.  
  497.         IF (PRECID) THEN
  498.           COLO16 = LIGNE(IDCOL:IFCOL)
  499. C         Si on ne lit rien on passe a la colonne suivante
  500.           IF (COLO16 .EQ. '                ' ) GOTO 11
  501.           TEXT   = COLO16
  502.         ELSE
  503.           COLO8  = LIGNE(IDCOL:IFCOL)
  504. C         Si on ne lit rien on passe a la colonne suivante
  505.           IF (COLO8 .EQ. '        ' ) GOTO 11
  506.           TEXT   = COLO8
  507.         ENDIF
  508.  
  509.  
  510.         ICOUR = LCOL
  511.         IFINAN= ICOUR+1
  512.  
  513. C       Correction à la volée d'une caractéristique du format .fem le 'E' n'est pas toujours mis pour les puissances négatives
  514.         IF ((.NOT. PRECID).AND.(IVALU.GE.1)) THEN
  515. C         Cas de la lecture des coordonnées d'un noeud simple precision
  516.           IF(COLO8(1:1).EQ.'-')THEN
  517.             IADD = 1
  518.           ELSE
  519.             IADD = 0
  520.           ENDIF
  521.  
  522.           DO 15 ICHAR1 = 1+IADD, LCOL
  523.             IF((COLO8(ICHAR1:ICHAR1).EQ.'-').AND.
  524.      &         (COLO8(ICHAR1-1:ICHAR1-1).NE.'e').AND.
  525.      &         (COLO8(ICHAR1-1:ICHAR1-1).NE.'E').AND.
  526.      &         (COLO8(ICHAR1-1:ICHAR1-1).NE.'d').AND.
  527.      &         (COLO8(ICHAR1-1:ICHAR1-1).NE.'D').AND.
  528.      &         (COLO8(ICHAR1-1:ICHAR1-1).NE.' '))THEN
  529.               COLO9 =COLO8(1:ICHAR1-1)//'E-'//COLO8(ICHAR1+1:LCOL)
  530.               TEXT  = COLO9
  531.               ICOUR = LEN(COLO9)
  532.               IFINAN= ICOUR+1
  533. C              WRITE(IOIMP,*) 'Nouvelle COLO9 : ',COLO9
  534.               GOTO 15
  535.             ENDIF
  536.  15       CONTINUE
  537.  
  538.         ELSEIF (PRECID .AND.(IVALU.GE.1)) THEN
  539. C         Cas de la lecture des coordonnées d'un noeud double precision
  540.           IF(COLO16(1:1).EQ.'-')THEN
  541.             IADD = 1
  542.           ELSE
  543.             IADD = 0
  544.           ENDIF
  545.  
  546.           DO 16 ICHAR1 = 1+IADD, LCOL
  547.             IF((COLO16(ICHAR1:ICHAR1).EQ.'-').AND.
  548.      &         (COLO16(ICHAR1-1:ICHAR1-1).NE.'e').AND.
  549.      &         (COLO16(ICHAR1-1:ICHAR1-1).NE.'E').AND.
  550.      &         (COLO16(ICHAR1-1:ICHAR1-1).NE.'d').AND.
  551.      &         (COLO16(ICHAR1-1:ICHAR1-1).NE.'D').AND.
  552.      &         (COLO16(ICHAR1-1:ICHAR1-1).NE.' '))THEN
  553.               COLO17 =COLO16(1:ICHAR1-1)//'E-'//
  554.      &                COLO16(ICHAR1+1:LCOL)
  555.               TEXT  = COLO17
  556.               ICOUR = LEN(COLO17)
  557.               IFINAN=ICOUR+1
  558. C              WRITE(IOIMP,*) 'Nouvelle COLO17 : ',COLO17
  559.               goto 16
  560.             ENDIF
  561.  16       CONTINUE
  562.         ENDIF
  563.  
  564.         NRAN  = 0
  565.         CALL REDLEC(sredle)
  566.  
  567. C       Poursuite dans le cas ou quelque chose a été lue
  568.         IF (IRE.NE.0) THEN
  569.           IVALU  = IVALU + 1
  570.  
  571. C          IF (DEBCB) THEN
  572. C           WRITE(IOIMP,*) 'TEXT          :',TEXT(1:ICOUR)
  573. C           WRITE(IOIMP,*) 'IVALU         :',IVALU
  574. C            IF (IRE.EQ.1) THEN
  575. C              WRITE(IOIMP,*) 'Entier Lu   :',NFIX
  576. C            ENDIF
  577. C           IF (IRE.EQ.2) THEN
  578. C             WRITE(IOIMP,*) ' Flottant Lu :',FLOT,TEXT(1:ICOUR)
  579. C           ENDIF
  580. C          ENDIF
  581.  
  582.  
  583. C***********************************************************************
  584. C           Traitement des coordonnées des Noeuds
  585. C***********************************************************************
  586.           IF ((IRETO1.EQ.1).OR.(IRETO1.EQ.2)) THEN
  587. C           Ajustement du segment MCOORD
  588.             IF (NBNPTS.GT.JGNOLO) THEN
  589.               INCJGN = INT(REAL(INCJGN) * XNCJG)
  590.               JGNOLO    = JGNOLO + INCJGN
  591.               NBPTS = JGNOLO + NBANC
  592.               SEGADJ,MLINOE
  593.               SEGADJ,MCOORD
  594. C              IF (DEBCB) THEN
  595. C                WRITE(IOIMP,*) 'Segment MCOORD Ajuste'
  596. C                WRITE(IOIMP,*) 'INCJGN : ',INCJGN
  597. C                WRITE(IOIMP,*) '   JGNOLO  : ',JGNOLO
  598. C                WRITE(IOIMP,*) 'NBPTS  : ',NBPTS
  599. C              ENDIF
  600.             ENDIF
  601.  
  602.             j=(NBANC+NBNPTS-1)*idimp1
  603.  
  604. C           Lecture du numéro du noeud (TYPE ENTIER)
  605.             IF (IVALU.EQ.1) THEN
  606. C             Prévoir erreur si pas entier lu
  607.               INOC3M(NBNPTS)=NBANC+NBNPTS
  608.               INOEHM(NBNPTS)=NFIX
  609.  
  610. C             Ajustement du segment MLINOE pour le tableau ICORNO(JGNOLU)
  611.               IF(NFIX.GT.JGNOLU) THEN
  612.                 INCJGN = INT(REAL(INCJGN) * XNCJG)
  613.                 JGNOLU = NFIX + INCJGN
  614.                 SEGADJ,MLINOE
  615.               ENDIF
  616.               ICORNO(NFIX)=NBNPTS
  617.  
  618. C           Lecture des 3 Coordonnées qui suivent le numéro du noeud (TYPE FLOT)
  619.             ELSEIF((IVALU.GT.1).AND.(IVALU.LE.4)) THEN
  620.               IF (IRE.EQ.1) THEN
  621.                 XCOOR(j+(IVALU-1))=NFIX
  622. C               IF (DEBCB) THEN
  623. C                 WRITE(IOIMP,*) 'Entier   Lu :',NFIX
  624. C                 WRITE(IOIMP,*) 'ICOL-3  :',ICOL-3
  625. C                 WRITE(IOIMP,*) 'IVALU-1 :',IVALU-1
  626. C               ENDIF
  627.               ELSEIF (IRE.EQ.2) THEN
  628.                 XCOOR(j+(IVALU-1))=FLOT
  629. C                IF (DEBCB) THEN
  630. C                 WRITE(IOIMP,*) ' Flottant Lu :',FLOT
  631. C                 WRITE(IOIMP,*) 'ICOL-3  :',ICOL-3
  632. C                 WRITE(IOIMP,*) 'IVALU-1 :',IVALU-1
  633. C                ENDIF
  634.               ENDIF
  635.             ELSEIF (IVALU.GT.4) THEN
  636.               WRITE(IOIMP,*) 'ERREUR, IVALU > 4 pour des Coordonnées'
  637.             ENDIF
  638. C           La densité n'a pas d'équivalent dans Hyper Mesh, elle est à 0.D0 par défaut
  639. C            XCOOR(j+idimp1)=REAL(0.D0)
  640.  
  641.  
  642. C***********************************************************************
  643. C           Traitement des ELEMENTS et de leur CONNECTIVITE
  644. C***********************************************************************
  645.           ELSEIF (IRETO1.GE.2) THEN
  646. C           Ajustement du segment MLIELE
  647.             IF(NELTOT.GT.JGELLO) THEN
  648.               INCJGE = INT(REAL(INCJGE) * XNCJG)
  649.               JGELLO = NELTOT + INCJGE
  650.               SEGADJ,MLIELE
  651.             ENDIF
  652.  
  653.             IF (IVALU.EQ.1) THEN
  654. C             Lecture de l'ID de l'élément
  655.               IDLU = NFIX
  656.  
  657. C             Enregistrement de la correspondance
  658.               ICOREL(NELTOT)=IDLU
  659.  
  660. C             Ajustement du segment MLIELE
  661.               IF (IDLU.GT.JGELLU) THEN
  662.                 INCJGE = INT(REAL(INCJGE) * XNCJG)
  663.                 JGELLU = IDLU + INCJGE
  664.                 SEGADJ,MLIELE
  665.               ENDIF
  666.  
  667.               IELTYP(IDLU) = IRETO1
  668.  
  669. C              IF(DEBCB) THEN
  670. C                WRITE(IOIMP,*) 'IDLU',IELTYP(IDLU),'IRETO1',IRETO1
  671. C              ENDIF
  672.  
  673.             ELSEIF (IRE.EQ.1) THEN
  674.               IF (IRETO1.EQ.3) THEN
  675. C               Cas particulier des RBE2
  676.                 IF (IVALU.EQ.3) THEN
  677. 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)
  678. C                 Je ne m'occupe pour l'instant que des supports géométriques des éléments
  679. C                  IF (DEBCB) THEN
  680. C                    WRITE(IOIMP,*) 'Degres bloques RBE2',COLO8
  681. C                  ENDIF
  682.                 ELSE
  683.                   NBCONN = NBCONN + 1
  684.                   IF (IVALU.EQ.2) THEN
  685. C                   Enregistrer ou débute la lecture de la connectivité
  686.                     IELCON(IDLU)=NBCONN
  687.                   ENDIF
  688. C                 Ajustement du segment MLIELE
  689.                   IF (NBCONN.GT.JELCON) THEN
  690.                     INCJCO = INT(REAL(INCJCO) * XNCJG)
  691.                     JELCON = NBCONN + INCJCO
  692.                     SEGADJ,MLIELE
  693.                   ENDIF
  694.  
  695. C                 Enregistrer la connectivité de l'élément
  696.                   ICONTO(NBCONN)=NFIX
  697.                   IELNBN(IDLU)=IELNBN(IDLU)+1
  698. C                  IF (DEBCB) THEN
  699. C                    WRITE(IOIMP,*) 'IVALU:',IVALU
  700. C                    WRITE(IOIMP,*) 'REB2 Connectivite :',NFIX
  701. C                  ENDIF
  702.                 ENDIF
  703.  
  704.               ELSEIF (IRETO1.EQ.4) THEN
  705. C               Cas particulier des RBE3
  706.                 IF ((IVALU.EQ.3).OR.(IVALU.EQ.4).OR.(IVALU.EQ.5)) THEN
  707. 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)
  708. C                 Je ne m'occupe pour l'instant que des supports géométriques des éléments
  709. C                  IF (DEBCB) THEN
  710. C                    WRITE(IOIMP,*) 'Degres bloques RBE2',LIGNE(IDCOL:IFCOL)
  711. C                  ENDIF
  712.                 ELSE
  713.                   NBCONN = NBCONN + 1
  714.                   IF (IVALU.EQ.2) THEN
  715. C                   Enregistrer ou débute la lecture de la connectivité
  716.                     IELCON(IDLU)=NBCONN
  717.                   ENDIF
  718. C                 Ajustement du segment MLIELE
  719.                   IF (NBCONN.GT.JELCON) THEN
  720.                     INCJCO = INT(REAL(INCJCO) * XNCJG)
  721.                     JELCON = NBCONN + INCJCO
  722.                     SEGADJ,MLIELE
  723.                   ENDIF
  724.  
  725. C                 Enregistrer la connectivité de l'élément
  726.                   ICONTO(NBCONN)=NFIX
  727.                   IELNBN(IDLU)=IELNBN(IDLU)+1
  728. C                  IF (DEBCB) THEN
  729. C                    WRITE(IOIMP,*) 'IVALU:',IVALU
  730. C                    WRITE(IOIMP,*) 'REB3 Connectivite :',NFIX
  731. C                  ENDIF
  732.                 ENDIF
  733.               ELSE
  734. C               Cas de tous les autres éléments
  735.                 IF (IVALU.EQ.2) THEN
  736. C                 Lecture de la Property à laquelle appartient l'élément
  737.                   IELPRO(IDLU)=NFIX
  738.  
  739.                 ELSE
  740.                   NBCONN = NBCONN + 1
  741.                   IF (IVALU.EQ.3) THEN
  742. C                   Enregistrer ou débute la lecture de la connectivité
  743.                     IELCON(IDLU)=NBCONN
  744.                   ENDIF
  745.  
  746. C                 Ajustement du segment MLIELE
  747.                   IF (NBCONN.GT.JELCON) THEN
  748.                     INCJCO = INT(REAL(INCJCO) * XNCJG)
  749.                     JELCON = NBCONN + INCJCO
  750.                     SEGADJ,MLIELE
  751.                   ENDIF
  752.  
  753. C                 Enregistrer la connectivité de l'élément
  754.                   ICONTO(NBCONN)=NFIX
  755.                   IELNBN(IDLU)=IELNBN(IDLU)+1
  756. C                  IF (DEBCB) THEN
  757. C                    WRITE(IOIMP,*) 'IVALU:',IVALU
  758. C                    WRITE(IOIMP,*) 'Entier Lu :',NFIX
  759. C                    WRITE(IOIMP,*) 'IELNBN(IDLU):',IELNBN(IDLU),
  760. C     &                             'IDLU:',IDLU
  761. C                  ENDIF
  762.  
  763. C                 Détection d'éléments d'ordre 2 par le nombre de noeuds dans la connectivité
  764. C                 Pour [IRETO1 >= 9] Exception car les éléments ont des noms identiques pour HM...
  765.                   IF ((IRETO1.GE.9).AND.
  766.      &                (IELNBN(IDLU).EQ.GECONN(IRETO1+1))) THEN
  767.                     IELTYP(IDLU) = IRETO1+1
  768. C                    IF (DEBCB) THEN
  769. C                      WRITE(IOIMP,*) 'IDLU:',IDLU,
  770. C     &                        'Ordre 2 IELTYP(IDLU):',IELTYP(IDLU)
  771. C                    ENDIF
  772.                     NOBJ(1+IRETO1)   = NOBJ(1+IRETO1)-1
  773.                     NOBJ(1+IRETO1+1) = NOBJ(1+IRETO1+1)+1
  774.                   ENDIF
  775.                 ENDIF
  776.               ENDIF
  777.             ENDIF
  778.  
  779. C***********************************************************************
  780. C           Répartition des éléments dans les Components adéquats
  781. C***********************************************************************
  782.           ELSEIF (IRETO2.EQ.1) THEN
  783.             IF (IVALU.EQ.1) THEN
  784.               IDCOMP = NFIX
  785. C             Ajustement du segment MCOMP
  786.               IF (IDCOMP.GT.JGCOLU) THEN
  787.                 INCCOM = INT(REAL(INCCOM) * XNCJG)
  788.                 JGCOLU = IDCOMP + INCCOM
  789.                 SEGADJ,MCOMP
  790. C                IF (DEBCB) THEN
  791. C                  WRITE(IOIMP,*) 'Ajustement du segment MCOMP 1'
  792. C                  WRITE(IOIMP,*) 'JGCOLU',JGCOLU
  793. C                ENDIF
  794.               ENDIF
  795. C             IF (DEBCB) THEN
  796. C               WRITE(IOIMP,*) 'IDCOMP',IDCOMP
  797. C             ENDIF
  798.             ELSE
  799.               IF (LIGNE(IDCOL:IDCOL+3) .EQ.'THRU') THEN
  800.                 IDLU0 = IDELEM
  801. C                IF (DEBCB) THEN
  802. C                  WRITE(IOIMP,*) 'INIT',IDLU0,LIGNE(IDCOL:IDCOL+3),':'
  803. C                ENDIF
  804.               ELSE
  805.                 IF (IRE.EQ.1) THEN
  806.                   IF (IDLU0.NE.0) THEN
  807.                     IDLU1 = NFIX
  808. C                    IF (DEBCB) THEN
  809. C                      WRITE(IOIMP,*) 'BOUCLE: ',(IDLU0+1),IDLU1,NBLIGN
  810. C                    ENDIF
  811.  
  812. C                   BOUCLE entre (IDLU0+1) et IDLU1 (IDLU0 a déjà été traité au premier passage )
  813. C                     Enregistrement de l'ID du component auquel appartient l'element
  814. C                                     du type de l'élément lu
  815. C                                     du nombre de type d'éléments dans le component et quels types sont présents
  816. C                                     du nombre d'élément de chaque type dans le component
  817.                     DO IDELEM=(IDLU0+1),IDLU1
  818.                       IELCOM(IDELEM) = IDCOMP
  819.                       IDTYPE = IELTYP(IDELEM)
  820.                       IF (NBELCO(IDCOMP,IDTYPE).EQ.0) THEN
  821.                         NBTYPE(IDCOMP,IDTYPE) = 1
  822.                         NBTYPE(IDCOMP,NBGEOM+1) =
  823.      &                         NBTYPE(IDCOMP,NBGEOM+1) + 1
  824.                       ENDIF
  825.                       NBELCO(IDCOMP,IDTYPE) = NBELCO(IDCOMP,IDTYPE)+1
  826.  
  827. C                      IF (DEBCB) THEN
  828. C                        WRITE(IOIMP,*) 'IDCOMP',IDCOMP,
  829. C     &                                 'IDBOUCLE',IDELEM,
  830. C     &                                 'IDTYPE',IDTYPE
  831. C     &                                 'NBNO  ',GECONN(IDTYPE)
  832. C                      ENDIF
  833.                     ENDDO
  834.  
  835. C                   Remise à zéro de IDLU0
  836.                     IDLU0 = 0
  837.  
  838.                   ELSE
  839. C                   Enregistrement de l'ID du component auquel appartient l'element
  840. C                                du type de l'élément lu
  841. C                                du nombre de type d'éléments dans le component et quels types sont présents
  842. C                                du nombre d'élément de chaque type dans le component
  843.                     IDELEM = NFIX
  844.                     IELCOM(IDELEM) = IDCOMP
  845.                     IDTYPE = IELTYP(IDELEM)
  846.                     IF (NBELCO(IDCOMP,IDTYPE).EQ.0) THEN
  847.                       NBTYPE(IDCOMP,IDTYPE) = 1
  848.                       NBTYPE(IDCOMP,NBGEOM+1) =
  849.      &                       NBTYPE(IDCOMP,NBGEOM+1) + 1
  850.                     ENDIF
  851.                     NBELCO(IDCOMP,IDTYPE) = NBELCO(IDCOMP,IDTYPE) + 1
  852.  
  853. C                    IF (DEBCB) THEN
  854. C                      WRITE(IOIMP,*) 'IDELEM',IDELEM,
  855. C     &                               'IDCOMP',IDCOMP,
  856. C     &                               'IDTYPE',IDTYPE,
  857. C     &                               'NBNO  ',GECONN(IDTYPE)
  858. C                    ENDIF
  859.                   ENDIF
  860.                 ENDIF
  861.               ENDIF
  862.             ENDIF
  863.  
  864. C***********************************************************************
  865. C           Traitement des noms de COMPONENT ET LOADCOL
  866. C***********************************************************************
  867.           ELSEIF (IRETO2.EQ.2) THEN
  868.             IF (IVALU.EQ.1) THEN
  869. C             Lecture du deuxième mot clé
  870.               MOTCL8 = LIGNE(IDCOL:IDCOL+LEN(COLO8)-1)
  871.  
  872.               IF (MOTCL8 .EQ. 'COMP    ' .OR.
  873.      &            MOTCL8 .EQ. 'COMP*   ') THEN
  874. C               Incrémentation du nombre de COMPONENT
  875.                 NBCOMP = NBCOMP + 1
  876. C               Ajustement du segment MCOMP
  877.                 IF (NBCOMP.GT.JGCOLO) THEN
  878.                   INCCOM = INT(REAL(INCCOM) * XNCJG)
  879.                   JGCOLO = NBCOMP + INCCOM
  880.                   SEGADJ,MCOMP
  881.                 ENDIF
  882.  
  883.               ELSEIF (MOTCL8 .EQ. 'LOADCOL ') THEN
  884. C               Incrémentation du nombre de LOADCOL
  885.                 NBLOCO = NBLOCO + 1
  886. C               Ajustement du segment MCOMP
  887.                 IF (NBLOCO.GT.JGLCLO) THEN
  888.                   INCLOC = INT(REAL(INCLOC) * XNCJG)
  889.                   JGLCLO = NBLOCO + INCLOC
  890.                   SEGADJ,MLOCOL
  891.                 ENDIF
  892.  
  893.               ELSE
  894.                 WRITE(IOIMP,*) '       Carte non lue : ',
  895.      &                          LIGNE(IDCOL:IFCOL)
  896.               ENDIF
  897.  
  898. C           Lecture de d'ID
  899.             ELSEIF (IVALU.EQ.2) THEN
  900.               IDLU = NFIX
  901.               IF (MOTCL8 .EQ. 'COMP    ' .OR.
  902.      &            MOTCL8 .EQ. 'COMP*   ') THEN
  903. C               Ajustement du segment MCOMP
  904.                 IF (IDLU.GT.JGCOLU) THEN
  905.                   INCCOM = INT(REAL(INCCOM) * XNCJG)
  906.                   JGCOLU = IDLU + INCCOM
  907.                   SEGADJ,MCOMP
  908. C                   IF (DEBCB) THEN
  909. C                     WRITE(IOIMP,*) 'Ajustement du segment MCOMP 2'
  910. C                     WRITE(IOIMP,*) 'JGCOLU',JGCOLU
  911. C                   ENDIF
  912.                 ENDIF
  913.                 ICOCOR(NBCOMP)=IDLU
  914. C                IF (DEBCB) THEN
  915. C                  WRITE(IOIMP,*) 'ID lu noms :',IDLU,'LIGNE : ',NBLIGN
  916. C                ENDIF
  917.  
  918.               ELSEIF (MOTCL8 .EQ. 'LOADCOL ') THEN
  919. C               Ajustement du segment MLOCOL
  920.                 IF (IDLU.GT.JGLCLU) THEN
  921.                   INCLOC = INT(REAL(INCLOC) * XNCJG)
  922.                   JGLCLU = IDLU + INCLOC
  923.                   SEGADJ,MLOCOL
  924. C                   IF (DEBCB) THEN
  925. C                     WRITE(IOIMP,*) 'Ajustement du segment MLOCOL 2'
  926. C                     WRITE(IOIMP,*) 'JGLCLU',JGLCLU
  927. C                   ENDIF
  928.                 ENDIF
  929.                 ILCCOR(NBLOCO)=IDLU
  930. C                 IF (DEBCB) THEN
  931. C                   WRITE(IOIMP,*) 'ID lu noms :',IDLU,'LIGNE : ',NBLIGN
  932. C                 ENDIF
  933.  
  934.               ENDIF
  935.  
  936. C           Lecture du MOT représentant le nom du COMPONENT
  937.             ELSEIF (IVALU.EQ.3) THEN
  938.               COLO80 = LIGNE(IDCOL+1:80)
  939.  
  940. C             Retrait de la double côte représentant la fin du nom lu
  941.               DO INDICE=2,LEN(COLO80)
  942.                 IF ((COLO80(INDICE:INDICE)).EQ.'"') THEN
  943.                   COLO80 = COLO80(1:INDICE-1)
  944.                   GOTO 320
  945.                 ENDIF
  946.               ENDDO
  947.  
  948.  320          CONTINUE
  949.               IF (MOTCL8 .EQ. 'COMP    ' .OR.
  950.      &            MOTCL8 .EQ. 'COMP*   ') THEN
  951.                 NAMECO(IDLU) = COLO80
  952. C                 IF (DEBCB) THEN
  953. C                   WRITE(IOIMP,*) 'NAMECO(IDLU):',NAMECO(IDLU)
  954. C     &                           ,':','LIGNE : ',NBLIGN
  955. C                 ENDIF
  956.  
  957.               ELSEIF (LIGNE(IDCOL:IFCOL) .EQ. 'LOADCOL ') THEN
  958.                 NOMLOC(IDLU) = COLO80
  959. C                 IF (DEBCB) THEN
  960. C                   WRITE(IOIMP,*) 'NOMLOC(IDLU):',NOMLOC(IDLU)
  961. C      &                          ,':','LIGNE : ',NBLIGN
  962. C                 ENDIF
  963.  
  964.               ENDIF
  965.             ENDIF
  966.  
  967. C***********************************************************************
  968. C           Traitement des couleurs
  969. C***********************************************************************
  970.           ELSEIF (IRETO2.EQ.3) THEN
  971.             IF (IVALU.EQ.1) THEN
  972. C             Lecture du deuxième mot clé
  973.               MOTCL8 = LIGNE(IDCOL:IDCOL+LEN(COLO8)-1)
  974.  
  975. C           Lecture de d'ID
  976.             ELSEIF (IVALU.EQ.2) THEN
  977.               IDLU = NFIX
  978. C              IF (DEBCB) THEN
  979. C                WRITE(IOIMP,*) 'ID lu couleurs :',IDLU
  980. C              ENDIF
  981.  
  982. C           Lecture de l'entier représentant la couleur
  983.             ELSEIF (IVALU.EQ.3) THEN
  984.               IF (MOTCL8 .EQ. ' COMP   ' .OR.
  985.      &            MOTCL8 .EQ. ' COMP*  ') THEN
  986. C               Cas du sous mot clé ' COMP   '
  987.                 ICOULC(IDLU) = NFIX
  988. C                IF (DEBCB) THEN
  989. C                  WRITE(IOIMP,*) 'Couleur lue :',NFIX
  990. C                ENDIF
  991.               ENDIF
  992.             ENDIF
  993.  
  994.  
  995. C***********************************************************************
  996. C           Traitement des SETS lus dans le fichier .fem
  997. C***********************************************************************
  998.           ELSEIF (IRETO2.EQ.4) THEN
  999. C           Lecture de d'ID du SET
  1000.             IF (IVALU.EQ.1) THEN
  1001. C             Incrémentation du nombre de sets
  1002.               NBSETS = NBSETS + 1
  1003.  
  1004. C             Ajustement du segment MSET
  1005.               IF (NBSETS.GT.JGSELO) THEN
  1006.                 INCSET = INT(REAL(INCSET) * XNCJG)
  1007.                 JGSELO = NBSETS + INCSET
  1008.                 SEGADJ,MSET
  1009. C                IF (DEBCB) THEN
  1010. C                  WRITE(IOIMP,*) 'Ajustement du segment MSET 1',JGSELO
  1011. C                ENDIF
  1012.               ENDIF
  1013.  
  1014.               IDLU = NFIX
  1015.  
  1016.               ISECOR(NBSETS)=IDLU
  1017. C              IF (DEBCB) THEN
  1018. C                WRITE(IOIMP,*)'ID du set Lu : ',IDLU
  1019. C              ENDIF
  1020.  
  1021. C             Ajustement du segment MSET
  1022.               IF (IDLU.GT.JGSELU) THEN
  1023.                 INCSET = INT(REAL(INCSET) * XNCJG)
  1024.                 JGSELU = IDLU + INCSET
  1025.                 SEGADJ,MSET
  1026. C                IF (DEBCB) THEN
  1027. C                  WRITE(IOIMP,*) 'Ajustement du segment MSET 1',JGSELU
  1028. C                ENDIF
  1029.               ENDIF
  1030.             ELSEIF (IVALU.EQ.2) THEN
  1031. C             Type de set lu On s'en sert pour créer des maillages SIMPLES ou COMPLEXES
  1032. C             1 ==> Noeuds
  1033. C             2 ==> Elements
  1034. C              IF (DEBCB) THEN
  1035. C                WRITE(IOIMP,*)'Type de SET Lu : ',NFIX
  1036. C              ENDIF
  1037.               ITYSET(IDLU)=NFIX
  1038.  
  1039. C           Lecture du MOT représentant le nom du SET
  1040.             ELSEIF (IVALU.EQ.3) THEN
  1041.               COLO80 = LIGNE(IDCOL+2:80)
  1042.  
  1043. C             Retrait de la double côte représentant la fin du nom lu
  1044.               DO 330 INDICE=2,LEN(COLO80)
  1045.                 IF ((COLO80(INDICE:INDICE)).EQ.'"') THEN
  1046.                   COLO80 = COLO80(1:INDICE-1)
  1047.                 ENDIF
  1048.  330          CONTINUE
  1049.  
  1050.               NOMSET(IDLU)=COLO80
  1051. C              IF (DEBCB) THEN
  1052. C                WRITE(IOIMP,*) 'Nom du SET = ',COLO80(1:INDICE-1)
  1053. C              ENDIF
  1054.  
  1055.  
  1056. C*******************************************
  1057. C  LECTURE du format d'écriture des SETS
  1058. C*******************************************
  1059.               NENTIT = 0
  1060.  
  1061. C             Lecture de la première ligne après la détection d'un SET
  1062.               READ(IUFEM,1000,ERR=989,END=100) COLO80
  1063.               READ(IUFEM,1000,ERR=989,END=100) COLO80
  1064.               NBLIGN = NBLIGN + 2
  1065.  
  1066.               DO INDICE=1,LEN(COLO80)
  1067.                 IF ((COLO80(INDICE:INDICE)).EQ.'=') THEN
  1068. C                 Format à vigule rencontré pour cette ligne
  1069.                   COLO80=COLO80(INDICE+2:(LEN(COLO80)))
  1070.                   IDINI=1
  1071.                   IDFIN=1
  1072. C                   IF (DEBCB) THEN
  1073. C                     WRITE(IOIMP,*)'Format a VIRGULE'
  1074. C                     WRITE(IOIMP,*)'Ligne a analyser :',COLO80
  1075. C                   ENDIF
  1076.                   GOTO 331
  1077.                 ENDIF
  1078.               ENDDO
  1079.  
  1080. C             Format Standard attendu lecture de la ligne suivante
  1081. C               IF (DEBCB) THEN
  1082. C                 WRITE(IOIMP,*)'Format STANDARD'
  1083. C               ENDIF
  1084.               GOTO 334
  1085.  
  1086. C*******************************************
  1087. C  LECTURE du format avec le séparateur ','
  1088. C*******************************************
  1089.  331          CONTINUE
  1090.               DO INDICE=IDINI,(LEN(COLO80)-1)
  1091. C                 IF (DEBCB) THEN
  1092. C                   WRITE(IOIMP,*)'Lettre:',COLO80(INDICE:INDICE),':'
  1093. C                 ENDIF
  1094.                 IF ((COLO80(INDICE:INDICE)).EQ.',') THEN
  1095.                   IDFIN=INDICE-1
  1096.                   NENTIT = NENTIT + 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.JGSELU) THEN
  1104.                     INCJGE = INT(REAL(INCJGE) * XNCJG)
  1105.                     JGSELU = 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
  1115.                   ILISTE(NENTIT,IDLU)=IENTLU
  1116.  
  1117.                   IDINI=INDICE+1
  1118.                   IF ((COLO80(INDICE+1:INDICE+1)).EQ.' ') THEN
  1119. C                   Lecture de la ligne suivante
  1120.                     GOTO 332
  1121.                   ENDIF
  1122.  
  1123.                 ELSEIF ((COLO80(INDICE:INDICE)).EQ.' ') THEN
  1124.                   NENTIT = NENTIT + 1
  1125.                   IDFIN=INDICE-1
  1126.                   READ (COLO80(IDINI:IDFIN),*) IENTLU
  1127. C                   IF (DEBCB) THEN
  1128. C                     WRITE(IOIMP,*)'NOMBRE =',IENTLU
  1129. C                   ENDIF
  1130.  
  1131. C                 Ajustement du segment MSET
  1132.                   IF (IENTLU.GT.JGSELU) THEN
  1133.                     INCJGE = INT(REAL(INCJGE) * XNCJG)
  1134.                     JGSELU = IENTLU + INCJGE
  1135.                     SEGADJ,MSET
  1136.                   ENDIF
  1137.                   IF (NENTIT.GT.JGNBEL) THEN
  1138.                     INCJGE = INT(REAL(INCJGE) * XNCJG)
  1139.                     JGNBEL = NENTIT + INCJGE
  1140.                     SEGADJ,MSET
  1141.                   ENDIF
  1142.  
  1143. C                 Sauvegarde de l'entité lue et du nombre d'entité lues
  1144.                   NBENTI(NBSETS)=NENTIT
  1145.                   ILISTE(NENTIT,IDLU)=IENTLU
  1146. C                 Fin de lecture du SET, retour en 10
  1147.                   GOTO 10
  1148.                 ENDIF
  1149.               ENDDO
  1150.  
  1151.  332          CONTINUE
  1152. C             Lecture des lignes incrémentale
  1153.               READ(IUFEM,1000,ERR=989,END=100) COLO80
  1154.               NBLIGN = NBLIGN + 1
  1155.  
  1156.               DO INDICE=6,LEN(COLO80)
  1157.                 IF ((COLO80(INDICE:INDICE)).NE.' ') THEN
  1158.                  COLO80=COLO80(INDICE:(LEN(COLO80)))
  1159.                   IDINI=1
  1160.                   IDFIN=1
  1161. C                   IF (DEBCB) THEN
  1162. C                     WRITE(IOIMP,*)'Ligne a analyser :',COLO80
  1163. C                   ENDIF
  1164.                 GOTO 331
  1165.                 ENDIF
  1166.               ENDDO
  1167.  
  1168. C**********************************************************************************
  1169. C  LECTURE des lignes formatées avec les balises THRU et les EXCEPT et les ENDTHRU
  1170. C**********************************************************************************
  1171.  333          CONTINUE
  1172. C              IF (DEBCB) THEN
  1173. C                WRITE(IOIMP,*)'MOT LU :',COLO80(IDINI:IDINI+ILONG),':'
  1174. C              ENDIF
  1175.               IF ((COLO80(IDINI:IDINI+ILONG)).EQ.'  THRU  ') THEN
  1176.                 IDINI=IDINI+(ILONG+1)
  1177. C                IF (DEBCB) THEN
  1178. C                  WRITE(IOIMP,*)'MOT LU :',COLO80(IDINI:IDINI+ILONG),':'
  1179. C                ENDIF
  1180.                 READ (COLO80(IDINI:IDINI+ILONG),*) IENTFI
  1181.                 IDINI=IDINI+(ILONG+1)
  1182. C                 IF (DEBCB) THEN
  1183. C                   WRITE(IOIMP,*)'INITIAL =',IENTLU,'FINAL =',IENTFI
  1184. C                 ENDIF
  1185.  
  1186. C               Ajustement du segment MSET
  1187.                 IF (IENTFI.GT.JGSELU) THEN
  1188.                   INCJGE = INT(REAL(INCJGE) * XNCJG)
  1189.                   JGSELU = IENTFI + INCJGE
  1190.                   SEGADJ,MSET
  1191.                 ENDIF
  1192.  
  1193.                 DO JNDICE=(IENTLU+1),IENTFI
  1194. C                 Sauvegarde de l'entité lue
  1195.                   NENTIT = NENTIT + 1
  1196.  
  1197. C                 Ajustement du segment MSET
  1198.                   IF (NENTIT.GT.JGNBEL) THEN
  1199.                     INCJGE = INT(REAL(INCJGE) * XNCJG)
  1200.                     JGNBEL = NENTIT + INCJGE
  1201.                     SEGADJ,MSET
  1202.                   ENDIF
  1203.  
  1204.                   ILISTE(NENTIT,ISECOR(NBSETS))=JNDICE
  1205.                 ENDDO
  1206.  
  1207. C               Lecture de l'entité suivante
  1208.                 GOTO 333
  1209.  
  1210.               ELSE
  1211.                 READ (COLO80(IDINI:IDINI+ILONG),*,
  1212.      &                ERR=334,IOSTAT=IOSTA1) IENTLU
  1213.                 IF (IOSTA1 .NE. 0) THEN
  1214. C                 Lecture d'une nouvelle ligne
  1215.                   GOTO 334
  1216.                 ENDIF
  1217.                 NENTIT = NENTIT + 1
  1218.  
  1219.                 IDINI=IDINI+(ILONG+1)
  1220. C                 IF (DEBCB) THEN
  1221. C                   WRITE(IOIMP,*)'NOMBRE =',IENTLU
  1222. C                 ENDIF
  1223.  
  1224. C               Ajustement du segment MSET
  1225.                 IF (IENTLU.GT.JGSELU) THEN
  1226.                   INCJGE = INT(REAL(INCJGE) * XNCJG)
  1227.                   JGSELU = IENTLU + INCJGE
  1228.                   SEGADJ,MSET
  1229.                 ENDIF
  1230.                 IF (NENTIT.GT.JGNBEL) THEN
  1231.                   INCJGE = INT(REAL(INCJGE) * XNCJG)
  1232.                   JGNBEL = NENTIT + INCJGE
  1233.                   SEGADJ,MSET
  1234.                 ENDIF
  1235.  
  1236. C               Sauvegarde de l'entité lue et du nombre d'entité lues
  1237.                 NBENTI(NBSETS)=NENTIT
  1238.                 ILISTE(NENTIT,ISECOR(NBSETS))=IENTLU
  1239.  
  1240. C               Lecture de l'entité suivante
  1241.                 GOTO 333
  1242.  
  1243.               ENDIF
  1244.  
  1245.  334          CONTINUE
  1246. C             Lecture des lignes incrémentale
  1247.               READ(IUFEM,1000,ERR=989,END=100) COLO80
  1248.               NBLIGN = NBLIGN + 1
  1249.  
  1250.               DO INDICE=1,LEN(COLO80)
  1251.                 IF (((COLO80(1:1)).NE.'+') .AND.
  1252.      &              ((COLO80(1:1)).NE.'*')) THEN
  1253. C                 Fin de lecture du SET, retour en 10
  1254.                   NBENTI(NBSETS)=NENTIT
  1255. C                  IF (DEBCB) THEN
  1256. C                    WRITE(IOIMP,*)'Fin Set = :',NENTIT,':',NBLIGN
  1257. C                  ENDIF
  1258.                   GOTO 10
  1259.                 ELSE
  1260.                   IF ((COLO80(1:1)).EQ.'+') THEN
  1261.                     ILONG=7
  1262.                   ELSE
  1263.                     ILONG=15
  1264.                   ENDIF
  1265.                   IDINI=9
  1266. C                  IF (DEBCB) THEN
  1267. C                    WRITE(IOIMP,*)'Ligne a analyser :',COLO80,':'
  1268. C                  ENDIF
  1269.                   GOTO 333
  1270.                 ENDIF
  1271.               ENDDO
  1272.  
  1273.             ENDIF
  1274.  
  1275.  
  1276. C***********************************************************************
  1277. C           Traitement des LOAD COLLECTORS lus dans le fichier .fem
  1278. C***********************************************************************
  1279.           ELSEIF (IRETO2.EQ.5) THEN
  1280. C         Cas des SPC
  1281.             IF (BSPC .EQV. .FALSE.) THEN
  1282.               BSPC = .TRUE.
  1283.               WRITE(IOIMP,*)'       Carte non lue : ',NGTYPE(IRETO2)
  1284.             ENDIF
  1285.  
  1286.             IF (IVALU.EQ.1) THEN
  1287. C             Récupération de l'ID du LOADCOL
  1288.               IDLU = NFIX
  1289.               NBENLC(IDLU)=NBENLC(IDLU)+1
  1290.               ITYLOC(IDLU)=1
  1291.  
  1292.               NBRENT = NBENLC(IDLU)
  1293.               NUMLOC = IDLU
  1294.  
  1295.             ELSEIF (IVALU.EQ.2) THEN
  1296. C             Lecture de l'ID de l'entité LU
  1297.               IDLU = NFIX
  1298. C               IF (DEBCB) THEN
  1299. C                 WRITE(IOIMP,*) 'LOADCOL n:',NUMLOC,'NBR',NBRENT,
  1300. C      &                         'Entite',IDLU
  1301. C               ENDIF
  1302.  
  1303. C             Ajustement du segment MLOCOL
  1304.               IF (IDLU.GT.JGNBEN) THEN
  1305.                 JGNBEN = IDLU + MAX(INCJGN,INCJGE)
  1306.                 SEGADJ,MLOCOL
  1307. C                     IF (DEBCB) THEN
  1308. C                       WRITE(IOIMP,*) 'Ajustement du segment MLOCOL 3'
  1309. C                       WRITE(IOIMP,*) 'JGNBEN',JGNBEN
  1310. C                     ENDIF
  1311.               ENDIF
  1312.  
  1313. C             Sauvgarde de l'entité lue
  1314.               ILOCNO(NBRENT,NUMLOC)=IDLU
  1315.  
  1316.             ELSEIF (IVALU.EQ.3) THEN
  1317. C           Lecture des degrés de liberté bloqués
  1318.  
  1319.             ENDIF
  1320.  
  1321.           ELSEIF (IRETO2.EQ.6) THEN
  1322. C         Cas des TEMPERATURES
  1323.             IF (BTEMP .EQV. .FALSE.) THEN
  1324.               BTEMP = .TRUE.
  1325.               WRITE(IOIMP,*)'       Carte non lue : ',NGTYPE(IRETO2)
  1326.             ENDIF
  1327.  
  1328. C           Lecture de d'ID du LOAD COLLECTOR
  1329.  
  1330.           ELSEIF (IRETO2.EQ.7) THEN
  1331. C         Cas des FORCES
  1332.             IF (BFORC .EQV. .FALSE.) THEN
  1333.               BFORC = .TRUE.
  1334.               WRITE(IOIMP,*)'       Carte non lue : ',NGTYPE(IRETO2)
  1335.             ENDIF
  1336.  
  1337. C           Lecture de d'ID du LOAD COLLECTOR
  1338.  
  1339.           ELSEIF (IRETO2.EQ.8) THEN
  1340. C         Cas des MOMENTS
  1341.             IF (BMOM .EQV. .FALSE.) THEN
  1342.               BMOM = .TRUE.
  1343.               WRITE(IOIMP,*)'       Carte non lue : ',NGTYPE(IRETO2)
  1344.             ENDIF
  1345.  
  1346. C           Lecture de d'ID du LOAD COLLECTOR
  1347.  
  1348.           ELSEIF (IRETO2.EQ.9) THEN
  1349. C         Cas des PRESSIONS (Normales ou directionnelles)
  1350.             IF (BPRES .EQV. .FALSE.) THEN
  1351.               BPRES = .TRUE.
  1352.               WRITE(IOIMP,*)'       Carte non lue : ',NGTYPE(IRETO2)
  1353.             ENDIF
  1354.  
  1355. C           Lecture de d'ID du LOAD COLLECTOR
  1356.  
  1357.           ENDIF
  1358.         ENDIF
  1359.  11   CONTINUE
  1360.  
  1361. C      IF (DEBCB) THEN
  1362. C        WRITE(IOIMP,*) 'IVALU :',IVALU
  1363. C      ENDIF
  1364.  
  1365.       GOTO 10
  1366.  
  1367.  100  CONTINUE
  1368.  
  1369. C     Ajustement des segments à la fin
  1370.       IF (NBNPTS .LT. JGNOLO) THEN
  1371.         JGNOLO=NBNPTS
  1372.         NBPTS=NBANC+JGNOLO
  1373.         SEGADJ,MLINOE
  1374.         SEGADJ,MCOORD
  1375.       ENDIF
  1376.  
  1377.       IF (NELTOT .LT. JGELLO) THEN
  1378.         JGELLO = NELTOT
  1379.         JELCON = NBCONN
  1380.         SEGADJ,MLIELE
  1381.       ENDIF
  1382.  
  1383.       IF (NBCOMP .LT. JGCOLO) THEN
  1384.         JGCOLO = NBCOMP
  1385.         SEGADJ,MCOMP
  1386.       ENDIF
  1387.  
  1388.       IF (NBSETS .LT. JGSELO) THEN
  1389.         JGSELO = NBSETS
  1390.         SEGADJ,MSET
  1391.       ENDIF
  1392.  
  1393.       IF (NBLOCO .LT. JGLCLO) THEN
  1394.         JGLCLO = NBLOCO
  1395.         SEGADJ,MLOCOL
  1396.       ENDIF
  1397.  
  1398.  
  1399. CC       Affichage des nombre d'objets lus selon leur Type :
  1400. C        DO 111 INDICE = 1, LONOBJ
  1401. C          IF(INDICE.EQ.1) THEN
  1402. C            WRITE(IOIMP,*)   'Objets Geom        :',
  1403. C     &                        NOBJ(INDICE)
  1404. C          ELSEIF (INDICE.LT.LONOBJ) THEN
  1405. C            WRITE(IOIMP,*)   'Nombre de ',GETYPE(INDICE-1),' :',
  1406. C     &                       NOBJ(INDICE)
  1407. C          ELSE
  1408. C            WRITE(IOIMP,*)   'Elements total     :',
  1409. C     &                        NOBJ(INDICE)
  1410. C          ENDIF
  1411. C 111    CONTINUE
  1412. C      ENDIF
  1413.  
  1414.  
  1415.  
  1416. C***********************************************************************
  1417. C     Création du tableau des pointeurs qui vont accueillir les MELEME
  1418. C     De chaque COMPONENT pour chaque TYPE d'élément lu
  1419. C***********************************************************************
  1420. C      IF (DEBCB) THEN
  1421. C        WRITE(IOIMP,*) 'NBCOMP',NBCOMP
  1422. C      ENDIF
  1423.       DO 210 INDICE = 1, NBCOMP
  1424.         IDCOMP = ICOCOR(INDICE)
  1425.         NBSOUS = NBTYPE(IDCOMP,NBGEOM+1)
  1426. C        IF (DEBCB) THEN
  1427. C          WRITE(IOIMP,*)
  1428. C          WRITE(IOIMP,*) 'IDCOMP     :',IDCOMP
  1429. C          WRITE(IOIMP,*) 'NBSOUS',NBSOUS
  1430. C        ENDIF
  1431.         IF (NBSOUS.GT.0) THEN
  1432. C         Construction des pointeurs des MELEME : OBJETS GEOMETRIQUES SIMPLE
  1433.           DO 211 IDTYPE = 1,NBGEOM
  1434.             IF (NBELCO(IDCOMP,IDTYPE).GT.0) THEN
  1435.               NBNN   = GECONN(IDTYPE)
  1436.               NBELEM = NBELCO(IDCOMP,IDTYPE)
  1437.               NBSOUS = 0
  1438.               NBREF  = 0
  1439.               SEGINI,IPT2
  1440.               IPT2.ITYPEL = IELEQU(IDTYPE)
  1441.  
  1442. C             Enregistrement dans un tableau du numéro de pointeur vers le MELEME non renseigné
  1443.               NPOINT(IDCOMP,IDTYPE) = IPT2
  1444. C              IF (DEBCB) THEN
  1445. C                WRITE(IOIMP,*) 'IDTYPE  :',IDTYPE
  1446. C                WRITE(IOIMP,*) 'NBNN    :',GECONN(IDTYPE)
  1447. C                WRITE(IOIMP,*) 'NB_ELEM :',NBELCO(IDCOMP,IDTYPE)
  1448. C                WRITE(IOIMP,*) 'Pointeur:',IPT2
  1449. C              ENDIF
  1450.             ENDIF
  1451.  211      CONTINUE
  1452.         ENDIF
  1453.  210  CONTINUE
  1454.  
  1455.  
  1456. C***********************************************************************
  1457. C     Relecture de tous les éléments du maillage
  1458. C     pour les placer dans le bon MELEME SIMPLE
  1459. C***********************************************************************
  1460. C     Cas des éléments lus appartenant aux COMPONENT
  1461.       DO 220 INDICE = 1,NELTOT
  1462.         IDELEM = ICOREL(INDICE)
  1463.         NBNN   = IELNBN(IDELEM)
  1464.         IDCONN = IELCON(IDELEM)
  1465.         IDCOMP = IELCOM(IDELEM)
  1466.         IDTYPE = IELTYP(IDELEM)
  1467.  
  1468. C       On incrémente le nombre d'élément placés dans le MELEME
  1469.         NBELC2(IDCOMP,IDTYPE) = NBELC2(IDCOMP,IDTYPE) + 1
  1470.         IELEME = NBELC2(IDCOMP,IDTYPE)
  1471.         IDMAIL = NPOINT(IDCOMP,IDTYPE)
  1472.  
  1473. C        IF (DEBCB) THEN
  1474. C          WRITE(IOIMP,*)
  1475. C          WRITE(IOIMP,*) 'INDICE   :',INDICE
  1476. C          WRITE(IOIMP,*) 'IDELEM      :',IDELEM
  1477. C          WRITE(IOIMP,*) 'IDCOMP:',IDCOMP
  1478. C          WRITE(IOIMP,*) 'IDTYPE:',IDTYPE
  1479. C          WRITE(IOIMP,*) 'NBNN  :',NBNN
  1480. C          WRITE(IOIMP,*) 'IELEME:',IELEME
  1481. C          WRITE(IOIMP,*) 'IDMAIL:',IDMAIL
  1482. C        ENDIF
  1483.  
  1484. C       Rechargement du pointeur du bon MELEME à remplir
  1485.         IPT2   = IDMAIL
  1486. C        IPT2.ICOLOR(IELEME) = ICOULC(IDCOMP)
  1487.         IPT2.ICOLOR(IELEME) = 0
  1488.  
  1489.         DO 221 JNDICE = 1,NBNN
  1490. C         Reconstitution de la connectivité dans l'ordre Cast3M
  1491.           ITEST  = IORDCO(20* (IDTYPE-1) + JNDICE)
  1492.           IDCOLU = ICONTO(IDCONN+(ITEST-1))
  1493.           IDCOCA = ICORNO(IDCOLU)+NBANC
  1494.           IPT2.NUM(JNDICE,IELEME) = IDCOCA
  1495. C          IF (DEBCB) THEN
  1496. C            WRITE(IOIMP,*) 'ITEST',ITEST
  1497. C            WRITE(IOIMP,*) 'ConLU :',IDCOLU,'ConC3M:',IDCOCA
  1498. C          ENDIF
  1499.  221    CONTINUE
  1500.  220  CONTINUE
  1501.  
  1502. C***********************************************************************
  1503. C     Traitement des SETS
  1504. C***********************************************************************
  1505.       DO INDICE=1,NBSETS
  1506.         IDSET =ISECOR(INDICE)
  1507.         COLO80=NOMSET(IDSET)
  1508. C        IF (DEBCB) THEN
  1509. C          WRITE(IOIMP,*) ' '
  1510. C          WRITE(IOIMP,*) 'Nom du Set :',COLO80,':'
  1511. C          WRITE(IOIMP,*) '(ID Set,Type Set     ,Nbr Entite)',
  1512. C     &                     IDSET ,ITYSET(IDSET),NBENTI(INDICE)
  1513. C        ENDIF
  1514.  
  1515.  
  1516. C       Cas des SETS de NOEUDS
  1517.         IF (ITYSET(IDSET) .EQ. 1) THEN
  1518. C          IF (DEBCB) THEN
  1519. C          WRITE(IOIMP,*) 'Traitement d''un SET de NOEUDS'
  1520. C          WRITE(IOIMP,*) ' Nom du Set :',COLO80,':'
  1521. C          WRITE(IOIMP,*) ' Indice_SET : ',INDICE
  1522. C          WRITE(IOIMP,*) ' Nombre de noeuds : ',NBENTI(INDICE)
  1523. C          WRITE(IOIMP,*) ' GECONN(1) = ',GECONN(1)
  1524. C          ENDIF
  1525.  
  1526.           NBNN   = GECONN(1)
  1527.           NBELEM = NBENTI(INDICE)
  1528.           SEGINI,IPT2
  1529.           IPT2.ITYPEL = IELEQU(1)
  1530.  
  1531.           DO JNDICE=1,NBELEM
  1532. C           IF (DEBCB) THEN
  1533. C             WRITE(IOIMP,*) 'LISTE DES NOEUDS',ILISTE(JNDICE,INDICE)
  1534. C           ENDIF
  1535.             IDCOLU = ILISTE(JNDICE,IDSET)
  1536.             IDCOCA = ICORNO(IDCOLU)+NBANC
  1537.             IPT2.NUM(1,JNDICE)=IDCOCA
  1538.           ENDDO
  1539.           SEGDES,IPT2
  1540.  
  1541. C         Ecriture dans la table de Sortie du MELEME SIMPLE
  1542.           CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,COLO80    ,.FALSE.,0,
  1543.      &                       'MAILLAGE',0,0.d0,'RIEN',.FALSE.,IPT2)
  1544.           IF (IERR.NE.0) THEN
  1545.             CALL ERREUR(IERR)
  1546.             RETURN
  1547.           ENDIF
  1548.  
  1549. C       Cas des SETS d'elements
  1550.         ELSEIF (ITYSET(IDSET) .EQ. 2) THEN
  1551. C          IF (DEBCB) THEN
  1552. C            WRITE(IOIMP,*) 'Traitement d''un SET d''ELEMENT'
  1553. C            WRITE(IOIMP,*)'Indice_SET : ',INDICE
  1554. C            WRITE(IOIMP,*) '(ID Set,Type Set     ,Nbr Entite)',
  1555. C     &                       IDSET ,ITYSET(IDSET),NBENTI(INDICE)
  1556. C          ENDIF
  1557.           IPT1=0
  1558.           IPT2=0
  1559.           DO JNDICE=1,NBENTI(INDICE)
  1560. C           Boucle sur tous les éléments du SET
  1561.             IDELEM = ILISTE(JNDICE,IDSET)
  1562.             NBNN   = IELNBN(IDELEM)
  1563.             IDCONN = IELCON(IDELEM)
  1564.             IDTYPE = IELTYP(IDELEM)
  1565.  
  1566. C            IF (DEBCB) THEN
  1567. C              WRITE(IOIMP,*) 'LISTE DES ELEMENTS',IDELEM
  1568. C              WRITE(IOIMP,*) 'Type d''element  :',IDTYPE
  1569. C              WRITE(IOIMP,*) 'Nombre Noeuds    :',NBNN
  1570. C              WRITE(IOIMP,*) 'IDCONN           :',IDCONN
  1571. C            ENDIF
  1572.  
  1573. C           Incrément du nombre d'élément de ce TYPE pour ce SET
  1574.             NBELSE(IDSET,IDTYPE) = NBELSE(IDSET,IDTYPE) + 1
  1575.  
  1576.             IF (NBTYPS(IDSET,IDTYPE) .EQ. 0) THEN
  1577. C             Cas d'un nouveau type d'élément rencontré
  1578.               NBELEM = NBENTI(INDICE)
  1579.               NBSOUS = 0
  1580.               NBREF  = 0
  1581.               SEGINI,IPT1
  1582.               IPT1.ITYPEL=IELEQU(IDTYPE)
  1583.  
  1584. C             Sauvegarde du pointeur
  1585.               NPOINS(IDSET,IDTYPE)   = IPT1
  1586.  
  1587. C             Incrément du nombre de types d'éléments dans le SET
  1588.               NBTYPS(IDSET,IDTYPE)   = 1
  1589.               NBTYPS(IDSET,NBGEOM+1) = NBTYPS(IDSET,NBGEOM+1) + 1
  1590.  
  1591.               IF(NBTYPS(IDSET,NBGEOM+1) .EQ. 1) THEN
  1592. C               Cas du premier MELEME SIMPLE rencontré
  1593.                 IPT2   = IPT1
  1594.                 NPOINS(IDSET,NBGEOM+1)   = IPT2
  1595. C                WRITE(IOIMP,*) 'Premier MELEME SIMPLE :',IDTYPE,
  1596. C     &         GELEQU(IDTYPE), IPT1
  1597.  
  1598.               ELSEIF (NBTYPS(IDSET,NBGEOM+1) .EQ. 2) THEN
  1599. C               Création d'un MELEME COMPLEXE
  1600.                 NBNN   = 0
  1601.                 NBELEM = 0
  1602.                 NBSOUS = 2
  1603.                 NBREF  = 0
  1604. C                WRITE(IOIMP,*) 'MELEME COMPLEXE Création :',IPT2, IPT1
  1605.                 SEGINI,IPT2
  1606.                 IPT2.LISOUS(1)=NPOINS(IDSET,NBGEOM+1)
  1607.                 IPT2.LISOUS(2)=IPT1
  1608.                 NPOINS(IDSET,NBGEOM+1)=IPT2
  1609.  
  1610.               ELSEIF(NBTYPS(IDSET,NBGEOM+1) .GT. 2) THEN
  1611. C               Ajout au MELEME COMPLEXE du nouveau MELEME SIMPLE
  1612.                 NBNN   = 0
  1613.                 NBELEM = 0
  1614.                 NBSOUS = NBTYPS(IDSET,NBGEOM+1)
  1615.                 NBREF  = 0
  1616. C                WRITE(IOIMP,*) 'MELEME COMPLEXE ajout :',IPT2, IPT1
  1617.                 SEGADJ,IPT2
  1618.                 IPT2.LISOUS(NBSOUS)=IPT1
  1619.               ENDIF
  1620.  
  1621.             ELSE
  1622. C             Cas d'un type d'élément déjà créé
  1623.               IPT1 = NPOINS(IDSET,IDTYPE)
  1624. C              WRITE(IOIMP,*)'IPT1 Char:',IPT1,IPT1.NUM(/1),IPT1.NUM(/2)
  1625.             ENDIF
  1626.  
  1627. C            WRITE(IOIMP,*)'NBNN :', IELNBN(IDELEM)
  1628. C            WRITE(IOIMP,*)'IPT1 INFO:',IPT1.NUM(/1),IPT1.NUM(/2)
  1629. C            WRITE(IOIMP,*)'Element LU :',IDELEM,'TYPE :',IDTYPE
  1630.  
  1631.             DO KNDICE=1,IELNBN(IDELEM)
  1632. C             Boucle sur la connectivité des éléments
  1633.               ITEST  = IORDCO(20* (IDTYPE-1) + KNDICE)
  1634.               IDCOLU = ICONTO(IDCONN+(ITEST-1))
  1635.               IDCOCA = ICORNO(IDCOLU)+NBANC
  1636.               NUMELE = NBELSE(IDSET,IDTYPE)
  1637.               IPT1.NUM(KNDICE,NUMELE) = IDCOCA
  1638. C             WRITE(IOIMP,*)'  Connecti  LU / Cast3M:',IDCOLU,IDCOCA,
  1639. C     &                     'ITEST :',ITEST
  1640.             ENDDO
  1641.           ENDDO
  1642. C         Fin de la boucle sur les ELEMENTS d'un SET
  1643.  
  1644. C         Ajustement final des MELEME SIMPLES d'un SET
  1645.           DO IDTYPE=1,NBGEOM
  1646.             IPT1  = NPOINS(IDSET,IDTYPE)
  1647.             IF(IPT1 .NE. 0) THEN
  1648.               NBELEM= NBELSE(IDSET,IDTYPE)
  1649.               IF(NBELEM .NE. IPT1.NUM(/2))THEN
  1650.                 NBELEM=NBELSE(IDSET,IDTYPE)
  1651.                 NBNN  =IPT1.NUM(/1)
  1652.                 NBSOUS=0
  1653.                 NBREF =0
  1654.                 SEGADJ,IPT1                
  1655.               ENDIF
  1656.               SEGDES,IPT1
  1657.             ENDIF
  1658.           ENDDO
  1659.           IPT2=NPOINS(IDSET,NBGEOM+1)
  1660.           SEGDES,IPT2
  1661.  
  1662. C         Ecriture dans la table de Sortie du MELEME SIMPLE ou COMPLEXE
  1663.           CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,COLO80    ,.FALSE.,0,
  1664.      &                       'MAILLAGE',0,0.d0,'RIEN',.FALSE.,IPT2)
  1665.           IF (IERR.NE.0) THEN
  1666.             CALL ERREUR(IERR)
  1667.             RETURN
  1668.           ENDIF
  1669.         ENDIF
  1670.       ENDDO
  1671. C     Fin de la boucle sur les SETS
  1672.  
  1673.  
  1674. C***********************************************************************
  1675. C     Création des maillages COMPLEXES composés des MELEME SIMPLES
  1676. C***********************************************************************
  1677.       DO 230 IDCOMP = 1,NBCOMP
  1678.         IDCOLU = ICOCOR(IDCOMP)
  1679.         COLO80 = NAMECO(IDCOLU)
  1680.         NBSOUS = NBTYPE(IDCOLU,NBGEOM+1)
  1681. C        IF (DEBCB) THEN
  1682. C          WRITE(IOIMP,*)
  1683. C          WRITE(IOIMP,*) 'IDCOLU',IDCOLU,'NBSOUS',NBSOUS
  1684. C        ENDIF
  1685.  
  1686.         ICOMPT = 0
  1687.         DO 231 IDTYPE = 1,NBGEOM
  1688. C         Parcours du tableau des MELEME SIMPLES
  1689.  
  1690.           IF (NBSOUS.EQ.0) THEN
  1691. C           Création d'un MELEME SIMPLE vide
  1692.             NBNN   = 0
  1693.             NBELEM = 0
  1694.             NBSOUS = 0
  1695.             NBREF  = 0
  1696.             SEGINI,IPT2
  1697.             IPT2.ITYPEL=ILCOUR
  1698.  
  1699.           ELSEIF (NBSOUS.EQ.1) THEN
  1700.             IF (NBTYPE(IDCOLU,IDTYPE).EQ.1) THEN
  1701. C             Resultat ==> MELEME SIMPLE le premier rencontré (le seul en théorie car NBSOUS=1)
  1702.               IPT2=NPOINT(IDCOLU,IDTYPE)
  1703.             ENDIF
  1704.  
  1705.           ELSE
  1706.             IF (NBTYPE(IDCOLU,IDTYPE).EQ.1) THEN
  1707.               IF (NPOINT(IDCOLU,NBGEOM+1).EQ.0) THEN
  1708. C               Création Initiale du MELEME COMPLEXE
  1709.                 NBNN   = 0
  1710.                 NBELEM = 0
  1711.                 NBREF  = 0
  1712.                 SEGINI,IPT2
  1713.  
  1714.               ELSE
  1715. C               Chargement du MELEME COMPLEXE et complétion avec les MELEME SIMPLES rencontrés
  1716.                 IPT2 = NPOINT(IDCOLU,NBGEOM+1)
  1717.               ENDIF
  1718.  
  1719.               ICOMPT = ICOMPT + 1
  1720.               IPT1=NPOINT(IDCOLU,IDTYPE)
  1721.               SEGDES,IPT1
  1722.               IPT2.LISOUS(ICOMPT)=NPOINT(IDCOLU,IDTYPE)
  1723. C              IF (DEBCB) THEN
  1724. C                WRITE(IOIMP,*) 'ICOMPT',ICOMPT,'IDTYPE',IDTYPE
  1725. C                WRITE(IOIMP,*) 'Pointeurs:',IPT2,IPT1
  1726. C              ENDIF
  1727.             ENDIF
  1728.           ENDIF
  1729.  231    CONTINUE
  1730.  
  1731. C       Ecriture dans la table de Sortie du MELEME COMPLEXE
  1732.         CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,COLO80    ,.FALSE.,0,
  1733.      &                     'MAILLAGE',0,0.d0,'RIEN',.FALSE.,IPT2)
  1734.         SEGDES,IPT2
  1735.  230  CONTINUE
  1736.  
  1737.  
  1738. C     A la fin on passe au Label 991 pour le ménage final
  1739.       GOTO 991
  1740.  
  1741.  
  1742.  989  CONTINUE
  1743. C       IF (DEBCB) THEN
  1744. C         WRITE(IOIMP,*) 'Erreur READ Wrong FORMAT (Lbl 989) : '
  1745. C       ENDIF
  1746.       CLOSE(UNIT=IUFEM,ERR=990)
  1747.       GOTO 991
  1748.  
  1749.  
  1750.  990  CONTINUE
  1751. C       IF (DEBCB) THEN
  1752. C         WRITE(IOIMP,*) 'Erreur OPEN/CLOSE (Lbl 990) : '
  1753. C       ENDIF
  1754.       GOTO 991
  1755.  
  1756.  
  1757.  991  CONTINUE
  1758.  
  1759. C Traitement des erreurs
  1760.       IF (IERR.NE.0) THEN
  1761.         CALL ERREUR(IERR)
  1762.         RETURN
  1763.       ENDIF
  1764.  
  1765. C***********************************************************************
  1766. C     Un peu de ménage dans la mémoire
  1767. C***********************************************************************
  1768.       SEGSUP,SREDLE
  1769.       SEGSUP,MLINOE
  1770.       SEGSUP,MLIELE
  1771.       SEGSUP,MELEQU
  1772.       SEGSUP,MCOMP
  1773.       SEGSUP,MSET
  1774.       SEGSUP,MLOCOL
  1775.       SEGDES,MTABLE
  1776.       END
  1777.  
  1778.  
  1779.  
  1780.  

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