Télécharger isova6.eso

Retour à la liste

Numérotation des lignes :

  1. C ISOVA6 SOURCE BP208322 16/11/18 21:17:57 9177
  2. SUBROUTINE ISOVA6(ELEMS,ITYPL)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : ISOVA6
  7. C DESCRIPTION :
  8. * Les piles d'éléments peuvent contenir des informations redondantes :
  9. * - dans une pile d'éléments, plusieurs fois le même
  10. * - dans la pile des POI1, des noeuds déjà présents dans les piles
  11. * de SEG2, TRI3, TET4, PYR5, PRI6, QUA4
  12. * - dans la pile des SEG2, des segments déjà présents dans les piles
  13. * de TRI3, TET4, PYR5, PRI6, QUA4
  14. * - dans la pile des TRI3, des faces déjà présentes dans la pile des
  15. * TET4
  16. * On réduit les piles de manière adéquate.
  17. C
  18. C
  19. C
  20. C LANGAGE : ESOPE
  21. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  22. C mél : gounand@semt2.smts.cea.fr
  23. C***********************************************************************
  24. C VERSION : v1, 15/09/2014, version initiale
  25. C HISTORIQUE : v1, 15/09/2014, création
  26. C HISTORIQUE : v1.1, 16/03/2015, correction anomalie 8433
  27. C HISTORIQUE :
  28. C***********************************************************************
  29. -INC CCOPTIO
  30. -INC CCGEOME
  31. -INC SMLENTI
  32. -INC CCREEL
  33. -INC SMCOORD
  34. *
  35. * Segments ajustables 1D contenant les noeuds des éléments créés ainsi
  36. * que leur couleur
  37. * ELEM(1) contient des POI1
  38. * ELEM(2) contient des SEG2
  39. * ELEM(3) contient des TRI3
  40. * ELEM(4) contient des TET4
  41. * ELEM(5) contient des PYR5
  42. * ELEM(6) contient des PRI6
  43. * ELEM(7) contient des QUA4
  44. *
  45. PARAMETER (NTYEL=7)
  46. SEGMENT ELEMS
  47. POINTEUR ELEM(NTYEL).MLENTI
  48. ENDSEGMENT
  49. * Défini dans isova1
  50. INTEGER ITYPL(NTYEL)
  51. *
  52. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  53. segment inode(ino)
  54. segment jelnum(imaxel,ino)
  55. segment kelnum(imaxel,ino)
  56. segment xelnum(imaxel,ino)
  57. integer locfac(3)
  58. *
  59. LOGICAL LFOUND
  60. *
  61. * Executable statements
  62. *
  63. * Debuggage : ecriture des piles
  64. *dbg do idpil=1,ntyel
  65. *dbg mlenti=elem(idpil)
  66. *dbg ndnode=nbnne(itypl(idpil))
  67. *dbg jdg=lect(/1)
  68. *dbg ndg=jdg/(ndnode+1)
  69. *dbg write(ioimp,*) '*** Pile ',idpil,' : ',ndnode,' noeuds ',ndg,
  70. *dbg $ ' elements'
  71. *dbg do idg=1,ndg
  72. *dbg iddx=(ndnode+1)*(idg-1)
  73. *dbg write(ioimp,147) idg,lect(iddx+ndnode+1),
  74. *dbg $ (lect(iddx+m),m=1,ndnode)
  75. *dbg enddo
  76. *dbg enddo
  77. *dbg 147 format (' element',1X,I6,' coul',1X,I6,10(1X,I6))
  78.  
  79. *
  80. * Il y aurait peut-être eu moyen de faire plus efficace en "flaggant"
  81. * les cas particuliers par rapport au cas général dans isova2.eso
  82. * mais ce serait plus compliqué à coder
  83. *
  84. *dbg write(ioimp,*) '****************************************'
  85. *dbg write(ioimp,*) ' Traitement des points redondants '
  86. *dbg write(ioimp,*) '****************************************'
  87. **********************************************************************
  88. * Traitement des points redondants
  89. **********************************************************************
  90. *
  91. * La pile des points peut contenir des noeuds en double
  92. * on la réduit si nécessaire.
  93. * Egalement, on supprime les noeuds qui sont dans les piles
  94. * ELEM(2-7) car s'ils sont référencés dedans, cela veut dire que
  95. * l'isovaleur s'est arrêtée au bord d'un élément
  96. *
  97. MLENTI=ELEM(1)
  98. JG=LECT(/1)
  99. IF (JG.GT.0) THEN
  100. * Ici, un segment de logiques suffirait
  101. SEGINI ICPR
  102. do ipil=2,7
  103. mlenti=elem(ipil)
  104. nnode=nbnne(itypl(ipil))
  105. jg=lect(/1)
  106. ng=jg/(nnode+1)
  107. do ig=1,ng
  108. do iloc=1,nnode
  109. idx=(nnode+1)*(ig-1)+iloc
  110. * write(ioimp,*) 'nnode=',nnode,' ig=',ig,' iloc=',iloc
  111. * write(ioimp,*) ' idx=',idx
  112. inod=lect(idx)
  113. * write(ioimp,*) ' inod=',inod
  114. if (icpr(inod).eq.0) icpr(inod)=1
  115. enddo
  116. enddo
  117. enddo
  118. * Dans la pile des points, on a des couples (noeud, couleur)
  119. ipil=1
  120. mlenti=elem(ipil)
  121. nnode=nbnne(itypl(ipil))
  122. jg=lect(/1)
  123. ng=jg/(nnode+1)
  124. ired=0
  125. *dbg write(ioimp,*) 'nnode=',nnode,' ig=',ig,' jg=',jg
  126. do ig=1,ng
  127. idx=(nnode+1)*(ig-1)+1
  128. inod=lect(idx)
  129. if (icpr(inod).eq.0) then
  130. icpr(inod)=1
  131. if (ired.gt.0) then
  132. idxr=(nnode+1)*(ig-ired-1)
  133. idx =(nnode+1)*(ig-1)
  134. do iloc=1,nnode+1
  135. lect(idxr+iloc)=lect(idx+iloc)
  136. enddo
  137. endif
  138. else
  139. ired=ired+1
  140. endif
  141. enddo
  142. SEGSUP ICPR
  143. *dbg write(ioimp,*) 'nb noeuds redondants ou deja dans elements ',
  144. *dbg $ ' =',ired
  145. jg=jg-((nnode+1)*ired)
  146. segadj mlenti
  147. ENDIF
  148.  
  149.  
  150. * Debuggage : ecriture des piles
  151. *dbg do idpil=1,ntyel
  152. *dbg mlenti=elem(idpil)
  153. *dbg ndnode=nbnne(itypl(idpil))
  154. *dbg jdg=lect(/1)
  155. *dbg ndg=jdg/(ndnode+1)
  156. *dbg write(ioimp,*) '*** Pile ',idpil,' : ',ndnode,' noeuds ',ndg,
  157. *dbg $ ' elements'
  158. *dbg do idg=1,ndg
  159. *dbg iddx=(ndnode+1)*(idg-1)
  160. *dbg write(ioimp,147) idg,lect(iddx+ndnode+1),
  161. *dbg $ (lect(iddx+m),m=1,ndnode)
  162. *dbg enddo
  163. *dbg enddo
  164.  
  165.  
  166. *dbg write(ioimp,*) '****************************************'
  167. *dbg write(ioimp,*) ' Traitement des segments redondants 1'
  168. *dbg write(ioimp,*) '****************************************'
  169. **********************************************************************
  170. * Traitement des segments redondants
  171. **********************************************************************
  172. *
  173. * On supprime les segments déjà référencés dans les piles d'éléments
  174. * surfaciques... (repris de reduri et chanlg)
  175. *
  176. ipil=2
  177. mlenti=elem(ipil)
  178. nnode=nbnne(itypl(ipil))
  179. jg=lect(/1)
  180. ng=jg/(nnode+1)
  181. IF (JG.GT.0) THEN
  182. *dbg WRITE(IOIMP,*) 'DIME MCOOR=',XCOOR(/1)/(IDIM+1)
  183. SEGINI ICPR
  184. * Création d'une numérotation locale
  185. ino=0
  186. do ig=1,ng
  187. idx=(nnode+1)*(ig-1)
  188. inod1=lect(idx+1)
  189. inod2=lect(idx+2)
  190. ia=max(inod1,inod2)
  191. * WRITE(IOIMP,*) 'ia=',ia
  192. if(icpr(ia).eq.0) then
  193. ino=ino+1
  194. icpr(ia)=ino
  195. endif
  196. enddo
  197. *
  198. * on compte combien de segments touche un noeud
  199. * on réduit la pile des segments en même temps
  200. *
  201. segini inode
  202. do ig=1,ng
  203. idx=(nnode+1)*(ig-1)
  204. inod1=lect(idx+1)
  205. inod2=lect(idx+2)
  206. ia=max(inod1,inod2)
  207. ib=icpr(ia)
  208. inode(ib)=inode(ib)+1
  209. enddo
  210. imaxel=0
  211. do i=1,ino
  212. imaxel=max(imaxel,inode(i))
  213. inode(i)=0
  214. enddo
  215. segini jelnum
  216. ired=0
  217. do 122 ig=1,ng
  218. idx=(nnode+1)*(ig-1)
  219. inod1=lect(idx+1)
  220. inod2=lect(idx+2)
  221. imax=max(inod1,inod2)
  222. imin=min(inod1,inod2)
  223. ib=icpr(imax)
  224. lfound=.false.
  225. do j=1,imaxel
  226. if (jelnum(j,ib).eq.0) then
  227. jelnum(j,ib)=imin
  228. * jelnum(j,ib,2)=lect(idx+3)
  229. inode(ib)=inode(ib)+1
  230. goto 123
  231. elseif (jelnum(j,ib).eq.imin) then
  232. lfound=.true.
  233. goto 123
  234. endif
  235. enddo
  236. 123 continue
  237. if (lfound) then
  238. ired=ired+1
  239. else
  240. if (ired.gt.0) then
  241. idxr=(nnode+1)*(ig-ired-1)
  242. idx =(nnode+1)*(ig-1)
  243. do iloc=1,nnode+1
  244. lect(idxr+iloc)=lect(idx+iloc)
  245. enddo
  246. endif
  247. endif
  248. 122 continue
  249. *dbg write(ioimp,*) 'nb seg redondants pile segments=',ired
  250. *dbg write(ioimp,*) ' nb segments*3=',jg
  251. jg=jg-((nnode+1)*ired)
  252. segadj mlenti
  253. *dbg write(ioimp,*) ' nb segments*3 apres=',jg
  254.  
  255.  
  256. * Debuggage : ecriture des piles
  257. *dbg do idpil=1,ntyel
  258. *dbg mlenti=elem(idpil)
  259. *dbg ndnode=nbnne(itypl(idpil))
  260. *dbg jdg=lect(/1)
  261. *dbg ndg=jdg/(ndnode+1)
  262. *dbg write(ioimp,*) '*** Pile ',idpil,' : ',ndnode,' noeuds ',ndg,
  263. *dbg $ ' elements'
  264. *dbg do idg=1,ndg
  265. *dbg iddx=(ndnode+1)*(idg-1)
  266. *dbg write(ioimp,147) idg,lect(iddx+ndnode+1),
  267. *dbg $ (lect(iddx+m),m=1,ndnode)
  268. *dbg enddo
  269. *dbg enddo
  270.  
  271.  
  272.  
  273.  
  274. *
  275. * Ici, on parcourt les segments des éléments
  276. * on met jelnum(j,ib) en négatif si on veut l'éliminer
  277. *
  278. * write(ioimp,*) 'parcours des segments des éléments'
  279. if (jg.gt.0) then
  280. do ipil=3,7
  281. * write(ioimp,*) ' ipil=',ipil
  282. mlenti=elem(ipil)
  283. nnode=nbnne(itypl(ipil))
  284. * write(ioimp,*) ' nnode=',nnode
  285. jg=lect(/1)
  286. * write(ioimp,*) ' jg=',jg
  287. ng=jg/(nnode+1)
  288. * write(ioimp,*) ' ng=',ng
  289. if (jg.gt.0) then
  290. ityp=itypl(ipil)
  291. * write(ioimp,*) 'ipil=',ipil,' ityp=',ityp
  292. nseg=LPL(ityp)
  293. idxseg=LPT(ityp)-1
  294. * Parcours des éléments de la pile
  295. do ig=1,ng
  296. idx=(nnode+1)*(ig-1)
  297. * Parcours des segments des éléments
  298. do iseg=1,nseg
  299. iloc1=KSEGM(idxseg+2*(iseg-1)+1)
  300. iloc2=KSEGM(idxseg+2*(iseg-1)+2)
  301. inod1=lect(idx+iloc1)
  302. inod2=lect(idx+iloc2)
  303. * write(ioimp,*) 'iseg=',iseg,' iloc1=',iloc1,
  304. * $ ' iloc2=',iloc2
  305. * write(ioimp,*) ' inod1=',inod1,
  306. * $ ' inod2=',inod2
  307. imax=max(inod1,inod2)
  308. imin=min(inod1,inod2)
  309. ib=icpr(imax)
  310. if (ib.ne.0) then
  311. do j=1,inode(ib)
  312. jmin=jelnum(j,ib)
  313. jamin=abs(jmin)
  314. if (jamin.eq.imin) then
  315. if (jmin.gt.0) jelnum(j,ib)=-jmin
  316. goto 125
  317. endif
  318. enddo
  319. endif
  320. 125 continue
  321. enddo
  322. enddo
  323. endif
  324. enddo
  325. *
  326. * On réduit à nouveau la pile des segments. Le imin est négatif dans
  327. * jelnum pour les segments que l'on ne souhaite pas garder
  328. *
  329. ipil=2
  330. mlenti=elem(ipil)
  331. nnode=nbnne(itypl(ipil))
  332. jg=lect(/1)
  333. ng=jg/(nnode+1)
  334. ired=0
  335. do 126 ig=1,ng
  336. idx=(nnode+1)*(ig-1)
  337. inod1=lect(idx+1)
  338. inod2=lect(idx+2)
  339. imax=max(inod1,inod2)
  340. imin=min(inod1,inod2)
  341. ib=icpr(imax)
  342. lfound=.false.
  343. do j=1,inode(ib)
  344. jmin=jelnum(j,ib)
  345. jamin=abs(jmin)
  346. if (jamin.eq.imin) then
  347. if (jmin.lt.0) then
  348. lfound=.true.
  349. endif
  350. goto 127
  351. endif
  352. enddo
  353. 127 continue
  354. if (lfound) then
  355. ired=ired+1
  356. else
  357. if (ired.gt.0) then
  358. idxr=(nnode+1)*(ig-ired-1)
  359. idx =(nnode+1)*(ig-1)
  360. do iloc=1,nnode+1
  361. lect(idxr+iloc)=lect(idx+iloc)
  362. enddo
  363. endif
  364. endif
  365. * enddo
  366. 126 continue
  367. *dbg write(ioimp,*) 'nb seg pile elts surf volu =',ired
  368. jg=jg-((nnode+1)*ired)
  369. segadj mlenti
  370. endif
  371. segsup jelnum
  372. segsup inode
  373. segsup icpr
  374. ENDIF
  375.  
  376. *dbg write(ioimp,*) '****************************************'
  377. *dbg write(ioimp,*) ' Traitement des segments redondants 2'
  378. *dbg write(ioimp,*) '****************************************'
  379.  
  380. * Debuggage : ecriture des piles
  381. *dbg do idpil=1,ntyel
  382. *dbg mlenti=elem(idpil)
  383. *dbg ndnode=nbnne(itypl(idpil))
  384. *dbg jdg=lect(/1)
  385. *dbg ndg=jdg/(ndnode+1)
  386. *dbg write(ioimp,*) '*** Pile ',idpil,' : ',ndnode,' noeuds ',ndg,
  387. *dbg $ ' elements'
  388. *dbg do idg=1,ndg
  389. *dbg iddx=(ndnode+1)*(idg-1)
  390. *dbg write(ioimp,147) idg,lect(iddx+ndnode+1),
  391. *dbg $ (lect(iddx+m),m=1,ndnode)
  392. *dbg enddo
  393. *dbg enddo
  394.  
  395.  
  396.  
  397. *dbg write(ioimp,*) '*****************************************'
  398. *dbg write(ioimp,*) ' Traitement des triangles redondants 1'
  399. *dbg write(ioimp,*) '*****************************************'
  400. **********************************************************************
  401. * Traitement des faces (triangulaires) redondantes
  402. **********************************************************************
  403. ipil=3
  404. mlenti=elem(ipil)
  405. nnode=nbnne(itypl(ipil))
  406. jg=lect(/1)
  407. ng=jg/(nnode+1)
  408. IF (JG.GT.0) THEN
  409. *dbg WRITE(IOIMP,*) 'DIME MCOOR=',XCOOR(/1)/(IDIM+1)
  410. SEGINI ICPR
  411. * Création d'une numérotation locale
  412. ino=0
  413. do ig=1,ng
  414. idx=(nnode+1)*(ig-1)
  415. inod1=lect(idx+1)
  416. inod2=lect(idx+2)
  417. inod3=lect(idx+3)
  418. ia=max(inod1,inod2,inod3)
  419. * WRITE(IOIMP,*) 'ia=',ia
  420. if(icpr(ia).eq.0) then
  421. ino=ino+1
  422. icpr(ia)=ino
  423. endif
  424. enddo
  425. *
  426. * on compte combien de faces triangulaires touche un noeud
  427. * on réduit la pile des faces triangulaires en même temps
  428. *
  429. segini inode
  430. do ig=1,ng
  431. idx=(nnode+1)*(ig-1)
  432. inod1=lect(idx+1)
  433. inod2=lect(idx+2)
  434. inod3=lect(idx+3)
  435. ia=max(inod1,inod2,inod3)
  436. ib=icpr(ia)
  437. inode(ib)=inode(ib)+1
  438. enddo
  439. imaxel=0
  440. do i=1,ino
  441. imaxel=max(imaxel,inode(i))
  442. inode(i)=0
  443. enddo
  444. segini jelnum
  445. segini kelnum
  446. ired=0
  447. do 222 ig=1,ng
  448. idx=(nnode+1)*(ig-1)
  449. do inno=1,3
  450. locfac(inno)=lect(idx+inno)
  451. enddo
  452. call knuta(3,locfac)
  453. imin=locfac(1)
  454. imoy=locfac(2)
  455. imax=locfac(3)
  456. ib=icpr(imax)
  457. lfound=.false.
  458. do j=1,imaxel
  459. if (jelnum(j,ib).eq.0) then
  460. jelnum(j,ib)=imin
  461. kelnum(j,ib)=imoy
  462. inode(ib)=inode(ib)+1
  463. goto 223
  464. elseif ((jelnum(j,ib).eq.imin).and.
  465. $ (kelnum(j,ib).eq.imoy)) then
  466. lfound=.true.
  467. goto 223
  468. endif
  469. enddo
  470. 223 continue
  471. if (lfound) then
  472. ired=ired+1
  473. else
  474. if (ired.gt.0) then
  475. idxr=(nnode+1)*(ig-ired-1)
  476. idx =(nnode+1)*(ig-1)
  477. do iloc=1,nnode+1
  478. lect(idxr+iloc)=lect(idx+iloc)
  479. enddo
  480. endif
  481. endif
  482. 222 continue
  483. *dbg write(ioimp,*) 'nb fac redondants pile faces=',ired
  484. * write(ioimp,*) ' nb segments*3=',jg
  485. jg=jg-((nnode+1)*ired)
  486. segadj mlenti
  487. *
  488. * Ici, on parcourt les faces des éléments tétraédriques
  489. * on met jelnum(j,ib) en négatif si on veut l'éliminer
  490. *
  491. * write(ioimp,*) 'parcours des faces des éléments tétra'
  492. if (jg.gt.0) then
  493. ipil=4
  494. * write(ioimp,*) ' ipil=',ipil
  495. mlenti=elem(ipil)
  496. nnode=nbnne(itypl(ipil))
  497. * write(ioimp,*) ' nnode=',nnode
  498. jg=lect(/1)
  499. * write(ioimp,*) ' jg=',jg
  500. ng=jg/(nnode+1)
  501. * write(ioimp,*) ' ng=',ng
  502. if (jg.gt.0) then
  503. ityp=itypl(ipil)
  504. * write(ioimp,*) 'ipil=',ipil,' ityp=',ityp
  505. nfac=LTEL(1,ityp)
  506. idxdel=LTEL(2,ityp)
  507. *dbg write(ioimp,*) 'nfac=',nfac
  508. if (nfac.ne.4) then
  509. call erreur(5)
  510. return
  511. endif
  512. * Parcours des éléments de la pile
  513. do ig=1,ng
  514. idx=(nnode+1)*(ig-1)
  515. * Parcours des faces des éléments
  516. do ifac=1,nfac
  517. *dbg
  518. ityfac=LDEL(1,idxdel+ifac-1)
  519. *dbg write(ioimp,*) 'ityfac=',ityfac
  520. if (ityfac.ne.1) then
  521. call erreur(5)
  522. return
  523. endif
  524. *dbg
  525. idxfac=LDEL(2,idxdel+ifac-1)
  526. iloc1=LFAC(idxfac)
  527. iloc2=LFAC(idxfac+1)
  528. iloc3=LFAC(idxfac+2)
  529. locfac(1)=lect(idx+iloc1)
  530. locfac(2)=lect(idx+iloc2)
  531. locfac(3)=lect(idx+iloc3)
  532. *dbg write(ioimp,*) 'ifac=',ifac,' iloc1=',iloc1,
  533. *dbg $ ' iloc2=',iloc2,' iloc3=',iloc3
  534. *dbg write(ioimp,*) ' locfac(1)=',locfac(1)
  535. *dbg $ ,' locfac(2)=',locfac(2),' locfac(3)='
  536. *dbg $ ,locfac(3)
  537. call knuta(3,locfac)
  538. imin=locfac(1)
  539. imoy=locfac(2)
  540. imax=locfac(3)
  541. ib=icpr(imax)
  542. if (ib.ne.0) then
  543. do j=1,inode(ib)
  544. jmin=jelnum(j,ib)
  545. jmoy=kelnum(j,ib)
  546. jamin=abs(jmin)
  547. if (jamin.eq.imin.and.jmoy.eq.imoy) then
  548. if (jmin.gt.0) jelnum(j,ib)=-jmin
  549. goto 225
  550. endif
  551. enddo
  552. endif
  553. 225 continue
  554. enddo
  555. enddo
  556. endif
  557. *
  558. * On réduit la pile des faces triangulaires. Le imin est négatif dans
  559. * jelnum pour les faces que l'on ne souhaite pas garder
  560. *
  561. ipil=3
  562. mlenti=elem(ipil)
  563. nnode=nbnne(itypl(ipil))
  564. jg=lect(/1)
  565. ng=jg/(nnode+1)
  566. ired=0
  567. do 226 ig=1,ng
  568. idx=(nnode+1)*(ig-1)
  569. do inno=1,3
  570. locfac(inno)=lect(idx+inno)
  571. enddo
  572. call knuta(3,locfac)
  573. imin=locfac(1)
  574. imoy=locfac(2)
  575. imax=locfac(3)
  576. ib=icpr(imax)
  577. lfound=.false.
  578. do j=1,inode(ib)
  579. jmin=jelnum(j,ib)
  580. jmoy=kelnum(j,ib)
  581. jamin=abs(jmin)
  582. if (jamin.eq.imin.and.jmoy.eq.imoy) then
  583. if (jmin.lt.0) then
  584. lfound=.true.
  585. endif
  586. goto 227
  587. endif
  588. enddo
  589. 227 continue
  590. if (lfound) then
  591. ired=ired+1
  592. else
  593. if (ired.gt.0) then
  594. idxr=(nnode+1)*(ig-ired-1)
  595. idx =(nnode+1)*(ig-1)
  596. do iloc=1,nnode+1
  597. lect(idxr+iloc)=lect(idx+iloc)
  598. enddo
  599. endif
  600. endif
  601. * enddo
  602. 226 continue
  603. *dbg write(ioimp,*) 'nb fac pile elts volu =',ired
  604. jg=jg-((nnode+1)*ired)
  605. segadj mlenti
  606. endif
  607. segsup kelnum
  608. segsup jelnum
  609. segsup inode
  610. segsup icpr
  611. ENDIF
  612.  
  613. *dbg write(ioimp,*) '*****************************************'
  614. *dbg write(ioimp,*) ' Traitement des triangles redondants 2'
  615. *dbg write(ioimp,*) '*****************************************'
  616.  
  617.  
  618. * Debuggage : ecriture des piles
  619. *dbg do ipil=1,ntyel
  620. *dbg mlenti=elem(ipil)
  621. *dbg nnode=nbnne(itypl(ipil))
  622. *dbg jg=lect(/1)
  623. *dbg ng=jg/(nnode+1)
  624. *dbg write(ioimp,*) '*** Pile ',ipil,' : ',nnode,' noeuds ',ng,
  625. *dbg $ ' elements'
  626. *dbg do ig=1,ng
  627. *dbg idx=(nnode+1)*(ig-1)
  628. *dbg write(ioimp,147) ig,lect(idx+nnode+1),
  629. *dbg $ (lect(idx+m),m=1,nnode)
  630. *dbg enddo
  631. *dbg enddo
  632.  
  633.  
  634. *
  635. * End of subroutine ISOVA6
  636. *
  637. END
  638.  
  639.  
  640.  
  641.  
  642.  
  643.  
  644.  
  645.  

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