Tťlťcharger femv14.eso

Retour ŗ la liste

Numťrotation des lignes :

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

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