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  25/04/22    21:15:05     12245          
  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.  
  1098.                   TEXT=COLO80(IDINI:IDFIN)
  1099.                   NRAN=0
  1100.                   ICOUR=IDFIN
  1101.                   CALL REDLEC(sredle)
  1102.                   IENTLU = NFIX
  1103.  
  1104. C                  READ (COLO80(IDINI:IDFIN),*) IENTLU
  1105. C                   IF (DEBCB) THEN
  1106. C                     WRITE(IOIMP,*)'NOMBRE =',IENTLU
  1107. C                   ENDIF
  1108.  
  1109. C                 Ajustement du segment MSET
  1110.                   IF (IENTLU.GT.JGSELU) THEN
  1111.                     INCJGE = INT(REAL(INCJGE) * XNCJG)
  1112.                     JGSELU = IENTLU + INCJGE
  1113.                     SEGADJ,MSET
  1114.                   ENDIF
  1115.                   IF (NENTIT.GT.JGNBEL) THEN
  1116.                     INCJGE = INT(REAL(INCJGE) * XNCJG)
  1117.                     JGNBEL = NENTIT + INCJGE
  1118.                     SEGADJ,MSET
  1119.                   ENDIF
  1120.  
  1121. C                 Sauvegarde de l'entité lue
  1122.                   ILISTE(NENTIT,IDLU)=IENTLU
  1123.  
  1124.                   IDINI=INDICE+1
  1125.                   IF ((COLO80(INDICE+1:INDICE+1)).EQ.' ') THEN
  1126. C                   Lecture de la ligne suivante
  1127.                     GOTO 332
  1128.                   ENDIF
  1129.  
  1130.                 ELSEIF ((COLO80(INDICE:INDICE)).EQ.' ') THEN
  1131.                   NENTIT = NENTIT + 1
  1132.                   IDFIN=INDICE-1
  1133.  
  1134.                   TEXT=COLO80(IDINI:IDFIN)
  1135.                   NRAN=0
  1136.                   ICOUR=IDFIN
  1137.                   CALL REDLEC(sredle)
  1138. C                  PRINT *,'femv14:IRE=',IRE,NFIX
  1139.                   IENTLU = NFIX
  1140.  
  1141. C                  READ (COLO80(IDINI:IDFIN),*) IENTLU
  1142. C                   IF (DEBCB) THEN
  1143. C                     WRITE(IOIMP,*)'NOMBRE =',IENTLU
  1144. C                   ENDIF
  1145.  
  1146. C                 Ajustement du segment MSET
  1147.                   IF (IENTLU.GT.JGSELU) THEN
  1148.                     INCJGE = INT(REAL(INCJGE) * XNCJG)
  1149.                     JGSELU = IENTLU + INCJGE
  1150.                     SEGADJ,MSET
  1151.                   ENDIF
  1152.                   IF (NENTIT.GT.JGNBEL) THEN
  1153.                     INCJGE = INT(REAL(INCJGE) * XNCJG)
  1154.                     JGNBEL = NENTIT + INCJGE
  1155.                     SEGADJ,MSET
  1156.                   ENDIF
  1157.  
  1158. C                 Sauvegarde de l'entité lue et du nombre d'entité lues
  1159.                   NBENTI(NBSETS)=NENTIT
  1160.                   ILISTE(NENTIT,IDLU)=IENTLU
  1161. C                 Fin de lecture du SET, retour en 10
  1162.                   GOTO 10
  1163.                 ENDIF
  1164.               ENDDO
  1165.  
  1166.  332          CONTINUE
  1167. C             Lecture des lignes incrémentale
  1168.               READ(IUFEM,1000,ERR=989,END=100) COLO80
  1169.               NBLIGN = NBLIGN + 1
  1170.  
  1171.               DO INDICE=6,LEN(COLO80)
  1172.                 IF ((COLO80(INDICE:INDICE)).NE.' ') THEN
  1173.                  COLO80=COLO80(INDICE:(LEN(COLO80)))
  1174.                   IDINI=1
  1175.                   IDFIN=1
  1176. C                   IF (DEBCB) THEN
  1177. C                     WRITE(IOIMP,*)'Ligne a analyser :',COLO80
  1178. C                   ENDIF
  1179.                 GOTO 331
  1180.                 ENDIF
  1181.               ENDDO
  1182.  
  1183. C**********************************************************************************
  1184. C  LECTURE des lignes formatées avec les balises THRU et les EXCEPT et les ENDTHRU
  1185. C**********************************************************************************
  1186.  333          CONTINUE
  1187. C              IF (DEBCB) THEN
  1188. C                WRITE(IOIMP,*)'MOT LU :',COLO80(IDINI:IDINI+ILONG),':'
  1189. C              ENDIF
  1190.               IF ((COLO80(IDINI:IDINI+ILONG)).EQ.'  THRU  ') THEN
  1191.                 IDINI=IDINI+(ILONG+1)
  1192. C                IF (DEBCB) THEN
  1193. C                  WRITE(IOIMP,*)'MOT LU :',COLO80(IDINI:IDINI+ILONG),':'
  1194. C                ENDIF
  1195.                   TEXT=COLO80(IDINI:IDINI+ILONG)
  1196.                   NRAN=0
  1197.                   ICOUR=IDINI+ILONG
  1198.                   CALL REDLEC(sredle)
  1199.                   IENTFI = NFIX
  1200.  
  1201. C                READ (COLO80(IDINI:IDINI+ILONG),*) IENTFI
  1202.                 IDINI=IDINI+(ILONG+1)
  1203. C                 IF (DEBCB) THEN
  1204. C                   WRITE(IOIMP,*)'INITIAL =',IENTLU,'FINAL =',IENTFI
  1205. C                 ENDIF
  1206.  
  1207. C               Ajustement du segment MSET
  1208.                 IF (IENTFI.GT.JGSELU) THEN
  1209.                   INCJGE = INT(REAL(INCJGE) * XNCJG)
  1210.                   JGSELU = IENTFI + INCJGE
  1211.                   SEGADJ,MSET
  1212.                 ENDIF
  1213.  
  1214.                 DO JNDICE=(IENTLU+1),IENTFI
  1215. C                 Sauvegarde de l'entité lue
  1216.                   NENTIT = NENTIT + 1
  1217.  
  1218. C                 Ajustement du segment MSET
  1219.                   IF (NENTIT.GT.JGNBEL) THEN
  1220.                     INCJGE = INT(REAL(INCJGE) * XNCJG)
  1221.                     JGNBEL = NENTIT + INCJGE
  1222.                     SEGADJ,MSET
  1223.                   ENDIF
  1224.  
  1225.                   ILISTE(NENTIT,ISECOR(NBSETS))=JNDICE
  1226.                 ENDDO
  1227.  
  1228. C               Lecture de l'entité suivante
  1229.                 GOTO 333
  1230.  
  1231.               ELSE
  1232.                 TEXT=COLO80(IDINI:IDINI+ILONG)
  1233.                 NRAN=0
  1234.                 ICOUR=IDINI+ILONG
  1235.                 CALL REDLEC(sredle)
  1236.  
  1237.                 IF(IRE .NE. 1) THEN
  1238. C                 Lecture d'une nouvelle ligne
  1239.                   GOTO 334
  1240.  
  1241.                 ELSE
  1242.                   IENTLU = NFIX
  1243.                 ENDIF
  1244.  
  1245. C                READ (COLO80(IDINI:IDINI+ILONG),*,
  1246. C     &                ERR=334,IOSTAT=IOSTA1) IENTLU
  1247. C                IF (IOSTA1 .NE. 0) THEN
  1248. CC                 Lecture d'une nouvelle ligne
  1249. C                  PRINT *,':',COLO80(IDINI:IDINI+ILONG),':',IRE
  1250. C                  GOTO 334
  1251. C                ENDIF
  1252.                 NENTIT = NENTIT + 1
  1253.  
  1254.                 IDINI=IDINI+(ILONG+1)
  1255. C                 IF (DEBCB) THEN
  1256. C                   WRITE(IOIMP,*)'NOMBRE =',IENTLU
  1257. C                 ENDIF
  1258.  
  1259. C               Ajustement du segment MSET
  1260.                 IF (IENTLU.GT.JGSELU) THEN
  1261.                   INCJGE = INT(REAL(INCJGE) * XNCJG)
  1262.                   JGSELU = IENTLU + INCJGE
  1263.                   SEGADJ,MSET
  1264.                 ENDIF
  1265.                 IF (NENTIT.GT.JGNBEL) THEN
  1266.                   INCJGE = INT(REAL(INCJGE) * XNCJG)
  1267.                   JGNBEL = NENTIT + INCJGE
  1268.                   SEGADJ,MSET
  1269.                 ENDIF
  1270.  
  1271. C               Sauvegarde de l'entité lue et du nombre d'entité lues
  1272.                 NBENTI(NBSETS)=NENTIT
  1273.                 ILISTE(NENTIT,ISECOR(NBSETS))=IENTLU
  1274.  
  1275. C               Lecture de l'entité suivante
  1276.                 GOTO 333
  1277.  
  1278.               ENDIF
  1279.  
  1280.  334          CONTINUE
  1281. C             Lecture des lignes incrémentale
  1282.               READ(IUFEM,1000,ERR=989,END=100) COLO80
  1283.               NBLIGN = NBLIGN + 1
  1284.  
  1285.               DO INDICE=1,LEN(COLO80)
  1286.                 IF (((COLO80(1:1)).NE.'+') .AND.
  1287.      &              ((COLO80(1:1)).NE.'*')) THEN
  1288. C                 Fin de lecture du SET, retour en 10
  1289.                   NBENTI(NBSETS)=NENTIT
  1290. C                  IF (DEBCB) THEN
  1291. C                    WRITE(IOIMP,*)'Fin Set = :',NENTIT,':',NBLIGN
  1292. C                  ENDIF
  1293.                   GOTO 10
  1294.                 ELSE
  1295.                   IF ((COLO80(1:1)).EQ.'+') THEN
  1296.                     ILONG=7
  1297.                   ELSE
  1298.                     ILONG=15
  1299.                   ENDIF
  1300.                   IDINI=9
  1301. C                  IF (DEBCB) THEN
  1302. C                    WRITE(IOIMP,*)'Ligne a analyser :',COLO80,':'
  1303. C                  ENDIF
  1304.                   GOTO 333
  1305.                 ENDIF
  1306.               ENDDO
  1307.  
  1308.             ENDIF
  1309.  
  1310.  
  1311. C***********************************************************************
  1312. C           Traitement des LOAD COLLECTORS lus dans le fichier .fem
  1313. C***********************************************************************
  1314.           ELSEIF (IRETO2.EQ.5) THEN
  1315. C         Cas des SPC
  1316.             IF (BSPC .EQV. .FALSE.) THEN
  1317.               BSPC = .TRUE.
  1318.               WRITE(IOIMP,*)'       Carte non lue : ',NGTYPE(IRETO2)
  1319.             ENDIF
  1320.  
  1321.             IF (IVALU.EQ.1) THEN
  1322. C             Récupération de l'ID du LOADCOL
  1323.               IDLU = NFIX
  1324.               NBENLC(IDLU)=NBENLC(IDLU)+1
  1325.               ITYLOC(IDLU)=1
  1326.  
  1327.               NBRENT = NBENLC(IDLU)
  1328.               NUMLOC = IDLU
  1329.  
  1330.             ELSEIF (IVALU.EQ.2) THEN
  1331. C             Lecture de l'ID de l'entité LU
  1332.               IDLU = NFIX
  1333. C               IF (DEBCB) THEN
  1334. C                 WRITE(IOIMP,*) 'LOADCOL n:',NUMLOC,'NBR',NBRENT,
  1335. C      &                         'Entite',IDLU
  1336. C               ENDIF
  1337.  
  1338. C             Ajustement du segment MLOCOL
  1339.               IF (IDLU.GT.JGNBEN) THEN
  1340.                 JGNBEN = IDLU + MAX(INCJGN,INCJGE)
  1341.                 SEGADJ,MLOCOL
  1342. C                     IF (DEBCB) THEN
  1343. C                       WRITE(IOIMP,*) 'Ajustement du segment MLOCOL 3'
  1344. C                       WRITE(IOIMP,*) 'JGNBEN',JGNBEN
  1345. C                     ENDIF
  1346.               ENDIF
  1347.  
  1348. C             Sauvgarde de l'entité lue
  1349.               ILOCNO(NBRENT,NUMLOC)=IDLU
  1350.  
  1351.             ELSEIF (IVALU.EQ.3) THEN
  1352. C           Lecture des degrés de liberté bloqués
  1353.  
  1354.             ENDIF
  1355.  
  1356.           ELSEIF (IRETO2.EQ.6) THEN
  1357. C         Cas des TEMPERATURES
  1358.             IF (BTEMP .EQV. .FALSE.) THEN
  1359.               BTEMP = .TRUE.
  1360.               WRITE(IOIMP,*)'       Carte non lue : ',NGTYPE(IRETO2)
  1361.             ENDIF
  1362.  
  1363. C           Lecture de d'ID du LOAD COLLECTOR
  1364.  
  1365.           ELSEIF (IRETO2.EQ.7) THEN
  1366. C         Cas des FORCES
  1367.             IF (BFORC .EQV. .FALSE.) THEN
  1368.               BFORC = .TRUE.
  1369.               WRITE(IOIMP,*)'       Carte non lue : ',NGTYPE(IRETO2)
  1370.             ENDIF
  1371.  
  1372. C           Lecture de d'ID du LOAD COLLECTOR
  1373.  
  1374.           ELSEIF (IRETO2.EQ.8) THEN
  1375. C         Cas des MOMENTS
  1376.             IF (BMOM .EQV. .FALSE.) THEN
  1377.               BMOM = .TRUE.
  1378.               WRITE(IOIMP,*)'       Carte non lue : ',NGTYPE(IRETO2)
  1379.             ENDIF
  1380.  
  1381. C           Lecture de d'ID du LOAD COLLECTOR
  1382.  
  1383.           ELSEIF (IRETO2.EQ.9) THEN
  1384. C         Cas des PRESSIONS (Normales ou directionnelles)
  1385.             IF (BPRES .EQV. .FALSE.) THEN
  1386.               BPRES = .TRUE.
  1387.               WRITE(IOIMP,*)'       Carte non lue : ',NGTYPE(IRETO2)
  1388.             ENDIF
  1389.  
  1390. C           Lecture de d'ID du LOAD COLLECTOR
  1391.  
  1392.           ENDIF
  1393.         ENDIF
  1394.  11   CONTINUE
  1395.  
  1396. C      IF (DEBCB) THEN
  1397. C        WRITE(IOIMP,*) 'IVALU :',IVALU
  1398. C      ENDIF
  1399.  
  1400.       GOTO 10
  1401.  
  1402.  100  CONTINUE
  1403.  
  1404. C     Ajustement des segments à la fin
  1405.       IF (NBNPTS .LT. JGNOLO) THEN
  1406.         JGNOLO=NBNPTS
  1407.         NBPTS=NBANC+JGNOLO
  1408.         SEGADJ,MLINOE
  1409.         SEGADJ,MCOORD
  1410.       ENDIF
  1411.  
  1412.       IF (NELTOT .LT. JGELLO) THEN
  1413.         JGELLO = NELTOT
  1414.         JELCON = NBCONN
  1415.         SEGADJ,MLIELE
  1416.       ENDIF
  1417.  
  1418.       IF (NBCOMP .LT. JGCOLO) THEN
  1419.         JGCOLO = NBCOMP
  1420.         SEGADJ,MCOMP
  1421.       ENDIF
  1422.  
  1423.       IF (NBSETS .LT. JGSELO) THEN
  1424.         JGSELO = NBSETS
  1425.         SEGADJ,MSET
  1426.       ENDIF
  1427.  
  1428.       IF (NBLOCO .LT. JGLCLO) THEN
  1429.         JGLCLO = NBLOCO
  1430.         SEGADJ,MLOCOL
  1431.       ENDIF
  1432.  
  1433.  
  1434. CC       Affichage des nombre d'objets lus selon leur Type :
  1435. C        DO 111 INDICE = 1, LONOBJ
  1436. C          IF(INDICE.EQ.1) THEN
  1437. C            WRITE(IOIMP,*)   'Objets Geom        :',
  1438. C     &                        NOBJ(INDICE)
  1439. C          ELSEIF (INDICE.LT.LONOBJ) THEN
  1440. C            WRITE(IOIMP,*)   'Nombre de ',GETYPE(INDICE-1),' :',
  1441. C     &                       NOBJ(INDICE)
  1442. C          ELSE
  1443. C            WRITE(IOIMP,*)   'Elements total     :',
  1444. C     &                        NOBJ(INDICE)
  1445. C          ENDIF
  1446. C 111    CONTINUE
  1447. C      ENDIF
  1448.  
  1449.  
  1450.  
  1451. C***********************************************************************
  1452. C     Création du tableau des pointeurs qui vont accueillir les MELEME
  1453. C     De chaque COMPONENT pour chaque TYPE d'élément lu
  1454. C***********************************************************************
  1455. C      IF (DEBCB) THEN
  1456. C        WRITE(IOIMP,*) 'NBCOMP',NBCOMP
  1457. C      ENDIF
  1458.       DO 210 INDICE = 1, NBCOMP
  1459.         IDCOMP = ICOCOR(INDICE)
  1460.         NBSOUS = NBTYPE(IDCOMP,NBGEOM+1)
  1461. C        IF (DEBCB) THEN
  1462. C          WRITE(IOIMP,*)
  1463. C          WRITE(IOIMP,*) 'IDCOMP     :',IDCOMP
  1464. C          WRITE(IOIMP,*) 'NBSOUS',NBSOUS
  1465. C        ENDIF
  1466.         IF (NBSOUS.GT.0) THEN
  1467. C         Construction des pointeurs des MELEME : OBJETS GEOMETRIQUES SIMPLE
  1468.           DO 211 IDTYPE = 1,NBGEOM
  1469.             IF (NBELCO(IDCOMP,IDTYPE).GT.0) THEN
  1470.               NBNN   = GECONN(IDTYPE)
  1471.               NBELEM = NBELCO(IDCOMP,IDTYPE)
  1472.               NBSOUS = 0
  1473.               NBREF  = 0
  1474.               SEGINI,IPT2
  1475.               IPT2.ITYPEL = IELEQU(IDTYPE)
  1476.  
  1477. C             Enregistrement dans un tableau du numéro de pointeur vers le MELEME non renseigné
  1478.               NPOINT(IDCOMP,IDTYPE) = IPT2
  1479. C              IF (DEBCB) THEN
  1480. C                WRITE(IOIMP,*) 'IDTYPE  :',IDTYPE
  1481. C                WRITE(IOIMP,*) 'NBNN    :',GECONN(IDTYPE)
  1482. C                WRITE(IOIMP,*) 'NB_ELEM :',NBELCO(IDCOMP,IDTYPE)
  1483. C                WRITE(IOIMP,*) 'Pointeur:',IPT2
  1484. C              ENDIF
  1485.             ENDIF
  1486.  211      CONTINUE
  1487.         ENDIF
  1488.  210  CONTINUE
  1489.  
  1490.  
  1491. C***********************************************************************
  1492. C     Relecture de tous les éléments du maillage
  1493. C     pour les placer dans le bon MELEME SIMPLE
  1494. C***********************************************************************
  1495. C     Cas des éléments lus appartenant aux COMPONENT
  1496.       DO 220 INDICE = 1,NELTOT
  1497.         IDELEM = ICOREL(INDICE)
  1498.         NBNN   = IELNBN(IDELEM)
  1499.         IDCONN = IELCON(IDELEM)
  1500.         IDCOMP = IELCOM(IDELEM)
  1501.         IDTYPE = IELTYP(IDELEM)
  1502.  
  1503. C       On incrémente le nombre d'élément placés dans le MELEME
  1504.         NBELC2(IDCOMP,IDTYPE) = NBELC2(IDCOMP,IDTYPE) + 1
  1505.         IELEME = NBELC2(IDCOMP,IDTYPE)
  1506.         IDMAIL = NPOINT(IDCOMP,IDTYPE)
  1507.  
  1508. C        IF (DEBCB) THEN
  1509. C          WRITE(IOIMP,*)
  1510. C          WRITE(IOIMP,*) 'INDICE   :',INDICE
  1511. C          WRITE(IOIMP,*) 'IDELEM      :',IDELEM
  1512. C          WRITE(IOIMP,*) 'IDCOMP:',IDCOMP
  1513. C          WRITE(IOIMP,*) 'IDTYPE:',IDTYPE
  1514. C          WRITE(IOIMP,*) 'NBNN  :',NBNN
  1515. C          WRITE(IOIMP,*) 'IELEME:',IELEME
  1516. C          WRITE(IOIMP,*) 'IDMAIL:',IDMAIL
  1517. C        ENDIF
  1518.  
  1519. C       Rechargement du pointeur du bon MELEME à remplir
  1520.         IPT2   = IDMAIL
  1521. C        IPT2.ICOLOR(IELEME) = ICOULC(IDCOMP)
  1522.         IPT2.ICOLOR(IELEME) = 0
  1523.  
  1524.         DO 221 JNDICE = 1,NBNN
  1525. C         Reconstitution de la connectivité dans l'ordre Cast3M
  1526.           ITEST  = IORDCO(20* (IDTYPE-1) + JNDICE)
  1527.           IDCOLU = ICONTO(IDCONN+(ITEST-1))
  1528.           IDCOCA = ICORNO(IDCOLU)+NBANC
  1529.           IPT2.NUM(JNDICE,IELEME) = IDCOCA
  1530. C          IF (DEBCB) THEN
  1531. C            WRITE(IOIMP,*) 'ITEST',ITEST
  1532. C            WRITE(IOIMP,*) 'ConLU :',IDCOLU,'ConC3M:',IDCOCA
  1533. C          ENDIF
  1534.  221    CONTINUE
  1535.  220  CONTINUE
  1536.  
  1537. C***********************************************************************
  1538. C     Traitement des SETS
  1539. C***********************************************************************
  1540.       DO INDICE=1,NBSETS
  1541.         IDSET =ISECOR(INDICE)
  1542.         COLO80=NOMSET(IDSET)
  1543. C        IF (DEBCB) THEN
  1544. C          WRITE(IOIMP,*) ' '
  1545. C          WRITE(IOIMP,*) 'Nom du Set :',COLO80,':'
  1546. C          WRITE(IOIMP,*) '(ID Set,Type Set     ,Nbr Entite)',
  1547. C     &                     IDSET ,ITYSET(IDSET),NBENTI(INDICE)
  1548. C        ENDIF
  1549.  
  1550.  
  1551. C       Cas des SETS de NOEUDS
  1552.         IF (ITYSET(IDSET) .EQ. 1) THEN
  1553. C          IF (DEBCB) THEN
  1554. C          WRITE(IOIMP,*) 'Traitement d''un SET de NOEUDS'
  1555. C          WRITE(IOIMP,*) ' Nom du Set :',COLO80,':'
  1556. C          WRITE(IOIMP,*) ' Indice_SET : ',INDICE
  1557. C          WRITE(IOIMP,*) ' Nombre de noeuds : ',NBENTI(INDICE)
  1558. C          WRITE(IOIMP,*) ' GECONN(1) = ',GECONN(1)
  1559. C          ENDIF
  1560.  
  1561.           NBNN   = GECONN(1)
  1562.           NBELEM = NBENTI(INDICE)
  1563.           SEGINI,IPT2
  1564.           IPT2.ITYPEL = IELEQU(1)
  1565.  
  1566.           DO JNDICE=1,NBELEM
  1567. C           IF (DEBCB) THEN
  1568. C             WRITE(IOIMP,*) 'LISTE DES NOEUDS',ILISTE(JNDICE,INDICE)
  1569. C           ENDIF
  1570.             IDCOLU = ILISTE(JNDICE,IDSET)
  1571.             IDCOCA = ICORNO(IDCOLU)+NBANC
  1572.             IPT2.NUM(1,JNDICE)=IDCOCA
  1573.           ENDDO
  1574.           SEGDES,IPT2
  1575.  
  1576. C         Ecriture dans la table de Sortie du MELEME SIMPLE
  1577.           CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,COLO80    ,.FALSE.,0,
  1578.      &                       'MAILLAGE',0,0.d0,'RIEN',.FALSE.,IPT2)
  1579.           IF (IERR.NE.0) THEN
  1580.             CALL ERREUR(IERR)
  1581.             RETURN
  1582.           ENDIF
  1583.  
  1584. C       Cas des SETS d'elements
  1585.         ELSEIF (ITYSET(IDSET) .EQ. 2) THEN
  1586. C          IF (DEBCB) THEN
  1587. C            WRITE(IOIMP,*) 'Traitement d''un SET d''ELEMENT'
  1588. C            WRITE(IOIMP,*)'Indice_SET : ',INDICE
  1589. C            WRITE(IOIMP,*) '(ID Set,Type Set     ,Nbr Entite)',
  1590. C     &                       IDSET ,ITYSET(IDSET),NBENTI(INDICE)
  1591. C          ENDIF
  1592.           IPT1=0
  1593.           IPT2=0
  1594.           DO JNDICE=1,NBENTI(INDICE)
  1595. C           Boucle sur tous les éléments du SET
  1596.             IDELEM = ILISTE(JNDICE,IDSET)
  1597.             NBNN   = IELNBN(IDELEM)
  1598.             IDCONN = IELCON(IDELEM)
  1599.             IDTYPE = IELTYP(IDELEM)
  1600.  
  1601. C            IF (DEBCB) THEN
  1602. C              WRITE(IOIMP,*) 'LISTE DES ELEMENTS',IDELEM
  1603. C              WRITE(IOIMP,*) 'Type d''element  :',IDTYPE
  1604. C              WRITE(IOIMP,*) 'Nombre Noeuds    :',NBNN
  1605. C              WRITE(IOIMP,*) 'IDCONN           :',IDCONN
  1606. C            ENDIF
  1607.  
  1608. C           Incrément du nombre d'élément de ce TYPE pour ce SET
  1609.             NBELSE(IDSET,IDTYPE) = NBELSE(IDSET,IDTYPE) + 1
  1610.  
  1611.             IF (NBTYPS(IDSET,IDTYPE) .EQ. 0) THEN
  1612. C             Cas d'un nouveau type d'élément rencontré
  1613.               NBELEM = NBENTI(INDICE)
  1614.               NBSOUS = 0
  1615.               NBREF  = 0
  1616.               SEGINI,IPT1
  1617.               IPT1.ITYPEL=IELEQU(IDTYPE)
  1618.  
  1619. C             Sauvegarde du pointeur
  1620.               NPOINS(IDSET,IDTYPE)   = IPT1
  1621.  
  1622. C             Incrément du nombre de types d'éléments dans le SET
  1623.               NBTYPS(IDSET,IDTYPE)   = 1
  1624.               NBTYPS(IDSET,NBGEOM+1) = NBTYPS(IDSET,NBGEOM+1) + 1
  1625.  
  1626.               IF(NBTYPS(IDSET,NBGEOM+1) .EQ. 1) THEN
  1627. C               Cas du premier MELEME SIMPLE rencontré
  1628.                 IPT2   = IPT1
  1629.                 NPOINS(IDSET,NBGEOM+1)   = IPT2
  1630. C                WRITE(IOIMP,*) 'Premier MELEME SIMPLE :',IDTYPE,
  1631. C     &         GELEQU(IDTYPE), IPT1
  1632.  
  1633.               ELSEIF (NBTYPS(IDSET,NBGEOM+1) .EQ. 2) THEN
  1634. C               Création d'un MELEME COMPLEXE
  1635.                 NBNN   = 0
  1636.                 NBELEM = 0
  1637.                 NBSOUS = 2
  1638.                 NBREF  = 0
  1639. C                WRITE(IOIMP,*) 'MELEME COMPLEXE Création :',IPT2, IPT1
  1640.                 SEGINI,IPT2
  1641.                 IPT2.LISOUS(1)=NPOINS(IDSET,NBGEOM+1)
  1642.                 IPT2.LISOUS(2)=IPT1
  1643.                 NPOINS(IDSET,NBGEOM+1)=IPT2
  1644.  
  1645.               ELSEIF(NBTYPS(IDSET,NBGEOM+1) .GT. 2) THEN
  1646. C               Ajout au MELEME COMPLEXE du nouveau MELEME SIMPLE
  1647.                 NBNN   = 0
  1648.                 NBELEM = 0
  1649.                 NBSOUS = NBTYPS(IDSET,NBGEOM+1)
  1650.                 NBREF  = 0
  1651. C                WRITE(IOIMP,*) 'MELEME COMPLEXE ajout :',IPT2, IPT1
  1652.                 SEGADJ,IPT2
  1653.                 IPT2.LISOUS(NBSOUS)=IPT1
  1654.               ENDIF
  1655.  
  1656.             ELSE
  1657. C             Cas d'un type d'élément déjà créé
  1658.               IPT1 = NPOINS(IDSET,IDTYPE)
  1659. C              WRITE(IOIMP,*)'IPT1 Char:',IPT1,IPT1.NUM(/1),IPT1.NUM(/2)
  1660.             ENDIF
  1661.  
  1662. C            WRITE(IOIMP,*)'NBNN :', IELNBN(IDELEM)
  1663. C            WRITE(IOIMP,*)'IPT1 INFO:',IPT1.NUM(/1),IPT1.NUM(/2)
  1664. C            WRITE(IOIMP,*)'Element LU :',IDELEM,'TYPE :',IDTYPE
  1665.  
  1666.             DO KNDICE=1,IELNBN(IDELEM)
  1667. C             Boucle sur la connectivité des éléments
  1668.               ITEST  = IORDCO(20* (IDTYPE-1) + KNDICE)
  1669.               IDCOLU = ICONTO(IDCONN+(ITEST-1))
  1670.               IDCOCA = ICORNO(IDCOLU)+NBANC
  1671.               NUMELE = NBELSE(IDSET,IDTYPE)
  1672.               IPT1.NUM(KNDICE,NUMELE) = IDCOCA
  1673. C             WRITE(IOIMP,*)'  Connecti  LU / Cast3M:',IDCOLU,IDCOCA,
  1674. C     &                     'ITEST :',ITEST
  1675.             ENDDO
  1676.           ENDDO
  1677. C         Fin de la boucle sur les ELEMENTS d'un SET
  1678.  
  1679. C         Ajustement final des MELEME SIMPLES d'un SET
  1680.           DO IDTYPE=1,NBGEOM
  1681.             IPT1  = NPOINS(IDSET,IDTYPE)
  1682.             IF(IPT1 .NE. 0) THEN
  1683.               NBELEM= NBELSE(IDSET,IDTYPE)
  1684.               IF(NBELEM .NE. IPT1.NUM(/2))THEN
  1685.                 NBELEM=NBELSE(IDSET,IDTYPE)
  1686.                 NBNN  =IPT1.NUM(/1)
  1687.                 NBSOUS=0
  1688.                 NBREF =0
  1689.                 SEGADJ,IPT1
  1690.               ENDIF
  1691.               SEGDES,IPT1
  1692.             ENDIF
  1693.           ENDDO
  1694.           IPT2=NPOINS(IDSET,NBGEOM+1)
  1695.           SEGDES,IPT2
  1696.  
  1697. C         Ecriture dans la table de Sortie du MELEME SIMPLE ou COMPLEXE
  1698.           CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,COLO80    ,.FALSE.,0,
  1699.      &                       'MAILLAGE',0,0.d0,'RIEN',.FALSE.,IPT2)
  1700.           IF (IERR.NE.0) THEN
  1701.             CALL ERREUR(IERR)
  1702.             RETURN
  1703.           ENDIF
  1704.         ENDIF
  1705.       ENDDO
  1706. C     Fin de la boucle sur les SETS
  1707.  
  1708.  
  1709. C***********************************************************************
  1710. C     Création des maillages COMPLEXES composés des MELEME SIMPLES
  1711. C***********************************************************************
  1712.       DO 230 IDCOMP = 1,NBCOMP
  1713.         IDCOLU = ICOCOR(IDCOMP)
  1714.         COLO80 = NAMECO(IDCOLU)
  1715.         NBSOUS = NBTYPE(IDCOLU,NBGEOM+1)
  1716. C        IF (DEBCB) THEN
  1717. C          WRITE(IOIMP,*)
  1718. C          WRITE(IOIMP,*) 'IDCOLU',IDCOLU,'NBSOUS',NBSOUS
  1719. C        ENDIF
  1720.  
  1721.         ICOMPT = 0
  1722.         DO 231 IDTYPE = 1,NBGEOM
  1723. C         Parcours du tableau des MELEME SIMPLES
  1724.  
  1725.           IF (NBSOUS.EQ.0) THEN
  1726. C           Création d'un MELEME SIMPLE vide
  1727.             NBNN   = 0
  1728.             NBELEM = 0
  1729.             NBSOUS = 0
  1730.             NBREF  = 0
  1731.             SEGINI,IPT2
  1732.             IPT2.ITYPEL=ILCOUR
  1733.  
  1734.           ELSEIF (NBSOUS.EQ.1) THEN
  1735.             IF (NBTYPE(IDCOLU,IDTYPE).EQ.1) THEN
  1736. C             Resultat ==> MELEME SIMPLE le premier rencontré (le seul en théorie car NBSOUS=1)
  1737.               IPT2=NPOINT(IDCOLU,IDTYPE)
  1738.             ENDIF
  1739.  
  1740.           ELSE
  1741.             IF (NBTYPE(IDCOLU,IDTYPE).EQ.1) THEN
  1742.               IF (NPOINT(IDCOLU,NBGEOM+1).EQ.0) THEN
  1743. C               Création Initiale du MELEME COMPLEXE
  1744.                 NBNN   = 0
  1745.                 NBELEM = 0
  1746.                 NBREF  = 0
  1747.                 SEGINI,IPT2
  1748.  
  1749.               ELSE
  1750. C               Chargement du MELEME COMPLEXE et complétion avec les MELEME SIMPLES rencontrés
  1751.                 IPT2 = NPOINT(IDCOLU,NBGEOM+1)
  1752.               ENDIF
  1753.  
  1754.               ICOMPT = ICOMPT + 1
  1755.               IPT1=NPOINT(IDCOLU,IDTYPE)
  1756.               SEGDES,IPT1
  1757.               IPT2.LISOUS(ICOMPT)=NPOINT(IDCOLU,IDTYPE)
  1758. C              IF (DEBCB) THEN
  1759. C                WRITE(IOIMP,*) 'ICOMPT',ICOMPT,'IDTYPE',IDTYPE
  1760. C                WRITE(IOIMP,*) 'Pointeurs:',IPT2,IPT1
  1761. C              ENDIF
  1762.             ENDIF
  1763.           ENDIF
  1764.  231    CONTINUE
  1765.  
  1766. C       Ecriture dans la table de Sortie du MELEME COMPLEXE
  1767.         CALL ECCTAB(MTABLE,'MOT     ',0,0.d0,COLO80    ,.FALSE.,0,
  1768.      &                     'MAILLAGE',0,0.d0,'RIEN',.FALSE.,IPT2)
  1769.         SEGDES,IPT2
  1770.  230  CONTINUE
  1771.  
  1772.  
  1773. C     A la fin on passe au Label 991 pour le ménage final
  1774.       GOTO 991
  1775.  
  1776.  
  1777.  989  CONTINUE
  1778. C       IF (DEBCB) THEN
  1779. C         WRITE(IOIMP,*) 'Erreur READ Wrong FORMAT (Lbl 989) : '
  1780. C       ENDIF
  1781.       CLOSE(UNIT=IUFEM,ERR=990)
  1782.       GOTO 991
  1783.  
  1784.  
  1785.  990  CONTINUE
  1786. C       IF (DEBCB) THEN
  1787. C         WRITE(IOIMP,*) 'Erreur OPEN/CLOSE (Lbl 990) : '
  1788. C       ENDIF
  1789.       GOTO 991
  1790.  
  1791.  
  1792.  991  CONTINUE
  1793.  
  1794. C Traitement des erreurs
  1795.       IF (IERR.NE.0) THEN
  1796.         CALL ERREUR(IERR)
  1797.         RETURN
  1798.       ENDIF
  1799.  
  1800. C***********************************************************************
  1801. C     Un peu de ménage dans la mémoire
  1802. C***********************************************************************
  1803.       SEGSUP,SREDLE
  1804.       SEGSUP,MLINOE
  1805.       SEGSUP,MLIELE
  1806.       SEGSUP,MELEQU
  1807.       SEGSUP,MCOMP
  1808.       SEGSUP,MSET
  1809.       SEGSUP,MLOCOL
  1810.       SEGDES,MTABLE
  1811.       END
  1812.  
  1813.  
  1814.  
  1815.  
  1816.  

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