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

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