Télécharger lirunv.eso

Retour à la liste

Numérotation des lignes :

  1. C LIRUNV SOURCE BP208322 16/11/18 21:18:57 9177
  2.  
  3. C=======================================================================
  4. C Appele par : LIREFI
  5. C=======================================================================
  6.  
  7. SUBROUTINE LIRUNV
  8.  
  9. IMPLICIT INTEGER(I-N)
  10. IMPLICIT REAL*8(A-H,O-Z)
  11.  
  12. -INC CCOPTIO
  13. -INC CCREDLE
  14. -INC CCGEOME
  15.  
  16. -INC SMCOORD
  17. -INC SMELEME
  18. -INC SMLENTI
  19. SEGMENT MLINOE.MLENTI,MLINO2.MLENTI,MLIEL2.MLENTI
  20. -INC SMTABLE
  21.  
  22. C= Nombre de caracteres sur une ligne lue (cf. etiquette 1000)
  23. PARAMETER (NCARMAX = 80 , NCARFIN = NCARMAX+1)
  24. C= Unite logique du fichier d'impression au format UNV I-Deas/NX(TM)
  25. PARAMETER (IUUNV=67)
  26. CHARACTER*256 FicUnv
  27.  
  28. PARAMETER (INCJG = 10000)
  29.  
  30. PARAMETER (NEFUNV=86, NEFBIM=8, NEFPOI=1)
  31. INTEGER LEFUNV(NEFUNV), LEFGEO(NEFUNV),
  32. & LEFBIM(NEFBIM), LEFPOI(NEFPOI)
  33. DATA LEFUNV / 11, 21, 22, 23, 24, 31, 32, 41, 42, 43,
  34. & 44, 45, 46, 51, 52, 53, 54, 55, 56, 61,
  35. & 62, 63, 64, 65, 66, 71, 72, 73, 74, 75,
  36. & 76, 81, 82, 84, 85, 91, 92, 93, 94, 95,
  37. & 96, 101, 102, 103, 104, 105, 106, 111, 112, 113,
  38. & 114, 115, 116, 117, 118, 121, 122, 136, 137, 138,
  39. & 139, 141, 142, 151, 152, 161, 171, 172, 181, 191,
  40. & 192, 193, 194, 195, 196, 201, 202, 203, 204, 208,
  41. & 212, 213, 221, 222, 231, 232 /
  42. DATA LEFGEO / 2, 2, 2, 0, 3, 0, 0, 4, 6, 0,
  43. & 8, 10, 0, 4, 6, 0, 8, 10, 0, 4,
  44. & 6, 0, 8, 10, 0, 8, 6, 0, 4, 10,
  45. & 0, 4, 6, 8, 10, 4, 6, 0, 8, 10,
  46. & 0, 16, 17, 0, 14, 15, 0, 23, 16, 17,
  47. & 0, 14, 15, 0, 24, 2, 0, 0, 0, 0,
  48. & 0, 0, 0, 0, 0, 1, 2, 3, 0, 0,
  49. & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  50. & 0, 0, 0, 0, 0, 0 /
  51. DATA LEFBIM / 11, 21, 22, 23, 24, 31, 32, 121 /
  52. DATA LEFPOI / 161 /
  53.  
  54. SEGMENT MLIELT
  55. INTEGER IELEM(JGEL,4)
  56. ENDSEGMENT
  57.  
  58. SEGMENT MLISEF
  59. INTEGER ITYPE(JGEF,5)
  60. ENDSEGMENT
  61.  
  62. SEGMENT MLIMAI
  63. POINTEUR PTMAI(JGMAI).MELEME
  64. INTEGER TYMAI(JGMAI)
  65. ENDSEGMENT
  66.  
  67. SEGMENT MLIPHY
  68. INTEGER NUMPHY(JGPHY)
  69. CHARACTER*40 NOMPHY(JGPHY)
  70. POINTEUR PTPHY(JGPHY).MELEME
  71. ENDSEGMENT
  72.  
  73. SEGMENT MLIPEG
  74. INTEGER NUMPEG(JGPEG,4)
  75. CHARACTER*40 NOMPEG(JGPEG)
  76. POINTEUR PTPEG(JGPEG).MELEME
  77. POINTEUR PTPEGN(JGPEG).MELEME
  78. ENDSEGMENT
  79.  
  80. EXTERNAL LONG
  81.  
  82. CHARACTER*8 mot_z
  83. CHARACTER*45 nom_z
  84. LOGICAL b_z
  85.  
  86. C... Format de lecture
  87. 1000 FORMAT(A80)
  88. C* 1003 FORMAT(2x,d23.16,2x,d23.16,2x,d23.16)
  89. C* 1004 FORMAT(2x,i8)
  90. C* 1005 FORMAT(4x,a2)
  91. C* 1010 FORMAT(8(i10))
  92.  
  93. C... Lecture des arguments (obligatoires)
  94. C= Lecture du nom du fichier de donnees au format UNV de I-Deas/NX(TM)
  95. CALL LIRCHA(FicUnv,1,IRETOU)
  96. IF (IERR.NE.0) RETURN
  97.  
  98. C... Initialisation de la table de sortie
  99. CALL CRTABL(MATAB)
  100. i_z = 0
  101. r_z = 0.
  102. b_z = .FALSE.
  103. mot_z = ' '
  104. nom_z = ' '
  105. C... Segment de lecture d'une ligne ...
  106. SEGINI,sredle
  107. SEPARA=.FALSE.
  108. MOT=' '
  109. NRAN=0
  110. ICOUR=0
  111. C... Configuration initiale
  112. IDIMI=IDIM
  113. WRITE(IOIMP,*)
  114. WRITE(IOIMP,FMT='(A,I2)') ' DIMEnsion initiale = ',IDIMI
  115. C* SEGACT,MCOORD*MOD
  116. NBANC=XCOOR(/1)/(IDIMI+1)
  117. C... Passage temporaire en dimension 3 (si necessaire)
  118. iOK=0
  119. IDIMF=3
  120. IF (IDIMF.NE.IDIMI) THEN
  121. CALL ECRENT(IDIMF)
  122. CALL ECRCHA('DIME')
  123. CALL OPTION(1)
  124. IF (IERR.NE.0) GOTO 990
  125. ENDIF
  126. C... Par defaut, on affiche erreur Cast3m numero 424
  127. iOK=424
  128. l=LONG(FicUnv)
  129. MOTERR(1:l)=FicUnv(1:l)
  130. INTERR(1)=0
  131. CLOSE(UNIT=IUUNV,ERR=990)
  132. WRITE(IOIMP,*)
  133. WRITE(IOIMP,*) 'Ouverture du fichier I-Deas/NX (TM)'
  134. OPEN(UNIT=IUUNV,STATUS='OLD',FILE=FicUnv(1:l),
  135. & IOSTAT=IOS,FORM='FORMATTED')
  136. C... Traitement des erreurs d ouverture des fichiers
  137. IF (IOS.NE.0) THEN
  138. iOK=599
  139. INTERR(1)=IOS
  140. GOTO 990
  141. ENDIF
  142. C... Quelques initialisations
  143. NBNPTS=0
  144. NBELTS=0
  145. NBEFLU=0
  146. NBMAIS=0
  147. NBPHYS=0
  148. NBPEGR=0
  149. MLINOE=0
  150. MLINO2=0
  151. MLIELT=0
  152. MLIEL2=0
  153. MLISEF=0
  154. MLIMAI=0
  155. MLIPHY=0
  156. MLIPEG=0
  157.  
  158. C... Lecture des lignes du fichier ...
  159. I_BLOC=0
  160. C... Recherche de l'indicateur "-1" en debut de bloc
  161. WRITE(IOIMP,*)
  162. WRITE(IOIMP,*) 'LECTURE DES DATASET'
  163. 10 CONTINUE
  164. READ(IUUNV,FMT=1000,ERR=991,END=100) TEXT
  165. NRAN=0
  166. ICOUR=NCARMAX
  167. IFINAN=NCARFIN
  168. CALL REDLEC(sredle)
  169. IF (IRE.NE.1) GOTO 10
  170. IF (NFIX.NE.-1) GOTO 10
  171. I_BLOC=1-I_BLOC
  172. IF (I_BLOC.EQ.0) GOTO 10
  173. C... Lecture de la cle
  174. READ(IUUNV,FMT=1000,ERR=991,END=100) TEXT
  175. NRAN=0
  176. ICOUR=NCARMAX
  177. IFINAN=NCARFIN
  178. CALL REDLEC(sredle)
  179. IF (IRE.NE.1) THEN
  180. WRITE(IOIMP,*) 'ERREUR : Numero du DATASET non trouve'
  181. iOK=21
  182. GOTO 991
  183. ENDIF
  184. IF (NFIX.EQ. 151) GOTO 151
  185. IF (NFIX.EQ. 164) GOTO 164
  186. IF (NFIX.EQ.2411) GOTO 2411
  187. IF (NFIX.EQ.2412) GOTO 2412
  188. IF (NFIX.EQ.2470) GOTO 2470
  189. IF (NFIX.EQ.2477) GOTO 2477
  190. WRITE(IOIMP,*) 'ATTENTION : DATASET ',NFIX,' ignore'
  191. GOTO 10
  192.  
  193. C... Lecture de l'entete
  194. 151 CONTINUE
  195. WRITE(IOIMP,*) '-> LECTURE du DATASET 151'
  196. DO i = 1, 7
  197. READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  198. IF (i.EQ.3) THEN
  199. * WRITE(IOIMP,*) TEXT(1:LONG(TEXT))
  200. ELSE IF (i.EQ.6) THEN
  201. WRITE(IOIMP,*) ' Programme = ',TEXT(1:LONG(TEXT))
  202. ENDIF
  203. ENDDO
  204. C... Fin du bloc
  205. READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  206. I_BLOC=1-I_BLOC
  207. WRITE(IOIMP,*) '<- Lecture du DATASET 151 terminee'
  208. GOTO 10
  209.  
  210. C... Lecture de l'entete
  211. 164 CONTINUE
  212. WRITE(IOIMP,*) '-> LECTURE du DATASET 164'
  213. * READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  214. READ(IUUNV,1640,ERR=991,END=991) i,TEXT,i
  215. 1640 FORMAT(I10,A20,I10)
  216. WRITE(IOIMP,*) ' Systeme d unite utilise = ',TEXT(1:LONG(TEXT))
  217. C* WRITE(IOIMP,*) ' Facteurs de conversion d unite'
  218. NBVPR = 4
  219. NBLIG = 0
  220. DO i=1, NBVPR
  221. IF (NBLIG.EQ.3) NBLIG = 0
  222. NBLIG = NBLIG + 1
  223. IF (NBLIG.EQ.1) THEN
  224. READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  225. C* NRAN=0
  226. C* ICOUR=NCARMAX
  227. C* IFINAN=NCARFIN
  228. ENDIF
  229. C* CALL REDLEC(sredle)
  230. ENDDO
  231. C... Fin du bloc
  232. READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  233. I_BLOC=1-I_BLOC
  234. WRITE(IOIMP,*) '<- Lecture du DATASET 164 terminee'
  235. GOTO 10
  236.  
  237. C Lecture des noeuds : numero, coordonnees (densite mise a zero)
  238. 2411 CONTINUE
  239. WRITE(IOIMP,*) '-> LECTURE du DATASET 2411'
  240. JG=INCJG
  241. SEGINI,MLINOE
  242. NBPTS=NBANC+JG
  243. SEGADJ,MCOORD
  244. NUMIN=100000000
  245. NUMAX=0
  246. idimp1=IDIM+1
  247. ABS_Z = 0.D0
  248. 12411 CONTINUE
  249. C... Lecture des informations liees au noeud (RECORD 1)
  250. READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  251. NRAN=0
  252. ICOUR=NCARMAX
  253. IFINAN=NCARFIN
  254. CALL REDLEC(sredle)
  255. IF (IRE.NE.1) THEN
  256. iOK=8
  257. GOTO 991
  258. ENDIF
  259. C. Fin du bloc ?
  260. IF (NFIX.EQ.-1) GOTO 22411
  261. IF (NFIX.EQ.0) THEN
  262. iOK=8
  263. GOTO 991
  264. ENDIF
  265. NBNPTS=NBNPTS+1
  266. IF (NBNPTS.GT.JG) THEN
  267. JG=JG+INCJG
  268. SEGADJ,MLINOE
  269. NBPTS=NBANC+JG
  270. SEGADJ,MCOORD
  271. ENDIF
  272. MLINOE.LECT(NBNPTS)=NFIX
  273. NUMIN=MIN(NUMIN,NFIX)
  274. NUMAX=MAX(NUMAX,NFIX)
  275. C... Lecture des coordonnees (RECORD 2)
  276. READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  277. NRAN=0
  278. ICOUR=NCARMAX
  279. IFINAN=NCARFIN
  280. j=(NBANC+NBNPTS-1)*idimp1
  281. DO k=1,IDIMF
  282. CALL REDLEC(sredle)
  283. IF (IRE.NE.1.AND.IRE.NE.2) THEN
  284. iOK=661
  285. GOTO 991
  286. ENDIF
  287. IF (IRE.EQ.1) THEN
  288. XCOOR(j+k)=NFIX
  289. ELSE
  290. XCOOR(j+k)=FLOT
  291. ENDIF
  292. ENDDO
  293. XCOOR(j+idimp1)=0.D0
  294. ABS_Z = MAX(ABS_Z,ABS(XCOOR(j+IDIMF)))
  295. GOTO 12411
  296. C... Fin du bloc
  297. 22411 CONTINUE
  298. WRITE(IOIMP,*) ' Nombre de noeuds lus :',NBNPTS
  299. WRITE(IOIMP,*) ' Numero du noeud min. :',NUMIN
  300. WRITE(IOIMP,*) ' Numero du noeud max. :',NUMAX
  301. WRITE(IOIMP,*) '<- Lecture du DATASET 2411 terminee'
  302. IF (NBNPTS.NE.JG) THEN
  303. JG = NBNPTS
  304. SEGADJ,MLINOE
  305. NBPTS = NBANC+JG
  306. SEGADJ,MCOORD
  307. ENDIF
  308. WRITE(IOIMP,*)
  309. IF (IDIMI.EQ.IDIMF) THEN
  310. WRITE(IOIMP,*) ' Noeuds lus en DIMEsion 3'
  311. ELSE
  312. IF (ABS_Z.GT.0.D0) THEN
  313. WRITE(IOIMP,*) ' Noeuds lus en DIMEnsion 3'
  314. WRITE(IOIMP,*) '=> Passage en DIMEnsion 3 necessaire'
  315. ELSE
  316. WRITE(IOIMP,*) ' Noeuds lus en DIMEnsion 2'
  317. IF (IDIMI.NE.2) THEN
  318. WRITE(IOIMP,*) '=> Passage en DIMEnsion 2 necessaire'
  319. ENDIF
  320. IDIMF = 2
  321. CALL ECRENT(IDIMF)
  322. CALL ECRCHA('DIME')
  323. CALL OPTION(1)
  324. IF (IERR.NE.0) GOTO 990
  325. ENDIF
  326. ENDIF
  327. WRITE(IOIMP,*)
  328. I_BLOC=1-I_BLOC
  329. GOTO 10
  330.  
  331. C... Lecture des elements
  332. 2412 CONTINUE
  333. WRITE(IOIMP,*) '-> LECTURE du DATASET 2412'
  334. JGEF = 50
  335. SEGINI,MLISEF
  336. JGEL = INCJG
  337. SEGINI,MLIELT
  338. NUMIN = 100000000
  339. NUMAX = 0
  340. 12412 CONTINUE
  341. C... Lecture des informations liees a l'element (RECORD 1)
  342. READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  343. NRAN=0
  344. ICOUR=NCARMAX
  345. IFINAN=NCARFIN
  346. DO i=1,6
  347. CALL REDLEC(sredle)
  348. IF (IRE.NE.1) THEN
  349. iOK=8
  350. GOTO 991
  351. ENDIF
  352. IF (i.EQ.1) THEN
  353. IF (NFIX.EQ.-1) GOTO 22412
  354. NUMELT=NFIX
  355. ELSE IF (i.EQ.2) THEN
  356. NUMEF=NFIX
  357. ELSE IF (i.EQ.3) THEN
  358. NUMPP=NFIX
  359. C* ELSE IF (i.EQ.4) THEN
  360. C* NUMMP=NFIX
  361. C* ELSE IF (i.EQ.5) THEN
  362. C* NUMCO=NFIX
  363. ELSE IF (i.EQ.6) THEN
  364. NBNOE=NFIX
  365. ENDIF
  366. ENDDO
  367. CALL PLACE2(LEFBIM,NEFBIM,IRETOU,NUMEF)
  368. C... Lecture des informations d un element type "BEAM"
  369. C... Pour l'instant pas de traitement de ces informations
  370. IF (IRETOU.NE.0) THEN
  371. READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  372. ENDIF
  373. NBELTS=NBELTS+1
  374. IF (NBELTS.GT.JGEL) THEN
  375. JGEL=JGEL+INCJG
  376. SEGADJ,MLIELT
  377. ENDIF
  378. NUMIN=MIN(NUMIN,NUMELT)
  379. NUMAX=MAX(NUMAX,NUMELT)
  380. DO i=1,NBEFLU
  381. IF (NUMEF.EQ.ITYPE(i,1)) GOTO 24120
  382. ENDDO
  383. NBEFLU = NBEFLU+1
  384. ITYPE(NBEFLU,1) = NUMEF
  385. ITYPE(NBEFLU,2) = NBNOE
  386. JG = 1*NBNOE
  387. SEGINI,MLENTI
  388. ITYPE(NBEFLU,5) = MLENTI
  389. i = NBEFLU
  390. 24120 CONTINUE
  391. IF (NBNOE.NE.ITYPE(i,2)) THEN
  392. write(IOIMP,*) 'Erreur NUMEF/NBNOE',NBELTS,NUMELT
  393. ENDIF
  394. NBELEF=ITYPE(i,3)+1
  395. ITYPE(i,3)=NBELEF
  396. MLENTI=ITYPE(i,5)
  397. JG=LECT(/1)
  398. NBNOEF=NBELEF*NBNOE
  399. IF (NBNOEF.GT.JG) THEN
  400. JG=JG+INCJG
  401. SEGADJ,MLENTI
  402. ENDIF
  403. NBNOEF=NBNOEF-NBNOE
  404. IELEM(NBELTS,1)=NUMELT
  405. IELEM(NBELTS,2)=NUMPP
  406. IELEM(NBELTS,3)=i
  407. IELEM(NBELTS,4)=NBELEF
  408. C... Lecture des noeuds de l'element (RECORD 2)
  409. j=0
  410. DO k=NBNOEF+1,NBNOEF+NBNOE
  411. j=j+1
  412. IF (j.EQ.1) THEN
  413. READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  414. NRAN=0
  415. ICOUR=NCARMAX
  416. IFINAN=NCARFIN
  417. ENDIF
  418. CALL REDLEC(sredle)
  419. IF (IRE.NE.1) THEN
  420. iOK=661
  421. GOTO 991
  422. ENDIF
  423. LECT(k)=NFIX
  424. IF (j.EQ.8) j=0
  425. ENDDO
  426. GOTO 12412
  427. C... Fin du bloc
  428. 22412 CONTINUE
  429. WRITE(IOIMP,*) ' Nombre d elements lus :',NBELTS
  430. WRITE(IOIMP,*) ' Numero d element min. :',NUMIN
  431. WRITE(IOIMP,*) ' Numero d element max. :',NUMAX
  432. WRITE(IOIMP,*) ' Nombre de types EF lus :',NBEFLU
  433. IF (NBELTS.NE.JGEL) THEN
  434. JGEL=NBELTS
  435. SEGADJ,MLIELT
  436. ENDIF
  437. I_BLOC=1-I_BLOC
  438. WRITE(IOIMP,*) '<- Lecture du DATASET 2412 terminee'
  439. GOTO 10
  440.  
  441. C Lecture des proprietes physiques
  442. 2470 CONTINUE
  443. WRITE(IOIMP,*) '-> LECTURE du DATASET 2470'
  444. NBPHYS = 0
  445. JGPHY = 50
  446. SEGINI,MLIPHY
  447. 12470 CONTINUE
  448. C... Lecture des donnees/proprietes physiques (RECORD 1)
  449. READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  450. NRAN=0
  451. ICOUR=NCARMAX
  452. IFINAN=NCARFIN
  453. DO i=1,3
  454. CALL REDLEC(sredle)
  455. IF (IRE.NE.1) THEN
  456. iOK=8
  457. GOTO 991
  458. ENDIF
  459. IF (i.EQ.1) THEN
  460. IF (NFIX.EQ.-1) GOTO 22470
  461. NUMPH=NFIX
  462. C* ELSE IF (i.EQ.2) THEN
  463. C* IDPHT=NFIX
  464. ELSE IF (i.EQ.3) THEN
  465. NBPHT=NFIX
  466. ENDIF
  467. ENDDO
  468. NBPHYS=NBPHYS+1
  469. IF (NBPHYS.GT.JGPHY) THEN
  470. JGPHY=JGPHY+50
  471. SEGADJ,MLIPHY
  472. ENDIF
  473. NUMPHY(NBPHYS)=NUMPH
  474. C... Lecture du nom de la propriete (RECORD 2)
  475. READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  476. NOMPHY(NBPHYS)=TEXT(1:LONG(TEXT))
  477. C... Lecture des valeurs de chaque propriete physique (RECORD 3 et 4)
  478. C... Pour l'instant : pas de traitement de ces valeurs
  479. DO i = 1, NBPHT
  480. READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  481. NRAN=0
  482. ICOUR=NCARMAX
  483. IFINAN=NCARFIN
  484. DO j=1,3
  485. CALL REDLEC(sredle)
  486. IF (IRE.NE.1) THEN
  487. iOK=8
  488. GOTO 991
  489. ENDIF
  490. IF (j.EQ.1) THEN
  491. C* NUMPR=NFIX
  492. ELSE IF (j.EQ.2) THEN
  493. IDTPR=NFIX
  494. ELSE IF (j.EQ.3) THEN
  495. NBVPR=NFIX
  496. ENDIF
  497. ENDDO
  498. NBLIG=0
  499. IF (IDTPR.EQ.1) THEN
  500. NBLIG = ((NBVPR-1) / 8) + 1
  501. ELSE IF (IDTPR.EQ.2) THEN
  502. NBLIG = ((NBVPR-1) / 5) + 1
  503. ELSE IF (IDTPR.EQ.3) THEN
  504. NBLIG = ((NBVPR-1) / 80) + 1
  505. ENDIF
  506. DO j=1,NBLIG
  507. READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  508. ENDDO
  509. ENDDO
  510. GOTO 12470
  511. C... Fin du bloc
  512. 22470 CONTINUE
  513. WRITE(IOIMP,*) ' Nombre de proprietes lues :',NBPHYS
  514. DO i=1,NBPHYS
  515. j=LONG(NOMPHY(i))
  516. WRITE(IOIMP,FMT='(3X,I2,3H = ,A)') NUMPHY(i),NOMPHY(i)(1:j)
  517. ENDDO
  518. c* IF (NBPHYS.NE.JGPHY) THEN
  519. c* JGPHY = NBPHYS
  520. c* SEGADJ,MLIPHY
  521. c* ENDIF
  522. I_BLOC=1-I_BLOC
  523. WRITE(IOIMP,*) '<- Lecture du DATASET 2470 terminee'
  524. GOTO 10
  525.  
  526. C Lecture des groupes (d'elements) "permanents"
  527. 2477 CONTINUE
  528. WRITE(IOIMP,*) '-> LECTURE du DATASET 2477'
  529. NBPEGR = 0
  530. NBPEGP = 0
  531. NBPEGE = 0
  532. JGPEG = 50
  533. SEGINI,MLIPEG
  534. 12477 CONTINUE
  535. C... Lecture des donnees... (RECORD 1)
  536. READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  537. NRAN=0
  538. ICOUR=NCARMAX
  539. IFINAN=NCARFIN
  540. DO i = 1, 8
  541. CALL REDLEC(sredle)
  542. IF (IRE.NE.1) THEN
  543. iOK=8
  544. GOTO 991
  545. ENDIF
  546. IF (i.EQ.1) THEN
  547. IF (NFIX.EQ.-1) GOTO 22477
  548. NUMPH = NFIX
  549. ELSE IF (i.EQ.8) THEN
  550. NBPHT = NFIX
  551. ENDIF
  552. ENDDO
  553. NBPEGR = NBPEGR+1
  554. IF (NBPEGR.GT.JGPEG) THEN
  555. JGPEG = JGPEG+50
  556. SEGADJ,MLIPEG
  557. ENDIF
  558. NUMPEG(NBPEGR,1) = NUMPH
  559. JG = NBPHT
  560. SEGINI,MLENTI
  561. NUMPEG(NBPEGR,2) = MLENTI
  562. C... Lecture du nom du groupe (RECORD 2)
  563. READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  564. j = LONG(TEXT)
  565. NOMPEG(NBPEGR) = TEXT(1:j)
  566. WRITE(IOIMP,FMT='(4X,9HGroupe lu,3X,I2,3H = ,A)')
  567. & NUMPH,NOMPEG(NBPEGR)
  568. C... Lecture de chaque entite du groupe
  569. i = 0
  570. kelt = 0
  571. knoe = NBPHT+1
  572. k = 0
  573. 32477 CONTINUE
  574. k = k + 1
  575. IF (k.EQ.1) THEN
  576. READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT
  577. NRAN=0
  578. ICOUR=NCARMAX
  579. IFINAN=NCARFIN
  580. ELSE
  581. k = 0
  582. ENDIF
  583. DO j = 1, 4
  584. CALL REDLEC(sredle)
  585. IF (IRE.NE.1) THEN
  586. IF (j.EQ.1) THEN
  587. IF (k.EQ.1) THEN
  588. iOK=8
  589. GOTO 991
  590. ELSE
  591. GOTO 32477
  592. ENDIF
  593. ENDIF
  594. ENDIF
  595. IF (j.EQ.1) THEN
  596. IDPTR=NFIX
  597. ELSE IF (j.EQ.2) THEN
  598. NUMPR=NFIX
  599. ENDIF
  600. ENDDO
  601. i = i + 1
  602. C... On ne conserve que les noeuds (POI1) et les elements
  603. IF (IDPTR.EQ.7) THEN
  604. knoe = knoe - 1
  605. LECT(knoe) = NUMPR
  606. ELSE IF (IDPTR.EQ.8) THEN
  607. kelt = kelt + 1
  608. LECT(kelt) = NUMPR
  609. ENDIF
  610. IF (i.EQ.NBPHT) GOTO 42477
  611. GOTO 32477
  612. 42477 CONTINUE
  613. knoe = NBPHT+1 - knoe
  614. NUMPEG(NBPEGR,3) = knoe
  615. NUMPEG(NBPEGR,4) = kelt
  616. IF (knoe.GT.0) NBPEGP = NBPEGP+1
  617. IF (kelt.GT.0) NBPEGE = NBPEGE+1
  618. IF (knoe.EQ.0 .AND. kelt.EQ.0) THEN
  619. NBPEGR = NBPEGR-1
  620. SEGSUP,MLENTI
  621. ENDIF
  622. GOTO 12477
  623. C... Fin du bloc
  624. 22477 CONTINUE
  625. WRITE(IOIMP,*) ' Nombre de groupes conserves :',NBPEGR
  626. DO i = 1, NBPEGR
  627. j = LONG(NOMPEG(i))
  628. IF (NUMPEG(i,4).EQ.0) THEN
  629. WRITE(IOIMP,FMT=2001) NUMPEG(i,1),NOMPEG(i)(1:j)
  630. ELSE
  631. IF (NUMPEG(i,3).EQ.0) THEN
  632. WRITE(IOIMP,FMT=2002) NUMPEG(i,1),NOMPEG(i)(1:j)
  633. ELSE
  634. WRITE(IOIMP,FMT=2000) NUMPEG(i,1)
  635. WRITE(IOIMP,FMT=2002) NUMPEG(i,1),NOMPEG(i)(1:j)//' '
  636. WRITE(IOIMP,FMT=2001) NUMPEG(i,1),NOMPEG(i)(1:j)//'_GN'
  637. ENDIF
  638. ENDIF
  639. ENDDO
  640. 2000 FORMAT(4X,I4,' ==> Groupe separe en 2 parties :')
  641. 2001 FORMAT(4X,I4,' = ',A,' -> GroupeNoeuds')
  642. 2002 FORMAT(4X,I4,' = ',A,' -> GroupeElements')
  643. c* IF (NBPEGR.NE.JGPEG) THEN
  644. c* JGPEG = NBPEGR
  645. c* SEGADJ,MLIPEG
  646. c* ENDIF
  647. I_BLOC = 1-I_BLOC
  648. WRITE(IOIMP,*) '<- Lecture du DATASET 2477 terminee'
  649. GOTO 10
  650.  
  651. C= Fin normale de la lecture
  652. 100 CONTINUE
  653. WRITE(IOIMP,*) 'FIN LECTURE DES DATASET'
  654.  
  655. C= Traitement des differents DATASET lus
  656.  
  657. C= Creation d'une liste croissante des noeuds selon leur numero lu
  658. C= Creation d'un maillage de POI1 contenant tous les noeuds lus
  659. C* Mettre une option pour creer ce maillage ?
  660. IF (MLINOE.NE.0) THEN
  661. NBNN=1
  662. NBELEM=NBNPTS
  663. NBSOUS=0
  664. NBREF=0
  665. SEGINI,MELEME
  666. ITYPEL=1
  667. DO i=1,NBNPTS
  668. NUM(1,i)=i+NBANC
  669. ENDDO
  670. SEGDES,MELEME
  671. CALL ECCTAB(MATAB,'MOT ',i_z,r_z,'NOEUDS',b_z, i_z ,
  672. & 'MAILLAGE',i_z,r_z, mot_z ,b_z,MELEME)
  673. JG = NBNPTS
  674. SEGINI,MLINO2
  675. MLINO2.LECT(1)=1
  676. DO i=2,NBNPTS
  677. INOE = MLINOE.LECT(i)
  678. DO j=i-1,1,-1
  679. JNO2 = MLINO2.LECT(j)
  680. JNOE = MLINOE.LECT(JNO2)
  681. IF (JNOE.LE.INOE) GOTO 101
  682. MLINO2.LECT(j+1) = JNO2
  683. ENDDO
  684. 101 CONTINUE
  685. MLINO2.LECT(j+1) = i
  686. ENDDO
  687. ENDIF
  688. C= Creation du maillage contenant l'ensemble des elements lus ayant
  689. C= une correspondance dans Cast3m
  690. IF (MLIELT.NE.0) THEN
  691. IF (MLINOE.EQ.0) THEN
  692. WRITE(IOIMP,*) 'ERREUR : DATASET 2411 non lu'
  693. iOK = 21
  694. GOTO 991
  695. ENDIF
  696. JGMAI = NBEFLU
  697. SEGINI,MLIMAI
  698. NBSOUS=0
  699. NBREF=0
  700. NBMAIS=0
  701. icoul=0
  702. DO i = 1, NBEFLU
  703. NUMEF = ITYPE(i,1)
  704. C* IF (NUMEF.LE.0) GOTO 110
  705. CALL PLACE2(LEFUNV,NEFUNV,IRETOU,NUMEF)
  706. IF (IRETOU.EQ.0) THEN
  707. WRITE(IOIMP,*) 'FE ID non reconnu : ',NUMEF
  708. GOTO 110
  709. ENDIF
  710. IF (LEFGEO(IRETOU).EQ.0) THEN
  711. WRITE(IOIMP,*) NUMEF,' sans correspondance dans C3M'
  712. GOTO 110
  713. ENDIF
  714. NBNN =ITYPE(i,2)
  715. NBELEM=ITYPE(i,3)
  716. MLENTI=ITYPE(i,5)
  717. icoul = icoul + 1
  718. IF (icoul.EQ.NBCOUL) icoul=1
  719. NBMAIS=NBMAIS+1
  720. C* ITYPE(i,1)=LEFGEO(IRETOU)
  721. ITYPE(i,4)=NBMAIS
  722. SEGINI,PTMAI(NBMAIS)
  723. IPT1=PTMAI(NBMAIS)
  724. IPT1.ITYPEL=LEFGEO(IRETOU)
  725. TYMAI(NBMAIS)=LEFGEO(IRETOU)
  726. NBNOEL=0
  727. DO j = 1, NBELEM
  728. DO k = 1, NBNN
  729. INOE = LECT(NBNOEL+k)
  730. lInf = 1
  731. lSup = NBNPTS
  732. 111 CONTINUE
  733. IF (lInf.GT.lSup) THEN
  734. WRITE(IOIMP,*) 'ERREUR : Noeud',INOE,'pas dans 2411'
  735. iOK=21
  736. GOTO 991
  737. ENDIF
  738. lMil = (lInf+lSup)/2
  739. l = MLINO2.LECT(lMil)
  740. JNOE = MLINOE.LECT(l)
  741. IF (INOE.EQ.JNOE) THEN
  742. GOTO 112
  743. ELSE IF (INOE.LT.JNOE) THEN
  744. lSup = lMil - 1
  745. ELSE
  746. lInf = lMil + 1
  747. ENDIF
  748. GOTO 111
  749. 112 CONTINUE
  750. IPT1.NUM(k,j) = NBANC+l
  751. LECT(NBNOEL+k) = NBANC+l
  752. ENDDO
  753. IPT1.ICOLOR(j)=icoul
  754. NBNOEL=NBNOEL+NBNN
  755. ENDDO
  756. SEGDES,PTMAI(NBMAIS)
  757. 110 CONTINUE
  758. MLENTI = ITYPE(i,5)
  759. SEGDES,MLENTI
  760. ENDDO
  761. IF (JGMAI.NE.NBMAIS) THEN
  762. JGMAI=NBMAIS
  763. SEGADJ,MLIMAI
  764. ENDIF
  765. IF (NBMAIS.EQ.0) THEN
  766. WRITE(IOIMP,*) 'Pas de maillage au sens Cast3m'
  767. CALL ECCTAB(MATAB,'MOT ',i_z,r_z,'MAILLAGE',b_z,i_z,
  768. & 'MOT ',i_z,r_z, 'VIDE' ,b_z,i_z)
  769. ELSE
  770. nom_z(1:5) = '@ '
  771. DO i = 1, NBMAIS
  772. IPT1=PTMAI(i)
  773. j =TYMAI(i)
  774. nom_z(2:5) = NOMS(j)(1:4)
  775. CALL ECCTAB(MATAB,'MOT ',i_z,r_z,nom_z(1:5),b_z,i_z ,
  776. & 'MAILLAGE',i_z,r_z, mot_z ,b_z,IPT1)
  777. ENDDO
  778. IF (NBMAIS.EQ.1) THEN
  779. IPT2=PTMAI(1)
  780. ELSE
  781. NBSOUS=NBMAIS
  782. NBREF =0
  783. NBNN =0
  784. NBELEM=0
  785. SEGINI,IPT2
  786. DO i = 1, NBSOUS
  787. IPT2.LISOUS(i)=PTMAI(i)
  788. ENDDO
  789. SEGDES,IPT2
  790. ENDIF
  791. CALL ECCTAB(MATAB,'MOT ',i_z,r_z,'MAILLAGE',b_z,i_z ,
  792. & 'MAILLAGE',i_z,r_z, mot_z ,b_z,IPT2)
  793. ENDIF
  794. ENDIF
  795. C= Creation des maillages (groupes d'elements) associes a chaque
  796. C= propriete physique lue (elements avec une correspondance dans Cast3m)
  797. IF (MLIPHY.NE.0) THEN
  798. IF (MLIELT.EQ.0) THEN
  799. WRITE(IOIMP,*) 'ERREUR : DATASET 2412 non lu'
  800. iOK = 21
  801. GOTO 991
  802. ENDIF
  803. IF (NBMAIS.EQ.0) THEN
  804. WRITE(IOIMP,*) 'Pas de GROUPE associe aux proprietes'
  805. ELSE
  806. JG=NBMAIS
  807. SEGINI,MLENTI,MLENT1
  808. DO j=1,NBMAIS
  809. SEGACT,PTMAI(j)
  810. ENDDO
  811. icoul = 1
  812. DO i = 1, NBPHYS
  813. NUMPP = NUMPHY(i)
  814. PTPHY(i) = 0
  815. DO j=1,NBMAIS
  816. LECT(j)=0
  817. MLENT1.LECT(j)=0
  818. ENDDO
  819. DO j=1,NBELTS
  820. IF (IELEM(j,2).EQ.NUMPP) THEN
  821. k = ITYPE(IELEM(j,3),4)
  822. IF (k.NE.0) LECT(k)=LECT(k)+1
  823. ENDIF
  824. ENDDO
  825. NMAIPH=0
  826. NBSOUS=0
  827. NBREF =0
  828. DO j=1,NBMAIS
  829. NBELEM=LECT(j)
  830. IF (NBELEM.NE.0) THEN
  831. NMAIPH=NMAIPH+1
  832. IPT1=PTMAI(j)
  833. NBNN=IPT1.NUM(/1)
  834. SEGINI,MELEME
  835. ITYPEL=IPT1.ITYPEL
  836. DO k=1,NBELEM
  837. ICOLOR(k)=icoul
  838. ENDDO
  839. LECT(j)=MELEME
  840. ENDIF
  841. ENDDO
  842. IF (NMAIPH.EQ.0) GOTO 120
  843. DO j=1,NBELTS
  844. IF (IELEM(j,2).EQ.NUMPP) THEN
  845. k = ITYPE(IELEM(j,3),4)
  846. IF (k.NE.0) THEN
  847. IPT1 =PTMAI(k)
  848. MELEME=LECT(k)
  849. NBNN = NUM(/1)
  850. iel1 = IELEM(j,4)
  851. iel2 = MLENT1.LECT(k)+1
  852. DO l=1,NBNN
  853. NUM(l,iel2)=IPT1.NUM(l,iel1)
  854. ENDDO
  855. MLENT1.LECT(k) = iel2
  856. ENDIF
  857. ENDIF
  858. ENDDO
  859. DO j=1,NBMAIS
  860. MELEME=LECT(j)
  861. IF (MELEME.NE.0) SEGDES,MELEME
  862. ENDDO
  863. IF (NMAIPH.EQ.1) THEN
  864. DO j=1,NBMAIS
  865. MELEME=LECT(j)
  866. IF (MELEME.NE.0) PTPHY(i)=MELEME
  867. ENDDO
  868. ELSE
  869. NBNN=0
  870. NBREF=0
  871. NBSOUS=NMAIPH
  872. SEGINI,MELEME
  873. ISOUS=0
  874. DO j=1,NBMAIS
  875. IPT1=LECT(j)
  876. IF (IPT1.NE.0) THEN
  877. ISOUS=ISOUS+1
  878. LISOUS(ISOUS)=IPT1
  879. ENDIF
  880. ENDDO
  881. SEGDES,MELEME
  882. PTPHY(i)=MELEME
  883. ENDIF
  884. icoul = icoul + 1
  885. IF (icoul.EQ.16) icoul=icoul-15
  886. 120 CONTINUE
  887. ENDDO
  888. SEGSUP,MLENTI,MLENT1
  889. DO j=1,NBMAIS
  890. SEGDES,PTMAI(j)
  891. ENDDO
  892. DO i = 1, NBPHYS
  893. IPT1=PTPHY(i)
  894. IF (IPT1.NE.0) THEN
  895. nom_z = NOMPHY(i)
  896. CALL ECCTAB(MATAB,'MOT ',i_z,r_z,nom_z,b_z,i_z,
  897. & 'MAILLAGE',i_z,r_z,mot_z,b_z,IPT1)
  898. ENDIF
  899. ENDDO
  900. ENDIF
  901. ENDIF
  902. C= Creation des groupes de noeuds ou d'elements ("permanents")
  903. C= Pour permettre la lecture d'"anciens" fichiers UNV...
  904. IF (MLIPEG.NE.0) THEN
  905. IF (MLIELT.EQ.0) THEN
  906. WRITE(IOIMP,*) 'ERREUR : DATASET 2412 non lu'
  907. iOK = 21
  908. GOTO 991
  909. ENDIF
  910. C= Creation d'une liste croissante des elements selon leur numero lu
  911. C= (uniquement s'il y des elements dans les groupes "permanents")
  912. IF (NBPEGE.NE.0) THEN
  913. JG = NBELTS
  914. SEGINI,MLIEL2
  915. MLIEL2.LECT(1) = 1
  916. DO i = 2, NBELTS
  917. INOE = IELEM(i,1)
  918. DO j = i-1, 1, -1
  919. JNO2 = MLIEL2.LECT(j)
  920. JNOE = IELEM(JNO2,1)
  921. IF (JNOE.LE.INOE) GOTO 130
  922. MLIEL2.LECT(j+1) = JNO2
  923. ENDDO
  924. 130 CONTINUE
  925. MLIEL2.LECT(j+1) = i
  926. ENDDO
  927. ENDIF
  928. C*
  929. icoul = 1
  930. JG = NBEFLU
  931. SEGINI,MLENT1
  932. DO i = 1, NBPEGR
  933. DO j = 1, NBEFLU
  934. MLENT1.LECT(j) = 0
  935. ENDDO
  936. c* NUMPH = NUMPEG(i,1)
  937. MLENTI = NUMPEG(i,2)
  938. knoe = NUMPEG(i,3)
  939. kelt = NUMPEG(i,4)
  940. PTPEG(i) = 0
  941. PTPEGN(i) = 0
  942. MELPOI = 0
  943. IF (knoe.EQ.0) GOTO 133
  944. NBNN = 1
  945. NBELEM = knoe
  946. NBREF = 0
  947. NBSOUS = 0
  948. SEGINI,MELEME
  949. ITYPEL = 1
  950. NBPHT = LECT(/1) - knoe
  951. DO k = 1, knoe
  952. INOE = LECT(NBPHT+k)
  953. lInf = 1
  954. lSup = NBNPTS
  955. 131 CONTINUE
  956. IF (lInf.GT.lSup) THEN
  957. WRITE(IOIMP,*) 'ERREUR : Noeud',INOE,'pas dans 2411'
  958. iOK = 21
  959. GOTO 991
  960. ENDIF
  961. lMil = (lInf+lSup)/2
  962. l = MLINO2.LECT(lMil)
  963. JNOE = MLINOE.LECT(l)
  964. IF (INOE.EQ.JNOE) THEN
  965. GOTO 132
  966. ELSE IF (INOE.LT.JNOE) THEN
  967. lSup = lMil - 1
  968. ELSE
  969. lInf = lMil + 1
  970. ENDIF
  971. GOTO 131
  972. 132 CONTINUE
  973. NUM(1,k) = NBANC+l
  974. ICOLOR(k) = icoul
  975. ENDDO
  976. SEGDES,MELEME
  977. MELPOI = MELEME
  978. PTPEG(i) = MELPOI
  979. IF (kelt.EQ.0) GOTO 137
  980. 133 CONTINUE
  981. PTPEGN(i) = MELPOI
  982. DO k = 1, kelt
  983. INOE = LECT(k)
  984. lInf = 1
  985. lSup = NBELTS
  986. 134 CONTINUE
  987. IF (lInf.GT.lSup) THEN
  988. WRITE(IOIMP,*) 'ERREUR : Element',INOE,'pas dans 2412'
  989. iOK = 21
  990. GOTO 991
  991. ENDIF
  992. lMil = (lInf+lSup)/2
  993. l = MLIEL2.LECT(lMil)
  994. JNOE = IELEM(l,1)
  995. IF (INOE.EQ.JNOE) THEN
  996. GOTO 135
  997. ELSE IF (INOE.LT.JNOE) THEN
  998. lSup = lMil - 1
  999. ELSE
  1000. lInf = lMil + 1
  1001. ENDIF
  1002. GOTO 134
  1003. 135 CONTINUE
  1004. LECT(k) = l
  1005. JNOE = IELEM(l,3)
  1006. MLENT1.LECT(JNOE) = MLENT1.LECT(JNOE) + 1
  1007. ENDDO
  1008. NBMAIS = 0
  1009. NBREF = 0
  1010. NBSOUS = 0
  1011. DO j = 1, NBEFLU
  1012. NBELEM = MLENT1.LECT(j)
  1013. IF (NBELEM.EQ.0) GOTO 136
  1014. NBMAIS = NBMAIS + 1
  1015. NUMEF = ITYPE(j,4)
  1016. NBNN = ITYPE(j,2)
  1017. IPT1 = PTMAI(NUMEF)
  1018. SEGACT,IPT1
  1019. SEGINI,MELEME
  1020. ITYPEL = IPT1.ITYPEL
  1021. iel2 = 0
  1022. DO k = 1, kelt
  1023. JNOE = LECT(k)
  1024. l = ITYPE(IELEM(JNOE,3),4)
  1025. IF (l.EQ.NUMEF) THEN
  1026. iel1 = IELEM(JNOE,4)
  1027. iel2 = iel2 + 1
  1028. DO l = 1, NBNN
  1029. NUM(l,iel2) = IPT1.NUM(l,iel1)
  1030. ENDDO
  1031. ICOLOR(iel2) = icoul
  1032. ENDIF
  1033. ENDDO
  1034. SEGDES,IPT1,MELEME
  1035. MLENT1.LECT(j) = MELEME
  1036. 136 CONTINUE
  1037. ENDDO
  1038. IF (NBMAIS.EQ.1) THEN
  1039. IPT2 = MELEME
  1040. ELSE
  1041. NBNN = 0
  1042. NBELEM = 0
  1043. NBREF = 0
  1044. NBSOUS = NBMAIS
  1045. SEGINI,IPT2
  1046. ISOUS = 0
  1047. DO j = 1, NBEFLU
  1048. IPT1 = MLENT1.LECT(j)
  1049. IF (IPT1.NE.0) THEN
  1050. ISOUS = ISOUS + 1
  1051. IPT2.LISOUS(ISOUS) = IPT1
  1052. ENDIF
  1053. ENDDO
  1054. SEGDES,IPT2
  1055. ENDIF
  1056. PTPEG(i) = IPT2
  1057. 137 CONTINUE
  1058. icoul = icoul + 1
  1059. IF (icoul.EQ.16) icoul = icoul-15
  1060. ENDDO
  1061.  
  1062. DO i = 1, NBPEGR
  1063. IPT1 = PTPEG(i)
  1064. j = LONG(NOMPEG(i))
  1065. nom_z = NOMPEG(i)(1:j)
  1066. CALL ECCTAB(MATAB,'MOT ',i_z,r_z,nom_z,b_z,i_z,
  1067. & 'MAILLAGE',i_z,r_z,mot_z,b_z,IPT1)
  1068. IPT1 = PTPEGN(i)
  1069. IF (IPT1.NE.0) THEN
  1070. nom_z = NOMPEG(i)(1:j)//'_GN'
  1071. CALL ECCTAB(MATAB,'MOT ',i_z,r_z,nom_z,b_z,i_z,
  1072. & 'MAILLAGE',i_z,r_z,mot_z,b_z,IPT1)
  1073. ENDIF
  1074. ENDDO
  1075.  
  1076. ENDIF
  1077.  
  1078. C= Ecriture de la TABLE contenant les donnees lues !
  1079. iOK = 0
  1080. CALL ECROBJ('TABLE ',MATAB)
  1081.  
  1082. C= Menage et traitement des erreurs
  1083. 991 CONTINUE
  1084. CLOSE(UNIT=IUUNV)
  1085.  
  1086. IF (MLINOE.NE.0) SEGSUP,MLINOE
  1087. IF (MLINO2.NE.0) SEGSUP,MLINO2
  1088. IF (MLIELT.NE.0) SEGSUP,MLIELT
  1089. IF (MLIEL2.NE.0) SEGSUP,MLIEL2
  1090. IF (MLISEF.NE.0) THEN
  1091. DO i = 1, NBEFLU
  1092. MLENTI = ITYPE(i,5)
  1093. SEGSUP,MLENTI
  1094. ENDDO
  1095. SEGSUP,MLISEF
  1096. ENDIF
  1097. IF (MLIMAI.NE.0) SEGSUP,MLIMAI
  1098. IF (MLIPHY.NE.0) SEGSUP,MLIPHY
  1099. IF (MLIPEG.NE.0) THEN
  1100. DO i = 1, NUMPEG(/1)
  1101. MLENTI = NUMPEG(i,2)
  1102. IF (MLENTI.NE.0) SEGSUP,MLENTI
  1103. ENDDO
  1104. SEGSUP,MLIPEG
  1105. ENDIF
  1106. 990 CONTINUE
  1107. SEGSUP,sredle
  1108. MTABLE=MATAB
  1109. SEGDES,MTABLE
  1110.  
  1111. C= Traitement des erreurs
  1112. IF (iOK.NE.0 .OR. IERR.NE.0) THEN
  1113. IF (iOK.NE.0) CALL ERREUR(iOK)
  1114. SEGSUP,MTABLE
  1115. WRITE(IOIMP,*)
  1116. WRITE(IOIMP,*) 'Retour a la configuration initiale'
  1117. NBPTS = NBANC
  1118. SEGADJ,MCOORD
  1119. IF (IDIMI.NE.0) THEN
  1120. CALL ECRENT(IDIMI)
  1121. CALL ECRCHA('DIME')
  1122. CALL OPTION(1)
  1123. ELSE
  1124. IDIM = IDIMI
  1125. ENDIF
  1126. ENDIF
  1127.  
  1128. WRITE(IOIMP,*)
  1129. RETURN
  1130. END
  1131.  
  1132.  
  1133.  
  1134.  
  1135.  

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