1 : C ZONAG SOURCE CHAT 08/09/17 21:16:15 6160 2 : SUBROUTINE ZONAG(IP1,IP2,ICCOUN,IEXX,IFL) 3 : C==================================================================== 4 : C localisation de points dans des elements d une zone elementaire 5 : C zonage et construction d un tableau de correspondance 6 : C 7 : C Entrees : 8 : C ip1 pointeur sur le maillage massif 9 : C ip2 pointeur sur le maillage poi1 10 : C iexx pointeur sur un segment contenant les points deja vus 11 : C ( eviter comptage des point aux frontieres de 2 sous zones) 12 : C IFL = 0 noeuds communs a IP1 et IP2 non repertories( accro) 13 : C IFL = 1 "" comptabilisés ( proi) 14 : C Sorties : 15 : C iccoun pointeur sur le segment ICOUNT contenant le tableau de 16 : C correspondance suivant 17 : C IEINT(1,N) numero du point du meleme IP2 18 : C IEINT(2,N) numero de l element du meleme IP1 le contenant 19 : C MAXPZ nombre de points de IP2 contenus dans la s_zone (N max) 20 : C==================================================================== 21 : IMPLICIT INTEGER(I-N) 22 : IMPLICIT REAL*8 (A-H,O-Z) 23 : *- 24 : -INC CCREEL 25 : -INC CCOPTIO 26 : -INC SMCOORD 27 : -INC SMELEME 28 : -INC CCGEOME 29 : DATA EPSI/1.D-5/ 30 : 31 : SEGMENT IEXCLU 32 : INTEGER IDEJVU(NODES) 33 : ENDSEGMENT 34 : segment inomil(0) 35 : segment wrk4 36 : real*8 xel(3,nbnn),shpp(6,nbnn),qsi(3) 37 : endsegment 38 : segment wrkl 39 : real*8 shpl(6,nbnnl),xell(3,nbnnl) 40 : endsegment 41 : 42 : 43 : SEGMENT ICOUNT 44 : INTEGER IEINT(2,NODES),MAXPZ(1) 45 : REAL*8 QQQ(3,NODES) 46 : ENDSEGMENT 47 : SEGMENT ISEG1 48 : REAL*8 XLIM(2,NBEL),YLIM(2,NBEL),ZLIM(2,NBEL),XPU(3) 49 : ENDSEGMENT 50 : SEGMENT ISEG3 51 : INTEGER NIZO(NZO+1) 52 : ENDSEGMENT 53 : SEGMENT ISEG4 54 : INTEGER NUMZO(NZO) 55 : ENDSEGMENT 56 : SEGMENT ISEG5 57 : INTEGER NNMEL(ILON),IDEJ(NZO) 58 : ENDSEGMENT 59 : 60 : C SEGMENT INFO 61 : C INTEGER INFELE(16) 62 : C ENDSEGMENT 63 : 64 : IDIM1 = IDIM + 1 65 : IFLAG= 1 66 : IPT2 = IP2 67 : 68 : SEGACT IPT2 69 : NODES = IPT2.NUM(/2) 70 : MELEME = IP1 71 : SEGACT MELEME 72 : IPT1 = MELEME 73 : SEGINI ICOUNT 74 : ICCOUN = ICOUNT 75 : 76 : NBNN = IPT1.NUM(/1) 77 : NBEL = IPT1.NUM(/2) 78 : ITR = 0 79 : SEGINI ISEG1 80 : XZO=0.D0 81 : YZO=0.D0 82 : ZZO=0.D0 83 : XZA=XGRAND 84 : YZA=XGRAND 85 : ZZA=XGRAND 86 : XTOMI=XGRAND 87 : XTOMA=-XGRAND 88 : YTOMI=XGRAND 89 : YTOMA=-XGRAND 90 : ZTOMI=XGRAND 91 : ZTOMA=-XGRAND 92 : DO 200 I1=1,NBEL 93 : XMI=XGRAND 94 : YMI=XGRAND 95 : ZMI=XGRAND 96 : YMA=-XGRAND 97 : XMA=-XGRAND 98 : ZMA=-XGRAND 99 : DO 201 I2 = 1,NBNN 100 : IB=NUM(I2,I1) 101 : IA=(IB-1)*IDIM1 102 : IF(XCOOR(IA+1).LT.XMI) XMI=XCOOR(IA+1) 103 : IF(XCOOR(IA+1).GT.XMA) XMA=XCOOR(IA+1) 104 : IF(XCOOR(IA+2).LT.YMI) YMI=XCOOR(IA+2) 105 : IF(XCOOR(IA+2).GT.YMA) YMA=XCOOR(IA+2) 106 : IF( IDIM.EQ.3 ) THEN 107 : IF(XCOOR(IA+3).LT.ZMI) ZMI=XCOOR(IA+3) 108 : IF(XCOOR(IA+3).GT.ZMA) ZMA=XCOOR(IA+3) 109 : ENDIF 110 : 201 CONTINUE 111 : XLIM(1,I1)=XMI 112 : XLIM(2,I1)=XMA 113 : YLIM(1,I1)=YMI 114 : YLIM(2,I1)=YMA 115 : XZO=MAX (XZO,XMA-XMI) 116 : YZO=MAX (YZO,YMA-YMI) 117 : XZA=MIN(XZA,XMA-XMI) 118 : YZA=MIN(YZA,YMA-YMI) 119 : IF(XMI.LT.XTOMI) XTOMI=XMI 120 : IF(XMA.GT.XTOMA) XTOMA=XMA 121 : IF(YMI.LT.YTOMI) YTOMI=YMI 122 : IF(YMA.GT.YTOMA) YTOMA=YMA 123 : IF(IDIM.EQ.3) THEN 124 : ZLIM(1,I1)=ZMI 125 : ZLIM(2,I1)=ZMA 126 : ZZO=MAX(ZZO,ZMA-ZMI) 127 : ZZA=MIN(ZZA,ZMA-ZMI) 128 : IF(ZMI.LT.ZTOMI) ZTOMI=ZMI 129 : IF(ZMA.GT.ZTOMA) ZTOMA=ZMA 130 : ENDIF 131 : 200 CONTINUE 132 : C WRITE(6,FMT='(''XZO YZO '',4E12.5)') XZO,YZO 133 : C WRITE(6,FMT='(''XZA YZA '',4E12.5)') XZA,YZA 134 : C WRITE(6,FMT='(''XTOMI XTOMA '',4E12.5)') XTOMI,XTOMA 135 : C WRITE(6,FMT='(''YTOMI YTOMA '',4E12.5)') YTOMI,YTOMA 136 : XPR=MIN(XZO*1.D-2,(XTOMA-XTOMI)/2.D+4) 137 : YPR=MIN(YZO*1.D-2,(YTOMA-YTOMI)/2.D+4) 138 : C XZO=XZO*1.1D0 139 : C YZO=YZO*1.1D0 140 : XZA=XZA*0.97D0 141 : YZA=YZA*0.97D0 142 : XTOMI= XTOMI - (XTOMA-XTOMI)/1.D+4 143 : XTOMA= XTOMA + (XTOMA-XTOMI)/1.D+4 144 : YTOMI= YTOMI - (YTOMA-YTOMI)/1.D+4 145 : YTOMA= YTOMA + (YTOMA-YTOMI)/1.D+4 146 : C XZO=MIN ( XZO, XTOMA-XTOMI) 147 : C YZO=MIN ( YZO, YTOMA-YTOMI) 148 : XZA=MIN ( XZA, XTOMA-XTOMI) 149 : YZA=MIN ( YZA, YTOMA-YTOMI) 150 : NXZO=(XTOMA-XTOMI)/XZA + 1 151 : NYZO=(YTOMA-YTOMI)/YZA + 1 152 : XZO=XZA 153 : YZO=YZA 154 : NZZO=1 155 : C WRITE(6,FMT='('' NXZO NYZO'',2I7)') NXZO,NYZO 156 : IF(IDIM.EQ.3) THEN 157 : ZPR=MIN(ZZO*1.D-2,(ZTOMA-ZTOMI)/2.D+4) 158 : C ZZO=ZZO*1.1D0 159 : ZZA=ZZA*0.97D0 160 : ZTOMI= ZTOMI - (ZTOMA-ZTOMI)/1.D+4 161 : ZTOMA= ZTOMA + (ZTOMA-ZTOMI)/1.D+4 162 : C ZZO=MIN ( ZZO, ZTOMA-ZTOMI) 163 : ZZA=MIN ( ZZA, ZTOMA-ZTOMI) 164 : IF(ZZA.EQ.0) THEN 165 : NZZO = 1 166 : ELSE 167 : NZZO=(ZTOMA-ZTOMI)/ZZA + 1 168 : ENDIF 169 : ZZO=ZZA 170 : C WRITE(6,FMT='('' zz0,zzA,ztomi,ztoma'',4e12.5)') 171 : C $ xzo,xza,ztomi,ztoma 172 : ENDIF 173 : C WRITE(6,*) XTOMI, XTOMA 174 : C WRITE(6,*) YTOMI ,YTOMA 175 : C WRITE(6,*) ZTOMI ,ZTOMA 176 : C_____________________________ 177 : IF ((XTOMA-XTOMI).LT.EPSI) THEN 178 : XTOMA = XTOMA + EPSI/2 179 : XTOMI = XTOMI - EPSI/2 180 : XZO = EPSI 181 : ENDIF 182 : IF ((YTOMA-YTOMI).LT.EPSI) THEN 183 : YTOMA = YTOMA + EPSI/2 184 : YTOMI = YTOMI - EPSI/2 185 : YZO = EPSI 186 : ENDIF 187 : IF (IDIM.EQ.3) THEN 188 : IF ((ZTOMA-ZTOMI).LT.EPSI) THEN 189 : ZTOMA = ZTOMA + EPSI/2 190 : ZTOMI = ZTOMI - EPSI/2 191 : ZZO = EPSI 192 : ENDIF 193 : ENDIF 194 : C_______________________________ 195 : NXDEP=MIN(NXZO,10) 196 : NYDEP=MIN(NYZO,10) 197 : IF(IDIM.EQ.2) THEN 198 : IF(FLOAT(NXZO)*FLOAT(NYZO).GT.100000.) THEN 199 : XY=SQRT(FLOAT(NXZO)*FLOAT(NYZO))/90 200 : NXZO=MAX(INT(NXZO/XY),NXDEP) 201 : NYZO=MAX(INT(NYZO/XY),NYDEP) 202 : IF(FLOAT(NXZO)*FLOAT(NYZO).GT.100000.) THEN 203 : XY=SQRT(FLOAT(NXZO)*FLOAT(NYZO))/60 204 : NXZO=MAX(INT(NXZO/XY),NXDEP) 205 : NYZO=MAX(INT(NYZO/XY),NYDEP) 206 : ENDIF 207 : XZO=(XTOMA-XTOMI)/NXZO 208 : YZO=(YTOMA-YTOMI)/NYZO 209 : NXZO=(XTOMA-XTOMI)/XZO +1 210 : NYZO=(YTOMA-YTOMI)/YZO +1 211 : ENDIF 212 : C WRITE(6,FMT='('' XZO NXZO YZO NYZO '' , E12.5,I5,E12.5,I5)') 213 : C $ XZO ,NXZO, YZO, NYZO 214 : ELSE 215 : NZDEP=MIN(NZZO,10) 216 : C WRITE(6,FMT='('' XZO NXZO YZO NYZO ZZO NZZO'' , E12.5,I7,/, 217 : C $ E12.5,I7,E12.5,I7)') 218 : C $ XZO ,NXZO, YZO, NYZO,ZZO,NZZO 219 : C WRITE(IOIMP,FMT='('' NXZO NYZO NZZO '' 220 : C $,4I7) ') NXZO,NYZO,NZZO 221 : IF(FLOAT(NXZO)*FLOAT(NYZO)*FLOAT(NZZO).GT.250000.) THEN 222 : XYZ =(FLOAT(NXZO)*FLOAT(NYZO)*FLOAT(NZZO))**0.3333/25 223 : NXZO=MAX(INT(NXZO/XYZ),NXDEP) 224 : NYZO=MAX(INT(NYZO/XYZ),NYDEP) 225 : NZZO=MAX(INT(NZZO/XYZ),NZDEP) 226 : C IF(IIMPI.NE.0)WRITE(IOIMP,FMT='('' NXZO NYZO NZZO '' 227 : C $,4I7) ') NXZO,NYZO,NZZO 228 : IF(FLOAT(NXZO)*FLOAT(NYZO)*FLOAT(NZZO).GT.250000.) THEN 229 : XYZ =(FLOAT(NXZO)*FLOAT(NYZO)*FLOAT(NZZO))**0.3333/25 230 : NXZO=MAX(INT(NXZO/XYZ),NXDEP) 231 : NYZO=MAX(INT(NYZO/XYZ),NYDEP) 232 : NZZO=MAX(INT(NZZO/XYZ),NZDEP) 233 : IF(IIMPI.NE.0)WRITE(IOIMP,FMT='('' NXZO NYZO NZZO '' 234 : $ ,4I7) ') NXZO,NYZO,NZZO 235 : IF(FLOAT(NXZO)*FLOAT(NYZO)*FLOAT(NZZO).GT.250000.) THEN 236 : XYZ =(FLOAT(NXZO)*FLOAT(NYZO)*FLOAT(NZZO))**0.3333 237 : $ /25 238 : NXZO=MAX(INT(NXZO/XYZ),NXDEP) 239 : NYZO=MAX(INT(NYZO/XYZ),NYDEP) 240 : NZZO=MAX(INT(NZZO/XYZ),NZDEP) 241 : ENDIF 242 : ENDIF 243 : XZO=(XTOMA-XTOMI)/NXZO 244 : YZO=(YTOMA-YTOMI)/NYZO 245 : ZZO=(ZTOMA-ZTOMI)/NZZO 246 : NXZO=(XTOMA-XTOMI)/XZO +1 247 : NYZO=(YTOMA-YTOMI)/YZO +1 248 : NZZO=(ZTOMA-ZTOMI)/ZZO +1 249 : ENDIF 250 : ENDIF 251 : * 252 : * ON VEUT CONSTRUIRE LA LISTE DES ELEMENTS TOUCHANT UNE ZONE 253 : * POUR CELA ON COMMENCE PAR COMPTER COMBIEN D'ELEMENT TOUCHENT 254 : * CHAQUE ZONE ET EN MEME TEMPS ON STOCKE LES ZONES TOUCHEES 255 : * PAR CHAQUE ELEMENT ET LEUR NOMBRE 256 : * 257 : 258 : NZO=NXZO*NYZO*NZZO 259 : C WRITE(IOIMP,FMT='('' NZO NXZO NYZO NZZO '' 260 : C $,4I7) ') NZO,NXZO,NYZO,NZZO 261 : NXYZO=NXZO*NYZO 262 : * 263 : SEGINI ISEG3 264 : SEGINI ISEG4 265 : DO 230 I1=1,NBEL 266 : NIZ1X=INT((XLIM(1,I1)-XTOMI-XPR)/XZO) +1 267 : NIZ1Y=INT((YLIM(1,I1)-YTOMI-YPR)/YZO) +1 268 : NIZ2X=INT((XLIM(2,I1)-XTOMI+XPR)/XZO) +1 269 : NIZ2Y=INT((YLIM(2,I1)-YTOMI+YPR)/YZO) +1 270 : IF(IDIM.EQ.3) THEN 271 : NIZ1Z=INT((ZLIM(1,I1)-ZTOMI-ZPR)/ZZO) +1 272 : NIZ2Z=INT((ZLIM(2,I1)-ZTOMI+ZPR)/ZZO) +1 273 : DO 231 L3=NIZ1Z,NIZ2Z 274 : DO 2311 L1=NIZ1Y,NIZ2Y 275 : DO 23111 L2=NIZ1X,NIZ2X 276 : NIZA = L2 + ( L1-1) * NXZO + ( L3-1)*NXYZO 277 : NUMZO(NIZA) = NUMZO(NIZA) +1 278 : 23111 CONTINUE 279 : 2311 CONTINUE 280 : 231 CONTINUE 281 : ELSE 282 : DO 232 L1=NIZ1Y,NIZ2Y 283 : DO 2321 L2=NIZ1X,NIZ2X 284 : NIZA = L2 + ( L1-1) * NXZO 285 : NUMZO(NIZA) = NUMZO(NIZA) +1 286 : 2321 CONTINUE 287 : 232 CONTINUE 288 : ENDIF 289 : 230 CONTINUE 290 : * 291 : * CONSTRUCTION DU TABLEAU D'ADRESSAGE DU TABLEAU DONNANT LES 292 : * ELEMENTS CONCERNES PAR UNE ZONE 293 : * 294 : ILON=0 295 : NIZO(1)=1 296 : DO 240 L1=1,NZO 297 : NIZO(L1+1)=NIZO(L1)+NUMZO(L1) 298 : ILON=ILON+ NUMZO(L1) 299 : 240 CONTINUE 300 : C WRITE(6,FMT='('' ILON '',I5)') ILON 301 : C WRITE(6,109) (KKK,NUMZO(KKK),(NELZO(KI,KKK),KI=1,4),KKK=1,NBEL) 302 : C 109 FORMAT(I6,I5,4I5) 303 : C WRITE(6,110)( NIZO(KI),KI=1,NZO+1) 304 : C 110 FORMAT(16I5) 305 : SEGINI ISEG5 306 : 307 : DO 250 I1=1,NBEL 308 : NIZ1X=INT((XLIM(1,I1)-XTOMI-XPR)/XZO) +1 309 : NIZ1Y=INT((YLIM(1,I1)-YTOMI-YPR)/YZO) +1 310 : NIZ2X=INT((XLIM(2,I1)-XTOMI+XPR)/XZO) +1 311 : NIZ2Y=INT((YLIM(2,I1)-YTOMI+YPR)/YZO) +1 312 : IF(IDIM.EQ.3) THEN 313 : NIZ1Z=INT((ZLIM(1,I1)-ZTOMI-ZPR)/ZZO) +1 314 : NIZ2Z=INT((ZLIM(2,I1)-ZTOMI+ZPR)/ZZO) +1 315 : DO 251 L3=NIZ1Z,NIZ2Z 316 : DO 2511 L1=NIZ1Y,NIZ2Y 317 : DO 25111 L2=NIZ1X,NIZ2X 318 : NIZA = L2 + ( L1-1) * NXZO + ( L3-1)*NXYZO 319 : IAD=NIZO(NIZA)+IDEJ(NIZA) 320 : NNMEL(IAD)=I1 321 : IDEJ(NIZA)=IDEJ(NIZA)+1 322 : 25111 CONTINUE 323 : 2511 CONTINUE 324 : 251 CONTINUE 325 : ELSE 326 : DO 252 L1=NIZ1Y,NIZ2Y 327 : DO 2521 L2=NIZ1X,NIZ2X 328 : NIZA = L2 + ( L1-1) * NXZO 329 : IAD=NIZO(NIZA)+IDEJ(NIZA) 330 : NNMEL(IAD)=I1 331 : IDEJ(NIZA)=IDEJ(NIZA)+1 332 : 2521 CONTINUE 333 : 252 CONTINUE 334 : ENDIF 335 : 250 CONTINUE 336 : * 337 : * IL NE RESTE PLUS QU'A FAIRE LE TRAVAIL PROPREMENT DIT POUR CHAQUE 338 : * POINT DE L'OBJETR MAILLAGE IPGFIN, ON COMMENCE PAR LE METTRE SOUS 339 : * FORME D'ELEMENTS DE TYPE POI1 340 : * 341 : SEGSUP ISEG4 342 : 343 : iexclu=iexx 344 : segact iexclu*MOD 345 : 346 : C on va tourner sur les elements poi1 347 : 348 : KEL = ipt1.itypel 349 : nbnn=ipt1.num(/1) 350 : C 351 : kd = kdegre(kel) 352 : nso = nbsom(kel) 353 : iad=nspos(kel)-1 354 : segini wrk4 355 : segini inomil 356 : C element quaf ? si oui kell=numero lineaire correspondant 357 : C si non kell=0 357 : CALL NQF2NL(kel,kell) 358 : IF (IERR.NE.0) RETURN 359 : IF (KELL.NE.0) THEN 360 : nbnnl=NBNNE(KELL) 361 : segini wrkl 362 : do i=1,nbnnl 363 : inomil(**)=i 364 : enddo 365 : ELSE 366 : if(kd.eq.3) then 367 : C element quadratiques 368 : 369 : do 762 i=1,nbnn 370 : do 763 j=1,nso 371 : iso = ibsom(iad+j) 372 : if(i.eq.iso) goto 762 373 : 763 continue 374 : inomil(**)= i 375 : 762 continue 376 : elseif(kd.eq.2) then 377 : C elements lineaires 378 : do i=1,nbnn 379 : inomil(**)=i 380 : enddo 381 : endif 382 : ENDIF 383 : C write(6,*) (inomil(i),i=1,inomil(/1)) 384 : DO 2 K = 1,IPT2.NUM(/2) 385 : IP= IPT2.NUM(1,K) 386 : C write (6,*) 'on cherche l element contenant le noeud' ,ip 387 : ITROU = 1 388 : IREFP= (IP-1)*(IDIM+1)+1 389 : XPU(1)=XCOOR(IREFP) 390 : XPU(2)=XCOOR(IREFP+1) 391 : XPU(3)=0.D0 392 : IF (IDIM.GE.3) XPU(3)=XCOOR(IREFP+2) 393 : IF(XPU(1).LT.XTOMI.OR.XPU(1).GT.XTOMA) GO TO 10 394 : IF(XPU(2).LT.YTOMI.OR.XPU(2).GT.YTOMA) GO TO 10 395 : IF(IDIM.EQ.3) THEN 396 : IF(XPU(3).LT.ZTOMI.OR.XPU(3).GT.ZTOMA) GO TO 10 397 : C write(6,*) XPU(3),ZTOMI,ZTOMA 398 : ENDIF 399 : INDZO=INT((XPU(1)-XTOMI)/XZO)+ 1 +INT((XPU(2)-YTOMI)/YZO)*NXZO 400 : IF(IDIM.EQ.3) INDZO=INDZO+INT((XPU(3)-ZTOMI)/ZZO)*NXZO*NYZO 401 : IDEB=NIZO(INDZO) 402 : IFIN=NIZO(INDZO+1)-1 403 : C write(6,fmt='('' ideb ifin'',2i5)') ideb,ifin ,indzo 404 : IF(IDEB.GT.IFIN) GO TO 10 405 : 406 : IA1 = 0 407 : IF(IPT1.ITYPEL.EQ.14.OR.IPT1.ITYPEL.EQ.15)IA1 = 1 408 : IF(IPT1.ITYPEL.EQ.16.OR.IPT1.ITYPEL.EQ.17)IA1 = 7 409 : C 410 : C------------------------------------------------- 411 : DO 11 KK=IDEB,IFIN 412 : J= NNMEL(KK) 413 : * write(6,*) ' ' 414 : * write(6,*) 'recherche point ',ip, 'ds elem ',J ,'itrou',ITROU 414 : call doxe(xcoor,idim,nbnn,ipt1.num,j,xel) 415 : * cas quaf 416 : if (kell.ne.0) then 417 : nsom=nbsom(kel) 418 : if(nsom.ne.nbnnl) then 418 : call erreur(5) 419 : return 420 : endif 421 : idx=nspos(kel)-1 422 : do innl=1,nbnnl 423 : do iid=1,idim 424 : xell(iid,innl)=xel(iid,ibsom(idx+innl)) 425 : enddo 426 : enddo 427 : endif 428 : * 428 : * call qsijs(xel,kel,nbnn,idim,xpu,SHPP,qsi,iret) 429 : * cas quaf 430 : if (kell.ne.0) then 430 : call qsijs(xell,kell,nbnnl,idim,xpu, 431 : $ SHPL,qsi,iret) 431 : call qsijs2(xel,kel,nbnn,idim,xpu, 432 : $ SHPP,qsi,iret) 433 : else 433 : call qsijs(xel,kel,nbnn,idim,xpu,SHPP,qsi,iret) 434 : endif 435 : * 436 : IF (IRET.NE.0) GOTO 11 436 : * CALL ERREUR(797) 437 : * RETURN 438 : * ENDIF 439 : C 440 : C write(6,fmt='(8E12.5)')(shpp(1,ih),ih=1,nbnn) 441 : do i=1,inomil(/1) 442 : ilp= inomil(i) 443 : if (kell.ne.0) then 444 : if( shpl(1,ilp).lt.0.D0) goto 11 445 : else 446 : if( shpp(1,ilp).lt.0.D0) goto 11 447 : endif 448 : 449 : enddo 450 : C 451 : goto 100 452 : 11 CONTINUE 453 : C on n a rien trouve pour ce point 454 : ITROU = 0 455 : 456 : 100 CONTINUE 457 : 458 : IF(ITROU.EQ.1) THEN 459 : C on a trouve l element contenant le point K attention 460 : C si le point appartient aux deux maillages on ne le stocke pas 461 : C pour accro mais on le stocke pour proi 462 : do 18 jl =1,IPT1.NUM(/1) 463 : if((IP.EQ.IPT1.NUM(jl,j)).AND.(IFL.EQ.0)) GOTO 19 464 : 18 continue 465 : if(idejvu(IP).EQ.0) then 466 : idejvu(ip) = 1 467 : itr = itr + 1 468 : IEINT(1,itr) = IP 469 : IEINT(2,itr) = J 470 : QQQ(1,itr) = qsi(1) 471 : QQQ(2,itr) = qsi(2) 472 : QQQ(3,itr) = qsi(3) 473 : C write(6,*) 'trouve point' ,IP, 'Element' ,J 474 : C write(6,2375)ip,j,(xpu(i1),i1=1,idim),(qsi(i2),i2=1,idim) 475 : endif 476 : 19 continue 477 : ENDIF 478 : 2375 format(2i4,6e12.5) 479 : 10 continue 480 : 481 : 2 continue 482 : segsup wrk4 ,inomil 483 : IF (KELL.NE.0) THEN 484 : SEGSUP wrkl 485 : ENDIF 486 : MAXPZ(1) = ITR 487 : SEGSUP ISEG1,ISEG5,ISEG3 488 : C 489 : C le tableau des correspondances est terminé 490 : C 491 : SEGDES IPT1,IPT2,ICOUNT,IEXCLU 492 : RETURN 493 : END 494 : 495 : 496 : 497 : 498 : 499 : 500 : 501 : 502 : 503 : 504 :
© Cast3M 2003 - All rights reserved.
Disclaimer