Tťlťcharger femv14.eso

Retour ŗ la liste

Numťrotation des lignes :

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

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