Tťlťcharger femv12.eso

Retour ŗ la liste

Numťrotation des lignes :

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

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