Télécharger liravs.eso

Retour à la liste

Numérotation des lignes :

  1. C LIRAVS SOURCE FANDEUR 14/01/08 21:15:08 7902
  2.  
  3. SUBROUTINE LIRAVS
  4.  
  5. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  6. C
  7. C BUT: Lecture des données provenant de AVS sous forme de
  8. C fichier UCD (Unstructured Cell Data) ASCII. Les données
  9. C sont logées dans une table qui est renvoyée comme
  10. C résultat.
  11. C
  12. C Auteur : Michel Bulik
  13. C Septembre 1994
  14. C
  15. C Appelé par : LIREFI
  16. C
  17. C FA7902 Modifications ordre des noeuds pour TE10
  18. C (2014/01) Ajout lecture commentaires entete du fichier
  19. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  20.  
  21. IMPLICIT INTEGER(I-N)
  22. IMPLICIT REAL*8(A-H,O-Z)
  23.  
  24. -INC CCOPTIO
  25. -INC CCREDLE
  26.  
  27. -INC SMCOORD
  28. -INC SMELEME
  29. -INC SMTABLE
  30. -INC SMCHAML
  31. -INC SMCHPOI
  32.  
  33. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  34.  
  35. SEGMENT LISTMA
  36. POINTEUR PTMA(NBSZEL).MELEME
  37. INTEGER MATER(NBSZEL)
  38. INTEGER TYPDEL(NBSZEL)
  39. INTEGER NUMEMA(NOMBEL)
  40. INTEGER NUMELE(NOMBEL)
  41. ENDSEGMENT
  42.  
  43. C
  44. C Description du segment LISTMA (LISTe des MAillages)
  45. C
  46. C Paramètres : NBSZEL - NomBre de Sous Zones ELémentaires
  47. C NOMBEL - NOMBre total des ELéments
  48. C
  49. C Tableaux : PTMA - PoinTeurs sur des MAillages élémentaires
  50. C MATER - numéros des MATERiaux des sous-zones
  51. C TYPDEL - TYPes Des ELéments des sous-zones (=ITYPEL)
  52. C NUMEMA - NUMEros des MAillages auquels appartiennent
  53. C les éléments (1..NBSZEL)
  54. C NUMELE - le NUMéro de l'ELEment dans sa sous zone
  55. C
  56. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  57.  
  58. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  59.  
  60. SEGMENT LISTCO
  61. CHARACTER*4 LESNOM(NBCOMP)
  62. REAL*8 LESCOM(NBDELE,NBCOMP)
  63. ENDSEGMENT
  64.  
  65. C
  66. C Description du segment LISTCO (LISTe des COmposantes du MCHAML)
  67. C
  68. C Paramètres : NBCOMP - le NomBre des COMPosantes
  69. C NBDELE - le NomBre D'ELEments
  70. C
  71. C Tableaux : LESNOM - LES NOMs des composantes (j'ai mis exprès 4
  72. C et non 8 à cause de problèmes + tard)
  73. C LESCOM - LES COMposantes elles memes
  74. C
  75. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  76.  
  77. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  78.  
  79. SEGMENT LISGRC
  80. INTEGER LESGRC(NBGRCO)
  81. ENDSEGMENT
  82.  
  83. C
  84. C Description du segment LISGRC (LISTe des GRoupes de Composantes)
  85. C
  86. C Paramètres : NBGRCO - le NomBre de GRoupes de COmposantes
  87. C
  88. C Tableaux : LESGRC - LES GRoupes des Composantes
  89. C
  90. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  91.  
  92. CHARACTER*8 MTYPEL
  93. C ... Tableau où on stocke temporairement les connectivités lues ...
  94. INTEGER ICONNT(20)
  95.  
  96. C ... Conversion MAJUSCULE/minuscule
  97. CHARACTER*26 MINU,MAJU
  98.  
  99. C ... Tableaux de conversion de connectivités (IC<nom_élément>) ...
  100. DIMENSION ICPOI1( 1)
  101. DIMENSION ICSEG2( 2)
  102. DIMENSION ICSEG3( 3)
  103. DIMENSION ICTRI3( 3)
  104. DIMENSION ICTRI6( 6)
  105. DIMENSION ICQUA4( 4)
  106. DIMENSION ICQUA8( 8)
  107. DIMENSION ICCUB8( 8)
  108. DIMENSION ICCU20(20)
  109. DIMENSION ICPRI6( 6)
  110. DIMENSION ICPR15(15)
  111. DIMENSION ICTET4( 4)
  112. DIMENSION ICTE10(10)
  113. DIMENSION ICPYR5( 5)
  114. DIMENSION ICPY13(13)
  115.  
  116. DATA ICPOI1 / 1/
  117. DATA ICSEG2 / 1, 2/
  118. DATA ICSEG3 / 1, 3, 2/
  119. DATA ICTRI3 / 1, 2, 3/
  120. DATA ICTRI6 / 1, 4, 2, 5, 3, 6/
  121. DATA ICQUA4 / 1, 2, 3, 4/
  122. DATA ICQUA8 / 1, 5, 2, 6, 3, 7, 4, 8/
  123. DATA ICCUB8 / 1, 2, 3, 4, 5, 6, 7, 8/
  124. DATA ICCU20 / 1, 9, 2,10, 3,11, 4,12,17,18,
  125. & 19,20, 5,13, 6,14, 7,15, 8,16/
  126. DATA ICPRI6 / 1, 2, 3, 4, 5, 6/
  127. DATA ICPR15 / 1, 7, 2, 8, 3, 9,14,13,15, 4,
  128. & 10, 5,11, 6,12/
  129. DATA ICTET4 / 1, 2, 3, 4/
  130. DATA ICTE10 / 1, 5, 2, 8, 3, 6, 7,10, 9, 4/
  131. DATA ICPYR5 / 2, 3, 4, 5, 1/
  132. DATA ICPY13 / 2,10, 3,11, 4,12, 5,13, 6, 7,
  133. & 8, 9, 1/
  134.  
  135. DATA MINU / 'abcdefghijklmnopqrstuvwxyz' /
  136. DATA MAJU / 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /
  137.  
  138. C ... Sauvetage de la lecture ...
  139. call inired(sredle)
  140.  
  141. IF(IDIM.EQ.0) IDIM=3
  142. LISTMA=0
  143.  
  144. C ... Création de la table de sortie ...
  145. CALL CRTABL(MTABLE)
  146.  
  147. C ... Lecture de la première ligne ...
  148. 9010 CONTINUE
  149. READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  150. C ... On saute les lignes de commentaires qui n'existent qu'en entete ...
  151. IF (TEXT(1:1).EQ.'#') GOTO 9010
  152. 3000 FORMAT(A256)
  153. CNONF77 READ(LIGNE,*,ERR=9999) NBNPTS,NBELTS,NBCONO,NBCOEL,NBCOGL
  154. NRAN=0
  155. ICOUR=256
  156. IFINAN=257
  157. CALL REDLEC(sredle)
  158. IF(IRE.EQ.1) THEN
  159. NBNPTS=NFIX
  160. ELSE
  161. GOTO 9999
  162. ENDIF
  163.  
  164. CALL REDLEC(sredle)
  165. IF(IRE.EQ.1) THEN
  166. NBELTS=NFIX
  167. ELSE
  168. GOTO 9999
  169. ENDIF
  170.  
  171. CALL REDLEC(sredle)
  172. IF(IRE.EQ.1) THEN
  173. NBCONO=NFIX
  174. ELSE
  175. GOTO 9999
  176. ENDIF
  177.  
  178. CALL REDLEC(sredle)
  179. IF(IRE.EQ.1) THEN
  180. NBCOEL=NFIX
  181. ELSE
  182. GOTO 9999
  183. ENDIF
  184.  
  185. CALL REDLEC(sredle)
  186. IF(IRE.EQ.1) THEN
  187. NBCOGL=NFIX
  188. ELSE
  189. GOTO 9999
  190. ENDIF
  191.  
  192. CDEBUG write(ioimp,*) 'NBNPTS = ',NBNPTS
  193. CDEBUG write(ioimp,*) 'NBELTS = ',NBELTS
  194. CDEBUG write(ioimp,*) 'NBCONO = ',NBCONO
  195. CDEBUG write(ioimp,*) 'NBCOEL = ',NBCOEL
  196.  
  197. C ... Lecture des coordonnées ...
  198. SEGACT MCOORD
  199. NBANC=XCOOR(/1)/(IDIM+1)
  200. NBNOUV=NBANC+NBNPTS
  201. NBPTS=NBNOUV
  202. SEGADJ MCOORD
  203. NDEBB=NBANC+1
  204. NBC=IDIM+1
  205. DO 3020 J=NDEBB,NBNOUV
  206. READ (IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  207. IF (TEXT(1:1).EQ.'#') GOTO 9999
  208. CMB ... AVS donne toujours 3 coordonnées ...
  209. CNONF77 READ (LIGNE,*,ERR=9999) IKK,(XCOOR((J-1)*NBC+I),I=1,3)
  210. NRAN=0
  211. ICOUR=256
  212. IFINAN=257
  213. CALL REDLEC(sredle)
  214. IF(IRE.EQ.1) THEN
  215. IKK=NFIX
  216. ELSE
  217. GOTO 9999
  218. ENDIF
  219.  
  220. DO 3015 I=1,3
  221. CALL REDLEC(sredle)
  222. IF(IRE.EQ.1.OR.IRE.EQ.2) THEN
  223. XCOOR((J-1)*NBC+I)=FLOT
  224. ELSE
  225. GOTO 9999
  226. ENDIF
  227. 3015 CONTINUE
  228.  
  229. CMB ... Ici on remet les densités à 0, si IDIM==2, ceci écrasera la troisième
  230. CMB composante lue dans le fichier ...
  231. XCOOR(J*NBC)=0.D0
  232. 3020 CONTINUE
  233.  
  234. CDEBUG write(ioimp,*) 'Lecture des noeuds terminée'
  235.  
  236. C ... Préparation du support des champs de vitesses (composé des POI1) ...
  237. IPT2=0
  238. NBELEM=NBNPTS
  239. NBNN=1
  240. NBSOUS=0
  241. NBREF=0
  242. SEGINI IPT2
  243. IPT2.ITYPEL=1
  244. DO 3025 I=NBANC+1,NBANC+NBNPTS
  245. IPT2.NUM(1,I-NBANC)=I
  246. c* IPT2.ICOLOR(I-NBANC)=0
  247. 3025 CONTINUE
  248. CALL ECCTAB(MTABLE,'MOT ',0,0.d0,'MAILSUPP',.FALSE.,0,
  249. & 'MAILLAGE',0,0.d0,' ',.FALSE.,IPT2)
  250. SEGDES IPT2
  251.  
  252. CDEBUG write(ioimp,*) 'Préparation du support du CHPOINT terminée'
  253.  
  254. C ... Lecture du maillage ...
  255. NBSZEL=0
  256. NOMBEL=NBELTS
  257. SEGINI LISTMA
  258.  
  259. DO 3030 I=1,NBELTS
  260. READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  261. IF (TEXT(1:1).EQ.'#') GOTO 9999
  262. CNONF77 READ(LIGNE,*,ERR=9999) INUMEL,INUMAT,MTYPEL
  263. NRAN=0
  264. ICOUR=256
  265. IFINAN=257
  266. CALL REDLEC(sredle)
  267. IF(IRE.EQ.1) THEN
  268. INUMEL=NFIX
  269. ELSE
  270. GOTO 9999
  271. ENDIF
  272.  
  273. CALL REDLEC(sredle)
  274. IF(IRE.EQ.1) THEN
  275. INUMAT=NFIX
  276. ELSE
  277. GOTO 9999
  278. ENDIF
  279.  
  280. CALL REDLEC(sredle)
  281. IF(IRE.EQ.3) THEN
  282. DO 3031 IAUX=1, NCAR
  283. IRAL=INDEX(MAJU,MOT(IAUX:IAUX))
  284. IF (IRAL.NE.0) MOT(IAUX:IAUX)=MINU(IRAL:IRAL)
  285. 3031 CONTINUE
  286. MTYPEL=MOT(1:NCAR)
  287. ELSE
  288. GOTO 9999
  289. ENDIF
  290.  
  291. IF (MTYPEL.EQ.'pt ') THEN
  292.  
  293. CNONF77 READ(LIGNE,*,END=9999) INUMEL,INUMAT,MTYPEL,
  294. CNONF77 & ICONNT(1)
  295. CALL REDLEC(sredle)
  296. IF(IRE.EQ.1) THEN
  297. ICONNT(1)=NFIX
  298. ELSE
  299. GOTO 9999
  300. ENDIF
  301.  
  302. ITELAC=1
  303. CALL EMPELE(I,ITELAC,INUMAT,ICPOI1,LISTMA,ICONNT)
  304. GOTO 3030
  305.  
  306. ELSE IF(MTYPEL.EQ.'line ') THEN
  307.  
  308. CNONF77 READ(LIGNE,*,END=5299) INUMEL,INUMAT,MTYPEL,
  309. CNONF77 & (ICONNT(J),J=1,3)
  310.  
  311. NBENT=0
  312. DO 5250 J=1,3
  313. CALL REDLEC(sredle)
  314. IF(IRE.EQ.1) THEN
  315. ICONNT(J)=NFIX
  316. ELSE
  317. GOTO 5299
  318. ENDIF
  319. NBENT=J
  320. 5250 CONTINUE
  321.  
  322. C ... C'est un SEG3 ...
  323. ITELAC=3
  324. CALL EMPELE(I,ITELAC,INUMAT,ICSEG3,LISTMA,ICONNT)
  325. GOTO 3030
  326. C ... C'est un SEG2 ...
  327. 5299 IF(NBENT.NE.2) GOTO 9999
  328. ITELAC=2
  329. CALL EMPELE(I,ITELAC,INUMAT,ICSEG2,LISTMA,ICONNT)
  330. GOTO 3030
  331.  
  332. ELSE IF(MTYPEL.EQ.'tri ') THEN
  333.  
  334. CNONF77 READ(LIGNE,*,END=5399) INUMEL,INUMAT,MTYPEL,
  335. CNONF77 & (ICONNT(J),J=1,6)
  336.  
  337. NBENT=0
  338. DO 5350 J=1,6
  339. CALL REDLEC(sredle)
  340. IF(IRE.EQ.1) THEN
  341. ICONNT(J)=NFIX
  342. ELSE
  343. GOTO 5399
  344. ENDIF
  345. NBENT=J
  346. 5350 CONTINUE
  347.  
  348. C ... C'est un TRI6 ...
  349. ITELAC=6
  350. CALL EMPELE(I,ITELAC,INUMAT,ICTRI6,LISTMA,ICONNT)
  351. GOTO 3030
  352. C ... C'est un TRI3 ...
  353. 5399 IF(NBENT.NE.3) GOTO 9999
  354. ITELAC=4
  355. CALL EMPELE(I,ITELAC,INUMAT,ICTRI3,LISTMA,ICONNT)
  356. GOTO 3030
  357.  
  358. ELSE IF(MTYPEL.EQ.'quad ') THEN
  359.  
  360. CNONF77 READ(LIGNE,*,END=5499) INUMEL,INUMAT,MTYPEL,
  361. CNONF77 & (ICONNT(J),J=1,8)
  362.  
  363. NBENT=0
  364. DO 5450 J=1,8
  365. CALL REDLEC(sredle)
  366. IF(IRE.EQ.1) THEN
  367. ICONNT(J)=NFIX
  368. ELSE
  369. GOTO 5499
  370. ENDIF
  371. NBENT=J
  372. 5450 CONTINUE
  373.  
  374. C ... C'est un QUA8 ...
  375. ITELAC=10
  376. CALL EMPELE(I,ITELAC,INUMAT,ICQUA8,LISTMA,ICONNT)
  377. GOTO 3030
  378. C ... C'est un QUA4 ...
  379. 5499 IF(NBENT.NE.4) GOTO 9999
  380. ITELAC=8
  381. CALL EMPELE(I,ITELAC,INUMAT,ICQUA4,LISTMA,ICONNT)
  382. GOTO 3030
  383.  
  384. ELSE IF(MTYPEL.EQ.'tet ') THEN
  385.  
  386. CNONF77 READ(LIGNE,*,END=5599) INUMEL,INUMAT,MTYPEL,
  387. CNONF77 & (ICONNT(J),J=1,10)
  388.  
  389. NBENT=0
  390. DO 5550 J=1,10
  391. CALL REDLEC(sredle)
  392. IF(IRE.EQ.1) THEN
  393. ICONNT(J)=NFIX
  394. ELSE
  395. GOTO 5599
  396. ENDIF
  397. NBENT=J
  398. 5550 CONTINUE
  399.  
  400. C ... C'est un TE10 ...
  401. ITELAC=24
  402. CALL EMPELE(I,ITELAC,INUMAT,ICTE10,LISTMA,ICONNT)
  403. GOTO 3030
  404. C ... C'est un TET4 ...
  405. 5599 IF(NBENT.NE.4) GOTO 9999
  406. ITELAC=23
  407. CALL EMPELE(I,ITELAC,INUMAT,ICTET4,LISTMA,ICONNT)
  408. GOTO 3030
  409.  
  410. ELSE IF(MTYPEL.EQ.'pyr ') THEN
  411.  
  412. CNONF77 READ(LIGNE,*,END=5699) INUMEL,INUMAT,MTYPEL,
  413. CNONF77 & (ICONNT(J),J=1,13)
  414.  
  415. NBENT=0
  416. DO 5650 J=1,13
  417. CALL REDLEC(sredle)
  418. IF(IRE.EQ.1) THEN
  419. ICONNT(J)=NFIX
  420. ELSE
  421. GOTO 5699
  422. ENDIF
  423. NBENT=J
  424. 5650 CONTINUE
  425.  
  426. C ... C'est un PY13 ...
  427. ITELAC=26
  428. CALL EMPELE(I,ITELAC,INUMAT,ICPY13,LISTMA,ICONNT)
  429. GOTO 3030
  430. C ... C'est un PYR5 ...
  431. 5699 IF(NBENT.NE.5) GOTO 9999
  432. ITELAC=25
  433. CALL EMPELE(I,ITELAC,INUMAT,ICPYR5,LISTMA,ICONNT)
  434. GOTO 3030
  435.  
  436. ELSE IF(MTYPEL.EQ.'prism ') THEN
  437.  
  438. CNONF77 READ(LIGNE,*,END=5799) INUMEL,INUMAT,MTYPEL,
  439. CNONF77 & (ICONNT(J),J=1,15)
  440.  
  441. NBENT=0
  442. DO 5750 J=1,15
  443. CALL REDLEC(sredle)
  444. IF(IRE.EQ.1) THEN
  445. ICONNT(J)=NFIX
  446. ELSE
  447. GOTO 5799
  448. ENDIF
  449. NBENT=J
  450. 5750 CONTINUE
  451.  
  452. C ... C'est un PR15 ...
  453. ITELAC=17
  454. CALL EMPELE(I,ITELAC,INUMAT,ICPR15,LISTMA,ICONNT)
  455. GOTO 3030
  456. C ... C'est un PRI6 ...
  457. 5799 IF(NBENT.NE.6) GOTO 9999
  458. ITELAC=16
  459. CALL EMPELE(I,ITELAC,INUMAT,ICPRI6,LISTMA,ICONNT)
  460. GOTO 3030
  461.  
  462. ELSE IF(MTYPEL.EQ.'hex ') THEN
  463.  
  464. CNONF77 READ(LIGNE,*,END=5899) INUMEL,INUMAT,MTYPEL,
  465. CNONF77 & (ICONNT(J),J=1,20)
  466.  
  467. NBENT=0
  468. DO 5850 J=1,20
  469. CALL REDLEC(sredle)
  470. IF(IRE.EQ.1) THEN
  471. ICONNT(J)=NFIX
  472. ELSE
  473. GOTO 5899
  474. ENDIF
  475. NBENT=J
  476. 5850 CONTINUE
  477.  
  478. C ... C'est un CU20 ...
  479. ITELAC=15
  480. CALL EMPELE(I,ITELAC,INUMAT,ICCU20,LISTMA,ICONNT)
  481. GOTO 3030
  482. C ... C'est un CUB8 ...
  483. 5899 IF(NBENT.NE.8) GOTO 9999
  484. ITELAC=14
  485. CALL EMPELE(I,ITELAC,INUMAT,ICCUB8,LISTMA,ICONNT)
  486. GOTO 3030
  487.  
  488. ELSE
  489.  
  490. MOTERR(1:8)=MTYPEL
  491. CALL ERREUR(702)
  492. GOTO 9000
  493.  
  494. ENDIF
  495. 3030 CONTINUE
  496.  
  497. NBSZEL = LISTMA.MATER(/1)
  498.  
  499. CDEBUG WRITE(IOIMP,*) 'Maillage lu'
  500. CDEBUG WRITE(IOIMP,*) ' NBSZEL = ',NBSZEL
  501.  
  502. C ... On décale les connectivités ...
  503. DO 3035 K=1,NBSZEL
  504. IPT5=LISTMA.PTMA(K)
  505. SEGACT IPT5*MOD
  506. NBNN=IPT5.NUM(/1)
  507. NBELEM=IPT5.NUM(/2)
  508. DO 3036 I=1,NBNN
  509. DO 3036 J=1,NBELEM
  510. IPT5.NUM(I,J)=IPT5.NUM(I,J)+NBANC
  511. 3036 CONTINUE
  512. SEGDES IPT5
  513. 3035 CONTINUE
  514.  
  515. CDEBUG WRITE(IOIMP,*) 'Connectivités décalées'
  516.  
  517. C ... Création du chapeau des sous-maillages ...
  518. IF (NBSZEL.EQ.1) THEN
  519. MELEME = LISTMA.PTMA(1)
  520. ELSE
  521. MELEME=0
  522. NBELEM=0
  523. NBNN=0
  524. NBSOUS=NBSZEL
  525. NBREF=1
  526. SEGINI MELEME
  527. ITYPEL=0
  528. LISREF(1)=IPT2
  529. DO 3032 I=1,NBSZEL
  530. LISOUS(I)=LISTMA.PTMA(I)
  531. 3032 CONTINUE
  532. SEGDES MELEME
  533. ENDIF
  534.  
  535. CDEBUG WRITE(IOIMP,*) 'Chapeau des maillages créé'
  536.  
  537. CALL ECCTAB(MTABLE,'MOT ',0,0.d0,'LEMAILLA',.FALSE.,0,
  538. & 'MAILLAGE',0,0.d0,' ',.FALSE.,MELEME)
  539.  
  540. C ... On met les sous maillages dans une sous table indicée par leur numéros ...
  541. CALL CRTABL(MTAB1)
  542. CALL ECCTAB(MTABLE,'MOT ',0,0.d0,'SOUMAILA',.FALSE.,0,
  543. & 'TABLE ',0,0.d0,' ',.FALSE.,MTAB1)
  544. DO 3033 I=1,NBSZEL
  545. IPT8=LISTMA.PTMA(I)
  546. CALL ECCTAB(MTAB1,'ENTIER ',I,0.d0,' ',.FALSE.,0,
  547. & 'MAILLAGE',0,0.d0,' ',.FALSE.,IPT8)
  548. 3033 CONTINUE
  549.  
  550. CDEBUG WRITE(IOIMP,*) 'Maillages mis dans la table'
  551.  
  552. C ... Lecture du CHPOINT ...
  553.  
  554. IF(NBCONO.GT.0) THEN
  555. READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  556. IF (TEXT(1:1).EQ.'#') GOTO 9999
  557. CNONF77 READ(LIGNE,*,ERR=9999) NBGRCO
  558. NRAN=0
  559. ICOUR=256
  560. IFINAN=257
  561. CALL REDLEC(sredle)
  562. IF(IRE.EQ.1) THEN
  563. NBGRCO=NFIX
  564. ELSE
  565. GOTO 9999
  566. ENDIF
  567. SEGINI LISGRC
  568.  
  569. CNONF77 READ(LIGNE,*,ERR=9999) NBGRCO,(LESGRC(I),I=1,NBGRCO)
  570. DO 3034 I=1,NBGRCO
  571. CALL REDLEC(sredle)
  572. IF(IRE.EQ.1) THEN
  573. LESGRC(I)=NFIX
  574. ELSE
  575. GOTO 9999
  576. ENDIF
  577. 3034 CONTINUE
  578.  
  579. CDEBUG write(IOIMP,*) NBGRCO,(LESGRC(I),I=1,NBGRCO)
  580.  
  581. NAT=1
  582. NSOUPO=1
  583. MCHPOI=0
  584. SEGINI MCHPOI
  585. MTYPOI=' '
  586. MOCHDE=' '
  587. & //' '
  588. JATTRI(1)=1
  589. IFOPOI=IFOUR
  590. NC=NBCONO
  591. SEGINI MSOUPO
  592. IPCHP(1)=MSOUPO
  593. K = 0
  594. DO 3079 I=1,NBGRCO
  595. READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  596. IF (TEXT(1:1).EQ.'#') GOTO 9999
  597. DO 3077 J=1,LESGRC(I)
  598. K = K + 1
  599. CNONF77 READ(LIGNE,*,END=3076) NOCOMP(K)
  600. CNONF77 3076 CONTINUE
  601. NRAN=0
  602. ICOUR=256
  603. IFINAN=257
  604. CALL REDLEC(sredle)
  605. IF(IRE.EQ.3) THEN
  606. NOCOMP(K)=MOT(1:NCAR)
  607. CDEBUG write(ioimp,*) 'Composante N° ',J,' = ',NOCOMP(K)
  608. ELSE
  609. GOTO 9999
  610. ENDIF
  611. C ... Attention à la virgule qui n'est pas considérée comme un
  612. C séparateur par REDLEC ...
  613. DO 3075 INUMC=1,4
  614. IF(NOCOMP(K)(INUMC:INUMC).EQ.',') THEN
  615. NOCOMP(K)(INUMC:4)=' '
  616. GOTO 3076
  617. ENDIF
  618. 3075 CONTINUE
  619. 3076 CONTINUE
  620. IF(LESGRC(I).GT.1) THEN
  621. IKK=LEN(NOCOMP(K))
  622. CALL AJNUME(NOCOMP(K),IKK,J)
  623. ENDIF
  624. 3077 CONTINUE
  625. C ... Attention !!! Les noms des composantes des champs scalaires risquent de ne pas etre uniques
  626. C si la différence se trouve au délà du 4ème caractère !!! ...
  627. 3079 CONTINUE
  628. SEGSUP LISGRC
  629. IGEOC=IPT2
  630. DO 3080 I=1,NC
  631. NOHARM(I)=0
  632. 3080 CONTINUE
  633. N=NBNPTS
  634. SEGINI MPOVAL
  635. IPOVAL=MPOVAL
  636. DO 3090 I=1,N
  637. READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  638. IF (TEXT(1:1).EQ.'#') GOTO 9999
  639. CDEBUG write(ioimp,*) 'Ligne avec les composantes N°',I,' lue'
  640. CNONF77 READ(LIGNE,*,ERR=9999) IKK,(VPOCHA(I,J),J=1,NC)
  641. NRAN=0
  642. ICOUR=256
  643. IFINAN=257
  644. CALL REDLEC(sredle)
  645. IF(IRE.EQ.1) THEN
  646. IKK=NFIX
  647. ELSE
  648. GOTO 9999
  649. ENDIF
  650. DO 30901 J=1,NC
  651. CALL REDLEC(sredle)
  652. IF(IRE.EQ.1.OR.IRE.EQ.2) THEN
  653. VPOCHA(I,J)=FLOT
  654. ELSE
  655. GOTO 9999
  656. ENDIF
  657. 30901 CONTINUE
  658. 3090 CONTINUE
  659. CALL ECCTAB(MTABLE,'MOT ',0,0.d0,'LECHPOIN',.FALSE.,0,
  660. & 'CHPOINT ',0,0.d0,' ',.FALSE.,MCHPOI)
  661. SEGDES MPOVAL
  662. SEGDES MSOUPO
  663. SEGDES MCHPOI
  664. ENDIF
  665.  
  666. CDEBUG WRITE(IOIMP,*) 'CHPOINT lu'
  667.  
  668. C ... Lecture du champ par élément à NBCOEL composantes ...
  669.  
  670. IF(NBCOEL.GT.0) THEN
  671. READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  672. IF (TEXT(1:1).EQ.'#') GOTO 9999
  673. CNONF77 READ(LIGNE,*,ERR=9999) NBGRCO
  674. NRAN=0
  675. ICOUR=256
  676. IFINAN=257
  677. CALL REDLEC(sredle)
  678. IF(IRE.EQ.1) THEN
  679. NBGRCO=NFIX
  680. ELSE
  681. GOTO 9999
  682. ENDIF
  683. SEGINI LISGRC
  684.  
  685. CNONF77 READ(LIGNE,*,ERR=9999) NBGRCO,(LESGRC(I),I=1,NBGRCO)
  686. DO 3091 I=1,NBGRCO
  687. CALL REDLEC(sredle)
  688. IF(IRE.EQ.1) THEN
  689. LESGRC(I)=NFIX
  690. ELSE
  691. GOTO 9999
  692. ENDIF
  693. 3091 CONTINUE
  694.  
  695. C ... On lit les noms et les valeurs des composantes ...
  696. NBCOMP=NBCOEL
  697. NBDELE=NBELTS
  698. SEGINI LISTCO
  699. K = 0
  700. DO 3038 I=1,NBGRCO
  701. READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  702. IF (TEXT(1:1).EQ.'#') GOTO 9999
  703. DO 3037 J=1,LESGRC(I)
  704. K = K + 1
  705. CNONF77 READ(LIGNE,*,END=3099) LESNOM(K)
  706. CNONF77 3099 CONTINUE
  707. NRAN=0
  708. ICOUR=256
  709. IFINAN=257
  710. CALL REDLEC(sredle)
  711. IF(IRE.EQ.3) THEN
  712. LESNOM(K)=MOT(1:NCAR)
  713. ELSE
  714. GOTO 9999
  715. ENDIF
  716. C ... Attention à la virgule qui n'est pas considérée comme un
  717. C séparateur par REDLEC ...
  718. DO 3092 INUMC=1,MIN(4,NCAR)
  719. IF(LESNOM(K)(INUMC:INUMC).EQ.',') THEN
  720. LESNOM(K)(INUMC:MIN(4,NCAR))=' '
  721. GOTO 3093
  722. ENDIF
  723. 3092 CONTINUE
  724. 3093 CONTINUE
  725. IF(LESGRC(I).GT.1) THEN
  726. IKK=LEN(LESNOM(K))
  727. CALL AJNUME(LESNOM(K),IKK,J)
  728. ENDIF
  729. 3037 CONTINUE
  730. 3038 CONTINUE
  731. SEGSUP LISGRC
  732. DO 3039 I=1,NBELTS
  733. READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  734. IF (TEXT(1:1).EQ.'#') GOTO 9999
  735. CNONF77 READ(LIGNE,*,END=9999) IKK,(LESCOM(I,J),J=1,NBCOEL)
  736. NRAN=0
  737. ICOUR=256
  738. IFINAN=257
  739. CALL REDLEC(sredle)
  740. IF(IRE.EQ.1) THEN
  741. IKK=NFIX
  742. ELSE
  743. GOTO 9999
  744. ENDIF
  745. DO 30391 J=1,NBCOEL
  746. CALL REDLEC(sredle)
  747. IF(IRE.EQ.1.OR.IRE.EQ.2) THEN
  748. LESCOM(I,J)=FLOT
  749. ELSE
  750. GOTO 9999
  751. ENDIF
  752. 30391 CONTINUE
  753. 3039 CONTINUE
  754.  
  755. C ... On prépare la structure des données ...
  756. MCHELM=0
  757. L1=16
  758. N1=NBSZEL
  759. N3=6
  760. SEGINI MCHELM
  761. TITCHE='CARACTERISTIQUES'
  762. IFOCHE=IFOUR
  763. DO 3040 I=1,N1
  764. CONCHE(I)=' '
  765. IMACHE(I)=LISTMA.PTMA(I)
  766. INFCHE(I,1)=0
  767. INFCHE(I,2)=0
  768. INFCHE(I,3)=0
  769. INFCHE(I,4)=0
  770. INFCHE(I,5)=0
  771. INFCHE(I,6)=2
  772. MCHAML=0
  773. N2=NBCOEL
  774. SEGINI MCHAML
  775. ICHAML(I)=MCHAML
  776. DO 3041 J=1,N2
  777. NOMCHE(J)=LESNOM(J)
  778. TYPCHE(J)='REAL*8 '
  779. MELVAL=0
  780. N1PTEL=1
  781. IPT9=LISTMA.PTMA(I)
  782. SEGACT IPT9
  783. N1EL=IPT9.NUM(/2)
  784. SEGDES IPT9
  785. N2PTEL=0
  786. N2EL=0
  787. SEGINI MELVAL
  788. IELVAL(J)=MELVAL
  789. 3041 CONTINUE
  790. 3040 CONTINUE
  791. C ... On n'a pas désactivé de segments MCHAML et MELVAL, ce sera fait + tard ...
  792.  
  793. C ... Le transfert du LESCOM aux VELCHE correspondants ...
  794. DO 3045 I=1,NBCOEL
  795. DO 3045 J=1,NBELTS
  796. IKK=LISTMA.NUMEMA(J)
  797. MCHAM1=ICHAML(IKK)
  798. MELVA1=MCHAM1.IELVAL(I)
  799. MELVA1.VELCHE(1,LISTMA.NUMELE(J))=LESCOM(J,I)
  800. 3045 CONTINUE
  801.  
  802. CALL ECCTAB(MTABLE,'MOT ',0,0.d0,'LEMCHAML',.FALSE.,0,
  803. & 'MCHAML ',0,0.d0,' ',.FALSE.,MCHELM)
  804.  
  805. C ... A la fin on désactive le MCHAML avec les dépendances ...
  806. DO 3046 I=1,NBSZEL
  807. MCHAM1=ICHAML(I)
  808. DO 3047 J=1,NBCOEL
  809. MELVA1=MCHAM1.IELVAL(J)
  810. SEGDES MELVA1
  811. 3047 CONTINUE
  812. SEGDES MCHAM1
  813. 3046 CONTINUE
  814. SEGDES MCHELM
  815. SEGSUP LISTCO
  816. ENDIF
  817.  
  818. CDEBUG WRITE(IOIMP,*) 'MCHAML lu'
  819.  
  820. C ... Lecture des composantes globales ...
  821.  
  822. IF(NBCOGL.GT.0) THEN
  823.  
  824. C ... Le nombre de groupes de composantes ...
  825. READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  826. IF (TEXT(1:1).EQ.'#') GOTO 9999
  827. CNONF77 READ(LIGNE,*,ERR=9999) NBGRCO
  828. NRAN=0
  829. ICOUR=256
  830. IFINAN=257
  831. CALL REDLEC(sredle)
  832. IF(IRE.EQ.1) THEN
  833. NBGRCO=NFIX
  834. ELSE
  835. GOTO 9999
  836. ENDIF
  837. C ... permet d'initialiser LISGRC ...
  838. SEGINI LISGRC
  839.  
  840. C ... que l'on remplit par la suite ...
  841. CNONF77 READ(LIGNE,*,ERR=9999) NBGRCO,(LESGRC(I),I=1,NBGRCO)
  842. DO 3191 I=1,NBGRCO
  843. CALL REDLEC(sredle)
  844. IF(IRE.EQ.1) THEN
  845. LESGRC(I)=NFIX
  846. ELSE
  847. GOTO 9999
  848. ENDIF
  849. 3191 CONTINUE
  850.  
  851. C ... ensuite on lit les noms des composantes ...
  852. NBCOMP=NBCOGL
  853. NBDELE=1
  854. SEGINI LISTCO
  855. K = 0
  856. DO 3138 I=1,NBGRCO
  857. READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  858. IF (TEXT(1:1).EQ.'#') GOTO 9999
  859. DO 3137 J=1,LESGRC(I)
  860. K = K + 1
  861. CNONF77 READ(LIGNE,*,END=3099) LESNOM(K)
  862. CNONF77 3099 CONTINUE
  863. NRAN=0
  864. ICOUR=256
  865. IFINAN=257
  866. CALL REDLEC(sredle)
  867. IF(IRE.EQ.3) THEN
  868. LESNOM(K)=MOT(1:NCAR)
  869. ELSE
  870. GOTO 9999
  871. ENDIF
  872. C ... Attention à la virgule qui n'est pas considérée comme un
  873. C séparateur par REDLEC ...
  874. DO 3192 INUMC=1,MIN(4,NCAR)
  875. IF(LESNOM(K)(INUMC:INUMC).EQ.',') THEN
  876. LESNOM(K)(INUMC:MIN(4,NCAR))=' '
  877. GOTO 3193
  878. ENDIF
  879. 3192 CONTINUE
  880. 3193 CONTINUE
  881. C ... en leur ajoutant (si besoin est) leur N° dans le groupe ...
  882. IF(LESGRC(I).GT.1) THEN
  883. IKK=LEN(LESNOM(K))
  884. CALL AJNUME(LESNOM(K),IKK,J)
  885. ENDIF
  886. 3137 CONTINUE
  887. 3138 CONTINUE
  888. SEGSUP LISGRC
  889.  
  890. C ... Puis, on on lit les composantes elles-mêmes ...
  891. READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256)
  892. IF (TEXT(1:1).EQ.'#') GOTO 9999
  893. CNONF77 READ(LIGNE,*,END=9999) IKK,(LESCOM(I,J),J=1,NBCOEL)
  894. NRAN=0
  895. ICOUR=256
  896. IFINAN=257
  897. CALL REDLEC(sredle)
  898. IF(IRE.EQ.1) THEN
  899. IKK=NFIX
  900. ELSE
  901. GOTO 9999
  902. ENDIF
  903. DO 31391 J=1,NBCOGL
  904. CALL REDLEC(sredle)
  905. IF(IRE.EQ.1.OR.IRE.EQ.2) THEN
  906. LESCOM(1,J)=FLOT
  907. ELSE
  908. GOTO 9999
  909. ENDIF
  910. 31391 CONTINUE
  911.  
  912. C ... À la fin on les met dans la table ...
  913. DO 31392 J=1,NBCOGL
  914. MTYPEL(1:4) = LESNOM(J)
  915. VALFLO = LESCOM(1,J)
  916. CALL ECCTAB(MTABLE,
  917. & 'MOT ',0, 0.d0,MTYPEL(1:4),.FALSE.,0,
  918. & 'FLOTTANT',0,VALFLO, ' ',.FALSE.,0)
  919. 31392 CONTINUE
  920. SEGSUP LISTCO
  921.  
  922. ENDIF
  923.  
  924. C ... Sortie de la table ...
  925. CALL ECROBJ('TABLE ',MTABLE)
  926. SEGDES MTABLE
  927.  
  928. C ... Fin du traitement du fichier AVS ...
  929. GOTO 9000
  930.  
  931. 9999 CONTINUE
  932. CALL ERREUR(703)
  933.  
  934. 9000 CONTINUE
  935. IF(LISTMA.NE.0) THEN
  936. SEGSUP LISTMA
  937. ENDIF
  938. segsup sredle
  939.  
  940. RETURN
  941. END
  942.  
  943.  
  944.  

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