Télécharger proob1.eso

Retour à la liste

Numérotation des lignes :

  1. C PROOB1 SOURCE CHAT 05/01/13 02:34:04 5004
  2. C CE PROGRAMME PERMET LA PROJECTION D'UN MAILLAGE 3D SUR UNE SUFACE
  3. C CARACTERISEE PAR UN AUTRE MAILLAGE 3D.
  4.  
  5. C ENTREES MAI2 : UN MAILLAGE DE TYPE MELEME A PROJETER.
  6. C MAI1 : UN MAILLAGE REPRESENTANT LA SURFACE SUR LAQUELLE MAI2
  7. C EST PROJETE.
  8. C IPOIN : UN POINT S' IL S'AGIT D'UN POINT A PROJETER.
  9. C IP1 : UN VECTEUR DEFINISSANT LA DIRECTION DE PROJECTION.
  10.  
  11. C DATE: AOUT 1996.
  12.  
  13. C **********************************************************************
  14. Subroutine proob1(mai2,mai1,ip1)
  15. IMPLICIT INTEGER(I-N)
  16. IMPLICIT REAL*8(A-H,O-Z)
  17.  
  18. -INC CCOPTIO
  19. -INC SMELEME
  20. -INC SMCOORD
  21. -INC CCREEL
  22. SEGMENT ISEG1
  23. REAL*8 XLIM(2,NBEL),YLIM(2,NBEL),ZLIM(2,NBEL)
  24. ENDSEGMENT
  25.  
  26. SEGMENT ISEG3
  27. INTEGER NIZO(NZO+1)
  28. ENDSEGMENT
  29.  
  30. SEGMENT ISEG4
  31. INTEGER NUMZO(NZO)
  32. ENDSEGMENT
  33.  
  34. SEGMENT ISEG5
  35. INTEGER NNMEL(ILON),IDEJ(NZO)
  36. ENDSEGMENT
  37.  
  38. SEGMENT ISEG6
  39. REAL*8 AM(4,4),AL(4),A(4),B(4),C(4)
  40. REAL*8 XPU(2),P(3)
  41. ENDSEGMENT
  42.  
  43. SEGMENT MCOOR1
  44. REAL*8 XCOOR1(XCOOR(/1))
  45. ENDSEGMENT
  46. C LA DERNIERE COORDONNEE D'UN POINT N'EST PAS UTILISEE.
  47.  
  48. SEGMENT MCOOR2
  49. REAL*8 XCOOR2(XCOOR(/1))
  50. ENDSEGMENT
  51. C LA DERNIERE COORDONNEE D'UN POINT N'EST PAS UTILISEE.
  52.  
  53. SEGMENT MCOR
  54. INTEGER ICOR(IONMAX+1)
  55. ENDSEGMENT
  56.  
  57. SEGMENT MCORRE
  58. INTEGER ICORRE((XCOOR(/1)/(IDIM+1)))
  59. ENDSEGMENT
  60.  
  61. SEGMENT ICP1
  62. INTEGER ICPR1(XCOOR(/1)/(IDIM+1))
  63. ENDSEGMENT
  64.  
  65. SEGMENT ICP2
  66. INTEGER ICPR2(XCOOR(/1)/(IDIM+1))
  67. ENDSEGMENT
  68.  
  69. SEGMENT MATRIC
  70. REAL*8 TABMAT(3,3),invma(3,3)
  71. ENDSEGMENT
  72.  
  73. C PASSAGE DU MAILLAGE MAI1 EN TRI3
  74. call change(mai1,4)
  75. C CREATION DE LA MATRICE DE CHANGEMENT DE BASE
  76. segini matric
  77. v1=xcoor((ip1-1)*(idim+1)+1)
  78. v2=xcoor((ip1-1)*(idim+1)+2)
  79. v3=xcoor((ip1-1)*(idim+1)+3)
  80. r1=sqrt(v1*v1+v2*v2+v3*v3)
  81. if( r1 . EQ. 0. ) then
  82. call erreur ( 21 )
  83. endif
  84. v1 = V1 / r1
  85. v2 = v2 / r1
  86. v3 = v3 / r1
  87. r2=sqrt(v1*v1+v2*v2)
  88. if ( r2 . gt. 1.e-5) then
  89. tabmat(1,1)=-v2/r2
  90. tabmat(1,2)=v1/r2
  91. tabmat(1,3)=0.
  92. else
  93. tabmat(1,1)=1.
  94. tabmat(1,2)=0.
  95. tabmat(1,3)=0.
  96. endif
  97. tabmat(2,1)=-v3*tabmat(1,2)
  98. tabmat(2,2)=v3*tabmat(1,1)
  99. tabmat(2,3)=v1*tabmat(1,2)-v2*tabmat(1,1)
  100. tabmat(3,1)=v1
  101. tabmat(3,2)=v2
  102. tabmat(3,3)=v3
  103. * pas besoin de diviser par le determinant car egal à 1.
  104. INVMA(1,1)= TABMAT(2,2)*TABMAT(3,3)-TABMAT(3,2)*TABMAT(2,3)
  105. INVMA(1,2)=-TABMAT(1,2)*TABMAT(3,3)+TABMAT(3,2)*TABMAT(1,3)
  106. INVMA(1,3)= TABMAT(1,2)*TABMAT(2,3)-TABMAT(2,2)*TABMAT(1,3)
  107. INVMA(2,1)=-TABMAT(2,1)*TABMAT(3,3)+TABMAT(3,1)*TABMAT(2,3)
  108. INVMA(2,2)= TABMAT(1,1)*TABMAT(3,3)-TABMAT(3,1)*TABMAT(1,3)
  109. INVMA(2,3)=-TABMAT(1,1)*TABMAT(2,3)+TABMAT(2,1)*TABMAT(1,3)
  110. INVMA(3,1)= TABMAT(2,1)*TABMAT(3,2)-TABMAT(2,2)*TABMAT(3,1)
  111. INVMA(3,2)=-TABMAT(1,1)*TABMAT(3,2)+TABMAT(3,1)*TABMAT(1,2)
  112. INVMA(3,3)= TABMAT(1,1)*TABMAT(2,2)-TABMAT(2,1)*TABMAT(1,2)
  113.  
  114. C LISTAGE DES POINTS APPARTENANT A MAI1
  115. segini icp1
  116. nbpts = xcoor(/1)/( idim+1)
  117. meleme=mai1
  118. segact meleme
  119. nbelem=num(/2)
  120. nbnn = num(/1)
  121. Do 10 i=1,nbelem
  122. Do 20 j=1,nbnn
  123. ia=num(j,i)
  124. icpr1(ia)=1
  125. 20 continue
  126. 10 continue
  127.  
  128. C LISTAGE DES POINTS APPARTENANT A MAI2
  129. ipt1=mai2
  130. segact ipt1
  131. segini icp2
  132. nbelem= ipt1.num(/2)
  133. nbnn = ipt1.num(/1)
  134. Do 30 i=1,nbelem
  135. Do 40 j=1,nbnn
  136. ia=ipt1.num(j,i)
  137. If (icpr1(ia).eq.1) then
  138. icpr2(ia)=2
  139. else
  140. icpr2(ia)=1
  141. Endif
  142. 40 continue
  143. 30 continue
  144.  
  145. C CALCUL DES COORDONNEES DANS LE NOUVEAU REPERE
  146. segini mcoor1
  147. nbpts=xcoor(/1)/(idim+1)
  148. Do 31 ia=1,nbpts
  149. If (icpr1(ia).eq.1) then
  150. xia1=xcoor((ia-1)*(idim+1)+1)
  151. xia2=xcoor((ia-1)*(idim+1)+2)
  152. xia3=xcoor((ia-1)*(idim+1)+3)
  153. Do 32 j=1,3
  154. xcoor1((ia-1)*(idim+1)+j)=(xia1*tabmat(j,1))+
  155. $(xia2*tabmat(j,2))+(xia3*tabmat(j,3))
  156. 32 continue
  157. Endif
  158. 31 continue
  159.  
  160. segini mcoor2
  161. Do 33 ia=1,nbpts
  162. If (icpr2(ia).eq.1) then
  163. xia1=xcoor((ia-1)*(idim+1)+1)
  164. xia2=xcoor((ia-1)*(idim+1)+2)
  165. xia3=xcoor((ia-1)*(idim+1)+3)
  166. Do 34 j=1,3
  167. xcoor2((ia-1)*(idim+1)+j)=(xia1*tabmat(j,1))+
  168. $(xia2*tabmat(j,2))+(xia3*tabmat(j,3))
  169. 34 continue
  170. Endif
  171. If (icpr2(ia).eq.2) then
  172. xia1=xcoor((ia-1)*(idim+1)+1)
  173. xia2=xcoor((ia-1)*(idim+1)+2)
  174. xia3=xcoor((ia-1)*(idim+1)+3)
  175. Do 35 j=1,3
  176. xcoor2((ia-1)*(idim+1)+j)=(xia1*tabmat(j,1))+
  177. $(xia2*tabmat(j,2))+(xia3*tabmat(j,3))
  178. 35 continue
  179. Endif
  180. 33 continue
  181.  
  182. C******************** DEBUT DU ZONAGE DE MAI1 **********************
  183.  
  184. C ON CALCULE LA TAILLE MAXI D'UN ELEMENT DANS TOUTES LES DIRECTIONS
  185. C AFIN DE CREER UN ZONAGE DE L'ESPACE. EN MEME TEMPS ON CALCULE
  186. C LA DIMENSION HORS TOUT DU MAILLAGE
  187. C
  188. IDIM1=4
  189. NBEL = NUM(/2)
  190. NBNN=NUM(/1)
  191. SEGINI ISEG1
  192. ILOC=0
  193. XZO=0.D0
  194. YZO=0.D0
  195. ZZO=0.D0
  196. XZA=XGRAND
  197. YZA=XGRAND
  198. ZZA=XGRAND
  199. XTOMI=XGRAND
  200. XTOMA=-XGRAND
  201. YTOMI=XGRAND
  202. YTOMA=-XGRAND
  203. ZTOMI=XGRAND
  204. ZTOMA=-XGRAND
  205. DO 1 I1=1,NBEL
  206. XMI=XGRAND
  207. YMI=XGRAND
  208. ZMI=XGRAND
  209. YMA=-XGRAND
  210. XMA=-XGRAND
  211. ZMA=-XGRAND
  212. DO 2 I2 = 1,NBNN
  213. IB=NUM(I2,I1)
  214. IA=(IB-1)*IDIM1
  215. IF(XCOOR1(IA+1).LT.XMI) XMI=XCOOR1(IA+1)
  216. IF(XCOOR1(IA+1).GT.XMA) XMA=XCOOR1(IA+1)
  217. IF(XCOOR1(IA+2).LT.YMI) YMI=XCOOR1(IA+2)
  218. IF(XCOOR1(IA+2).GT.YMA) YMA=XCOOR1(IA+2)
  219. 2 CONTINUE
  220. XLIM(1,I1)=XMI
  221. XLIM(2,I1)=XMA
  222. YLIM(1,I1)=YMI
  223. YLIM(2,I1)=YMA
  224. XZO=MAX (XZO,XMA-XMI)
  225. YZO=MAX (YZO,YMA-YMI)
  226. XZA=MIN(XZA,XMA-XMI)
  227. YZA=MIN(YZA,YMA-YMI)
  228. IF(XMI.LT.XTOMI) XTOMI=XMI
  229. IF(XMA.GT.XTOMA) XTOMA=XMA
  230. IF(YMI.LT.YTOMI) YTOMI=YMI
  231. IF(YMA.GT.YTOMA) YTOMA=YMA
  232.  
  233. 1 CONTINUE
  234. XPR=MIN(XZO*1.D-2,(XTOMA-XTOMI)/2.D+4)
  235. YPR=MIN(YZO*1.D-2,(YTOMA-YTOMI)/2.D+4)
  236. XZA=XZA*0.97
  237. YZA=YZA*0.97
  238. XTOMI= XTOMI - (XTOMA-XTOMI)/1.D+4
  239. XTOMA= XTOMA + (XTOMA-XTOMI)/1.D+4
  240. YTOMI= YTOMI - (YTOMA-YTOMI)/1.D+4
  241. YTOMA= YTOMA + (YTOMA-YTOMI)/1.D+4
  242. XZA=MIN ( XZA, XTOMA-XTOMI)
  243. YZA=MIN ( YZA, YTOMA-YTOMI)
  244. XZA = max ( xza , (XTOMA-XTOMI) / 50)
  245. YZA = max ( yza , (YTOMA-YTOMI) / 50)
  246. NXZO=(XTOMA-XTOMI)/XZA + 1
  247. NYZO=(YTOMA-YTOMI)/YZA + 1
  248. XZO=XZA
  249. YZO=YZA
  250. NZZO=1
  251. NXDEP=MIN(NXZO,10)
  252. NYDEP=MIN(NYZO,10)
  253. IF(FLOAT(NXZO)*FLOAT(NYZO).GT.10000.) THEN
  254. XY=SQRT(FLOAT(NXZO)*FLOAT(NYZO))/90
  255. NXZO=MAX(INT(NXZO/XY),NXDEP)
  256. NYZO=MAX(INT(NYZO/XY),NYDEP)
  257. IF(FLOAT(NXZO)*FLOAT(NYZO).GT.10000.) THEN
  258. XY=SQRT(FLOAT(NXZO)*FLOAT(NYZO))/60
  259. NXZO=MAX(INT(NXZO/XY),NXDEP)
  260. NYZO=MAX(INT(NYZO/XY),NYDEP)
  261. ENDIF
  262. XZO=(XTOMA-XTOMI)/NXZO
  263. YZO=(YTOMA-YTOMI)/NYZO
  264. NXZO=(XTOMA-XTOMI)/XZO +1
  265. NYZO=(YTOMA-YTOMI)/YZO +1
  266. ENDIF
  267.  
  268. C
  269. C ON VEUT CONSTRUIRE LA LISTE DES ELEMENTS TOUCHANT UNE ZONE
  270. C POUR CELA ON COMMENCE PAR COMPTER COMBIEN D'ELEMENT TOUCHENT
  271. C CHAQUE ZONE ET EN MEME TEMPS ON STOCKE LES ZONES TOUCHEES
  272. C PAR CHAQUE ELEMENT ET LEUR NOMBRE
  273. C
  274.  
  275. NZO=NXZO*NYZO
  276. IF(IIMPI.NE.0)WRITE(IOIMP,FMT='('' NZO NXZO NYZO NZZO ''
  277. $,4I7) ') NZO,NXZO,NYZO,NZZO
  278. NXYZO=NXZO*NYZO
  279. SEGINI ISEG3
  280. SEGINI ISEG4
  281. DO 3 I1=1,NBEL
  282. NIZ1X=INT((XLIM(1,I1)-XTOMI-XPR)/XZO) +1
  283. NIZ1Y=INT((YLIM(1,I1)-YTOMI-YPR)/YZO) +1
  284. NIZ2X=INT((XLIM(2,I1)-XTOMI+XPR)/XZO) +1
  285. NIZ2Y=INT((YLIM(2,I1)-YTOMI+YPR)/YZO) +1
  286. DO 201 L1=NIZ1Y,NIZ2Y
  287. DO 201 L2=NIZ1X,NIZ2X
  288. NIZA = L2 + ( L1-1) * NXZO
  289. NUMZO(NIZA) = NUMZO(NIZA) +1
  290. 201 CONTINUE
  291. 3 CONTINUE
  292. C
  293. C CONSTRUCTION DU TABLEAU D'ADRESSAGE DU TABLEAU DONNANT LES
  294. C ELEMENTS CONCERNEES PAR UNE ZONE
  295. C
  296. ILON=0
  297. NIZO(1)=1
  298. DO 202 L1=1,NZO
  299. NIZO(L1+1)=NIZO(L1)+NUMZO(L1)
  300. ILON=ILON+ NUMZO(L1)
  301. 202 CONTINUE
  302. 110 FORMAT(16I5)
  303. SEGINI ISEG5
  304. DO 5 I1=1,NBEL
  305. NIZ1X=INT((XLIM(1,I1)-XTOMI-XPR)/XZO) + 1
  306. NIZ1Y=INT((YLIM(1,I1)-YTOMI-YPR)/YZO) + 1
  307. NIZ2X=INT((XLIM(2,I1)-XTOMI+XPR)/XZO) + 1
  308. NIZ2Y=INT((YLIM(2,I1)-YTOMI+YPR)/YZO) + 1
  309. DO 203 L1=NIZ1Y,NIZ2Y
  310. DO 203 L2=NIZ1X,NIZ2X
  311. NIZA = L2 + ( L1-1) * NXZO
  312. IAD=NIZO(NIZA)+IDEJ(NIZA)
  313. NNMEL(IAD)=I1
  314. IDEJ(NIZA)=IDEJ(NIZA)+1
  315. 203 CONTINUE
  316. 5 CONTINUE
  317. C *********************** FIN DU ZONAGE DE MAI1 **************************
  318. prec = 1.E-5
  319. prec2 = -prec
  320. prec3 = -2.E-3
  321. C ******RECHERCHE DU NOMBRE D'ELEMENT MAX CONTENU DANS UNE ZONE***********
  322. la=0
  323. ls=0
  324. Do 420 i=1,nzo
  325. ls=ls+numzo(i)
  326. If (numzo(i).gt.la) then
  327. la=numzo(i)
  328. Endif
  329. 420 continue
  330. ionmax=la
  331.  
  332. C ****************** TRAITEMENT SUR LES POINTS DE MAI2 *******************
  333. nbelem=num(/2)
  334. nbnn=num(/1)
  335. nbpts=xcoor(/1)/(idim+1)
  336. nbpts2=nbpts
  337. segini mcor,mcorre,iseg6
  338. Do 405 ia=1,nbpts2
  339. If (icpr2(ia).eq.2) then
  340. icorre(ia)=ia
  341. Endif
  342. If (icpr2(ia).eq.1) then
  343. xpu(1)=xcoor2((ia-1)*(idim+1)+1)
  344. xpu(2)=xcoor2((ia-1)*(idim+1)+2)
  345. if (((xpu(1)-xtomi).lt.prec.) .or.
  346. $ ((xpu(2)-ytomi).lt.prec.) .or.
  347. $ ((xpu(1)-xtoma).gt.prec2.) .or.
  348. $ ((xpu(2)-ytoma).gt.prec2.)) then
  349. call erreur(21)
  350. return
  351. endif
  352. C RECHERCHE DU NUMERO DE LA ZONE CORRESPONDANTE
  353. k2=int(((xcoor2((ia-1)*(idim+1)+1))-xtomi-xpr)/xzo)+1
  354. k1=int(((xcoor2((ia-1)*(idim+1)+2))-ytomi-ypr)/yzo)+1
  355. niza=k2+(k1-1)*nxzo
  356. C INVENTAIRE DES ELEMENTS CONCERNES PAR LE POINT IA
  357. iad=nizo(niza)
  358. Do 406 i=1,numzo(niza)
  359. i1=nnmel(iad)
  360. C CALCUL DES COORDONNEES BARYCENTRIQUES DE IA DANS L'ELEMENT I1
  361. j1=num(1,i1)
  362. j2=num(2,i1)
  363. j3=num(3,i1)
  364. j1idim=(j1-1)*(idim+1)
  365. j2idim=(j2-1)*(idim+1)
  366. j3idim=(j3-1)*(idim+1)
  367. Do 408 l=1,2
  368. p(l+1)=xpu(l)
  369. am(l+1,1)=xcoor1(j1idim+l)
  370. am(l+1,2)=xcoor1(j2idim+l)
  371. am(l+1,3)=xcoor1(j3idim+l)
  372. 408 continue
  373. x1=am(2,1)
  374. x2=am(2,2)
  375. x3=am(2,3)
  376. y1=am(3,1)
  377. y2=am(3,2)
  378. y3=am(3,3)
  379. x=p(2)
  380. y=p(3)
  381. detam=x1*y2+x2*y3+x3*y1-y1*x2-y2*x3-y3*x1
  382. a(1)=x2*y3-y2*x3
  383. a(2)=x3*y1-x1*y3
  384. a(3)=x1*y2-x2*y1
  385. b(1)=y2-y3
  386. b(2)=y3-y1
  387. b(3)=y1-y2
  388. c(1)=x3-x2
  389. c(2)=x1-x3
  390. c(3)=x2-x1
  391. Do 409 k=1,nbnn
  392. al(k)=(a(k)+b(k)*x+c(k)*y)/detam
  393. 409 continue
  394. C TEST DE POSITION SUR LES COORDONNEES BARYCENTRIQUES
  395. If (al(1).gt.prec3 . and. al(2).gt.prec3 . and.
  396. $al(3).gt.prec3) then
  397. C LE POINT EST A L'INTERIEUR DE L'ELEMENT I1
  398. icor(1)=icor(1)+1
  399. icor(icor(1)+1)=i1
  400. Endif
  401. iad=iad+1
  402.  
  403. 406 continue
  404. If (icor(1).eq.0) then
  405. interr(1) = ia
  406. call erreur(782)
  407. return
  408. Endif
  409. Endif
  410. C FIN DE L'INVENTAIRE
  411. C CALCUL DES PROJETES DE MAI2 SUR MAI1
  412. If (icpr2(ia).eq.1) then
  413. C SI IA SE PROJETTE SUR PLUSIEURS ELEMENTS
  414. dmin=1.e30
  415. nbpts=nbpts+1
  416. segadj mcoord
  417. Do 500 m=1,icor(1)
  418. m1=num(1,icor(m+1))
  419. m2=num(2,icor(m+1))
  420. m3=num(3,icor(m+1))
  421. C Calcul des coordonnees du projete
  422. xm1=xcoor1((m1-1)*(idim+1)+1)
  423. ym1=xcoor1((m1-1)*(idim+1)+2)
  424. zm1=xcoor1((m1-1)*(idim+1)+3)
  425. xm2=xcoor1((m2-1)*(idim+1)+1)
  426. ym2=xcoor1((m2-1)*(idim+1)+2)
  427. zm2=xcoor1((m2-1)*(idim+1)+3)
  428. xm3=xcoor1((m3-1)*(idim+1)+1)
  429. ym3=xcoor1((m3-1)*(idim+1)+2)
  430. zm3=xcoor1((m3-1)*(idim+1)+3)
  431. xnew=xcoor2((ia-1)*(idim+1)+1)
  432. ynew=xcoor2((ia-1)*(idim+1)+2)
  433. C Calcul du zib
  434. o1=(ym1-ym2)*(zm1-zm3)-(ym1-ym3)*(zm1-zm2)
  435. o2=(zm1-zm2)*(xm1-xm3)-(zm1-zm3)*(xm1-xm2)
  436. o3=(xm1-xm2)*(ym1-ym3)-(xm1-xm3)*(ym1-ym2)
  437. o4=-(o1*xm1+o2*ym1+o3*zm1)
  438. znew=-(o1*xnew+o2*ynew+o4)/o3
  439. zpoint = xcoor2((ia-1)*(idim+1)+3)
  440. * If ((znew-zpoint).gt.0.) then
  441. If ((znew-zpoint).lt.dmin) then
  442. icorre(ia) = nbpts
  443. dmin=znew-zpoint
  444. xcoor((nbpts-1)*(idim+1)+1)=xnew
  445. xcoor((nbpts-1)*(idim+1)+2)=ynew
  446. xcoor((nbpts-1)*(idim+1)+3)=znew
  447. Endif
  448. * Endif
  449. 500 continue
  450.  
  451. C *********************RETOUR A L'ANCIENNE BASE*********************
  452. ib=nbpts
  453. xa1=xcoor((ib-1)*(idim+1)+1)
  454. xa2=xcoor((ib-1)*(idim+1)+2)
  455. xa3=xcoor((ib-1)*(idim+1)+3)
  456. Do 3200 j=1,3
  457. xcoor((ib-1)*(idim+1)+j)=(xa1*invma(j,1))+
  458. $(xa2*invma(j,2))+(xa3*invma(j,3))
  459. 3200 continue
  460. Endif
  461. icor(1)=0
  462. 405 continue
  463.  
  464. segsup iseg1,iseg3,iseg4,iseg5,iseg6,mcoor1,mcoor2
  465. segsup icp1,icp2
  466. C CREATION DU MAILLAGE PROJETE MAI3
  467. segini,ipt3=ipt1
  468. ipt4 = IPT3
  469. do 2456 IU = 1, max( 1,IPT3.LISOUS(/1))
  470. If( IPT3.LISOUS(/1).NE.0) THEN
  471. IPT5=IPT3.LISOUS(IU)
  472. SEGINI,IPT4=IPT5
  473. NBREF = 0
  474. NBSOUS=0
  475. SEGADJ IPT4
  476. ENDIF
  477. nbel1=ipt4.num(/2)
  478. nbnn1=ipt4.num(/1)
  479. Do 600 i=1,nbel1
  480. Do 601 j=1,nbnn1
  481. ia=ipt4.num(j,i)
  482. ib=icorre(ia)
  483. ipt4.num(j,i)=ib
  484. 601 continue
  485. 600 continue
  486. 2456 continue
  487. do 2457 IU = 1, max( 0,IPT3.LISREF(/1))
  488. If( IPT3.LISREF(/1).NE.0) THEN
  489. IPT5 = IPT3.LISREF(IU)
  490. SEGINI,IPT4=IPT5
  491. ENDIF
  492. nbel1=ipt4.num(/2)
  493. nbnn1=ipt4.num(/1)
  494. Do 602 i=1,nbel1
  495. Do 603 j=1,nbnn1
  496. ia=ipt4.num(j,i)
  497. ib=icorre(ia)
  498. ipt4.num(j,i)=ib
  499. 603 continue
  500. 602 continue
  501. SEGDES IPT4
  502. 2457 continue
  503. call ecrobj('MAILLAGE',ipt3)
  504. segdes ipt3,ipt1,meleme
  505. segsup mcor,mcorre,matric
  506. Return
  507. End
  508.  
  509.  
  510.  
  511.  
  512.  
  513.  
  514.  
  515.  
  516.  
  517.  
  518.  
  519.  

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