Télécharger isova6.eso

Retour à la liste

Numérotation des lignes :

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

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