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