1 : C SEPA2 SOURCE PV 13/11/29 21:15:06 7872 2 : C**************************************************************************** 3 : C**************************************************************************** 4 : C***************SEPAR...trouve separation************************************ 5 : C**************************************************************************** 6 : C**************************************************************************** 7 : 8 : C SEPAR trouve la separation a partir du domaine defini par 9 : C MASQ=.TRUE. et du noeud appele PIVOT, renvoie DIMSEP,le nombre de 10 : C noeuds contenant dans la separation, MASQ=.FALSE. pour les noeuds 11 : C appartenant a la separation, renumerote celle-ci dans IADJ, 12 : 13 : SUBROUTINE SEPA2(IADJ,JADJC,PIVOTA,MASQUE,DIMSEP,N,IPOS, 14 : & NODES,IPOSMAX,nrelong,noelon,noel2, 15 : > londim,nbthr) 16 : 17 : IMPLICIT INTEGER(I-N) 18 : common/cnumop/fcout2c(64),fcoutc(64),iadjc,jadjcc,nrelongc, 19 : > noelonc,isensc(64),dimlonc(64),masqc,nodesc,iposc,nbtotc, 20 : > lfrontc(64),londimc,lpivc(64),ipointc,noel2c, 21 : > boolc(64),ldim2c(64),nbthrc,pivotc(50,64),npointc(64), 22 : > npoint2c(64),imaxc,lfronc(64) 23 : external noepr2i 24 : integer dimlonc,boolc 25 : SEGMENT IADJ(0) 26 : SEGMENT JADJC(0) 27 : integer pivot(50),pivot2(50),pivota,pivots,pivotc,pivotb 28 : SEGMENT MASQUE 29 : LOGICAL MASQ(0) 30 : ENDSEGMENT 31 : SEGMENT IPOS(0) 32 : INTEGER NODES 33 : INTEGER BOOL 34 : INTEGER DIMSEP,N 35 : REAL*8 FCOUT,FCOUT2,xbtot,xbfr2,xdeseq2,fcout2c,fcoutc 36 : real*8 xran 37 : INTEGER LONG,LONG2,L,DIMLON 38 : C LONG2,LONG correspond au pseudo-diametre. 39 : C L determine les noeuds appartenant a la separation. 40 : 41 : SEGMENT NRELONG(NODES) 42 : C NRELONG contient pour chaque noeud sa profondeur. 43 : 44 : SEGMENT NOELON(NODES) 45 : SEGMENT NOEL2(NODES) 46 : SEGMENT LONDIM(NODES) 47 : C NOELON contient les noeuds de profondeur LONG. 48 : C DIMLON= dimension de NOELON. 49 : 50 : C Initialisation des segments de travail. 51 : * write (6,*) ' entree dans sepa2 nbthr ',nbthr 52 : * noepr2 travaille differamment suivant que nbtot est nul ou pas 53 : nbtot=0 54 : lpiv=1 55 : pivot(lpiv)=pivota 56 : MDOMN=IPOS(PIVOTA+NODES) 56 : CALL NOEPR2(IADJ(1),JADJC(1),PIVOT,NRELONG(1),NOELON(1), 57 : > isens,DIMLON,MASQ(1),NODES,IPOS(1),NBTOT,lfront,lfron, 58 : > londim(1),fcout,lpiv) 59 : ** nbtot=0 60 : ** pivot(lpiv)=noelon(1) 61 : ** pivotb=pivot(lpiv) 62 : ** do ix=1,dimlon 63 : ** ii=noelon(ix) 64 : ** nrelong(ii)=0 65 : ** enddo 65 : ** CALL NOEPR2(IADJ(1),JADJC(1),PIVOT,NRELONG(1),NOELON(1), 66 : ** > isens,DIMLON,MASQ(1),NODES,IPOS(1),NBTOT,lfront,lfron, 67 : ** > londim(1),fcout,lpiv) 68 : do ix=1,dimlon 69 : ii=noelon(ix) 70 : nrelong(ii)=0 71 : enddo 72 : if (fcout.lt.2) goto 11 73 : if (nbtot.le.13) goto 11 74 : ldim2=londim(2) 75 : do j=1,dimlon 76 : noel2(j)=noelon(j) 77 : enddo 78 : * recherche aléatoire 79 : npoint=2 80 : do i=lpiv+1,npoint 81 : pivot(i)=0 82 : enddo 83 : lpiv=npoint 84 : bool=2 85 : ipoint=0 86 : imax=0 87 : 499 continue 88 : do 500 itent=1,2**30 89 : if (bool.le.0 ) goto 510 90 : bool=bool-1 91 : ipoint=ipoint+1 92 : if (ipoint.gt.npoint) then 93 : imax=1 94 : ipoint=1 95 : endif 96 : npoint2=npoint 97 : nbthrl=min(nbthr,nbtot/16+1) 98 : pivots=pivot(ipoint) 99 : do 521 ith=1,nbthrl 100 : iadjc=iadj 101 : jadjcc=jadjc 102 : nrelongc=nrelong 103 : noelonc=noelon 104 : isensc(ith)=isens 105 : dimlonc(ith)=dimlon 106 : masqc=masque 107 : nodesc=nodes 108 : iposc=ipos 109 : nbtotc=nbtot 110 : lfrontc(ith)=lfront 111 : lfronc(ith)=lfron 112 : londimc=londim 113 : fcout2c(ith)=fcout2 114 : lpivc(ith)=lpiv 115 : ipointc=ipoint 116 : noel2c=noel2 117 : boolc(ith)=bool 118 : fcoutc(ith)=fcout 119 : ldim2c(ith)=ldim2 120 : npointc(ith)=npoint 121 : npoint2c(ith)=npoint2 122 : nbthrc=nbthrl 123 : imaxc=imax 124 : do jj=1,lfron 125 : londim(jj+(ith-1)*nodes)=londim(jj) 126 : enddo 127 : do jj=1,npoint2 128 : pivotc(jj,ith)=pivot(jj) 129 : enddo 130 : if (ith.ne.nbthrl) then 131 : * write (6,*) ' appel threadid ',ith 131 : call threadid(ith,noepr2i) 132 : else 132 : call noepr2i(ith) 133 : endif 134 : 521 continue 135 : do 523 ith=1,nbthrl-1 135 : call threadif(ith) 136 : 523 continue 137 : do 522 ith=1,nbthrl 138 : if (fcoutc(ith).lt.fcout.or.(fcoutc(ith).eq.fcout.and. 139 : > pivot(ipoint).ne.pivotc(ipoint,ith))) then 140 : * write (6,*) ' sepa2 ith fcoutc fcout ',ith,fcoutc(ith), 141 : * > fcout,' pivotc ', pivotc(ipoint,ith) 142 : if (fcoutc(ith).ne.fcout) bool=2 143 : isens=isensc(ith) 144 : fcout=fcoutc(ith) 145 : ldim2=ldim2c(ith) 146 : npoint=npointc(ith) 147 : npoint2=npoint2c(ith) 148 : pivot(ipoint)=pivotc(ipoint,ith) 149 : pivot(npoint2)=0 150 : endif 151 : 522 continue 152 : npoint=npoint2 153 : lpiv=npoint 154 : 500 continue 155 : 510 continue 156 : * write (6,*) ' nb pts maitres ',npoint 157 : * petit gradient local 158 : istop=0 159 : do 560 itent=1,2**30 160 : if (istop.eq.1) goto 570 161 : istop=1 162 : do 550 ipoint= npoint,1,-1 163 : lpoint=pivot(ipoint) 164 : if (lpoint.le.0) goto 550 165 : * on ne le fait que si il n'y a pas trop de noeuds connectes 166 : if (iadj(lpoint+1)-iadj(lpoint).gt.dimlon/5) goto 550 167 : if (ipoint.ne.1) then 168 : pivot(ipoint)=0 168 : CALL NOEPR2(IADJ(1),JADJC(1),PIVOT,NRELONG(1),NOELON(1), 169 : > isens,DIMLON,MASQ(1),NODES,IPOS(1),NBTOT,lfront,lfron, 170 : > londim(1),fcout2,lpiv) 171 : if (fcout.lt.2) goto 11 172 : if (fcout2.lt.fcout) then 173 : * write (6,*) ' amelioration 2 fcout fcout2 ',fcout,fcout2 174 : istop=0 175 : fcout=fcout2 176 : lpoint=pivot(ipoint) 177 : goto 560 178 : endif 179 : endif 180 : do 580 kk=iadj(lpoint),iadj(lpoint+1)-1 181 : k=jadjc(kk) 182 : if (k.eq.0) goto 580 183 : if (IPOS(k+NODES).ne.mdomn) goto 580 184 : pivot(ipoint)=k 184 : CALL NOEPR2(IADJ(1),JADJC(1),PIVOT,NRELONG(1),NOELON(1), 185 : > isens,DIMLON,MASQ(1),NODES,IPOS(1),NBTOT,lfront,lfron, 186 : > londim(1),fcout2,lpiv) 187 : if (fcout.lt.2) goto 11 188 : if (fcout2.lt.fcout) then 189 : * write (6,*) ' amelioration 1 fcout fcout2 ',fcout,fcout2 190 : istop=0 191 : fcout=fcout2 192 : lpoint=pivot(ipoint) 193 : * goto 560 194 : else 195 : pivot(ipoint)=lpoint 196 : endif 197 : 580 continue 198 : 550 continue 199 : * if (istop.eq.0) goto 499 200 : 560 continue 201 : 570 continue 202 : 203 : 204 : 11 continue 205 : * write (6,*) ' sepa2 pivot qivot rivot sivot nbtot ',pivot,qivot, 206 : * > rivot,sivot,nbtot 207 : nbtot=0 207 : CALL NOEPR2(IADJ(1),JADJC(1),PIVOT,NRELONG(1),NOELON(1), 208 : > isens,DIMLON,MASQ(1),NODES,IPOS(1),NBTOT,lfront,lfron, 209 : > londim(1),fcout,lpiv) 210 : 211 : C PIVOT correspond au noeud pseudo-peripherique. 212 : C LONG2 correspond au pseudo-diametre. 213 : C 214 : 215 : DIMSEP=0 216 : C MDOMN est le numéro de mon domaine 217 : 218 : C pour l'instant,aucun noeud n'appartient a la separation. 219 : 220 : 221 : l=lfront 222 : C L correspond a la distance moyenne pour aller d'un bout a l'autre 223 : C du domaine. 224 : 225 : C on arrete de separer si LONG < = 5. 226 : C on masque alors tous les noeuds repondant a cette condition. 227 : 228 : IF(Lfront.le.1.OR.NBTOT.LE.13) THEN 229 : C insertion d'une seule zone 230 : IPOSV=IPOS(MDOMN+1) 231 : C IPOSV est son rang 232 : DO I=0,IPOSMAX 233 : IF (IPOS(I+1).GT.IPOSV) IPOS(I+1)=IPOS(I+1)+1 234 : ENDDO 235 : IPOSMAX=IPOSMAX+1 236 : if (iposmax.gt.nodes-1) then 237 : * write (6,*) ' iposmax > modes ' 238 : iposmax=nodes-1 239 : endif 240 : IPOS(IPOSMAX+1-0)=IPOSV+1 241 : C IPOSV est son rang 242 : DO 40 IX=1,DIMLON 243 : I=NOELON(IX) 244 : IF(MDOMN.EQ.IPOS(I+NODES).AND.NRELONG(I).NE.0) THEN 245 : MASQ(I)=.FALSE. 246 : IPOS(I+NODES)=IPOSMAX 247 : DIMSEP=DIMSEP+1 248 : ENDIF 249 : 40 CONTINUE 250 : * do 41 i=1,nodes 251 : * IF(MDOMN.EQ.IPOS(I+NODES).AND.NRELONG(I).EQ.0) THEN 252 : * write (6,*) ' zone non connexe 1 ',mdomn,i 253 : * endif 254 : *41 continue 254 : * CALL CMG2(IADJ,JADJC,PIVOT,LONG,NRELONG,NOELON, 255 : * * DIMLON,MASQUE,NODES,IPOS,DIMSEP) 256 : GOTO 50 257 : ENDIF 258 : 259 : C calcul des nouveaux indices de zones 260 : IPOSV=IPOS(MDOMN+1) 261 : C IPOSV est son rang 262 : DO I=0,IPOSMAX 263 : IF (IPOS(I+1).GT.IPOSV) IPOS(I+1)=IPOS(I+1)+3 264 : ENDDO 265 : IPOSMAX=IPOSMAX+3 266 : if (iposmax.gt.nodes-1) then 267 : * write (6,*) ' iposmax > modes ' 268 : iposmax=nodes-1 269 : endif 270 : isens=1 271 : IPOS(IPOSMAX+1-2)=IPOSV+1 272 : IPOS(IPOSMAX+1-1)=IPOSV+1+isens 273 : IPOS(IPOSMAX+1-0)=IPOSV+4-isens 274 : 275 : C On calcule la position de chaque noeud I. 276 : C si I a une profondeur L, I appartient a la separation. 277 : 278 : iwr=1 279 : izcti1=2**30 280 : izcti2=2**30 281 : izcti3=2**30 282 : izcti4=2**30 283 : izcti5=2**30 284 : izcti6=2**30 285 : izcte1=2**30 286 : izcte2=2**30 287 : izcte3=2**30 288 : izcte4=2**30 289 : izcte5=2**30 290 : izcte6=2**30 291 : dimseq=dimsep 292 : DO 20 IX=1,DIMLON 293 : I=NOELON(IX) 294 : * L'intérieur 295 : IF(MDOMN.EQ.IPOS(I+NODES).AND.(NRELONG(I).GT.0)) THEN 296 : IF((NRELONG(I).LT.L)) THEN 297 : * recherche de izcti 298 : do kk=iadj(i),iadj(i+1)-1 299 : k=jadjc(kk) 300 : if (k.ne.0) then 301 : if (nrelong(k).eq.0) then 302 : if (izcti1.eq.ipos(ipos(k+nodes)+1)) then 303 : elseif (izcti1.gt.ipos(ipos(k+nodes)+1)) then 304 : izcti6=izcti5 305 : izcti5=izcti4 306 : izcti4=izcti3 307 : izcti3=izcti2 308 : izcti2=izcti1 309 : izcti1=ipos(ipos(k+nodes)+1) 310 : elseif (izcti2.eq.ipos(ipos(k+nodes)+1)) then 311 : elseif (izcti2.gt.ipos(ipos(k+nodes)+1)) then 312 : izcti6=izcti5 313 : izcti5=izcti4 314 : izcti4=izcti3 315 : izcti3=izcti2 316 : izcti2=ipos(ipos(k+nodes)+1) 317 : ELSEIF (IZCTI3.EQ.IPOS(IPOS(K+NODES)+1)) THEN 318 : elseif (izcti3.gt.ipos(ipos(k+nodes)+1)) then 319 : izcti6=izcti5 320 : izcti5=izcti4 321 : izcti4=izcti3 322 : izcti3=ipos(ipos(k+nodes)+1) 323 : elseif (izcti4.eq.ipos(ipos(k+nodes)+1)) then 324 : elseif (izcti4.gt.ipos(ipos(k+nodes)+1)) then 325 : izcti6=izcti5 326 : izcti5=izcti4 327 : izcti4=ipos(ipos(k+nodes)+1) 328 : elseif (izcti5.eq.ipos(ipos(k+nodes)+1)) then 329 : elseif (izcti5.gt.ipos(ipos(k+nodes)+1)) then 330 : izcti6=izcti5 331 : izcti5=ipos(ipos(k+nodes)+1) 332 : elseif (izcti6.eq.ipos(ipos(k+nodes)+1)) then 333 : elseif (izcti6.gt.ipos(ipos(k+nodes)+1)) then 334 : izcti6=ipos(ipos(k+nodes)+1) 335 : endif 336 : endif 337 : endif 338 : enddo 339 : IPOS(I+NODES)=IPOSMAX-1 340 : IPOS(I+2*NODES)=IPOS(I+2*NODES)+1 341 : * write (6,*) ' zone ',i,IPOS(I+NODES) 342 : GOTO 20 343 : ENDIF 344 : 345 : IF(NRELONG(I).EQ.L) THEN 346 : * pour que le noeud soit bien dans la separation, il faut qu'il soit 347 : * connecter a un noeud de profondeur plus élevée (prob des noeuds milieux) 348 : DO 100 J=1,IADJ(I+1)-IADJ(I) 349 : K=JADJC(IADJ(I)+J-1) 350 : C K:voisin de I 351 : * if (k.eq.0) write (6,*) ' k peut valoir 0 ' 352 : IF(K.EQ.0) GOTO 100 353 : IF (NRELONG(K).EQ.0) GOTO 100 354 : IF(MDOMN.NE.IPOS(k+NODES).and. 355 : > ipos(k+nodes).lt.iposmax-2) then 356 : write (6,*) ' sepa2 mauvais domaine ',mdomn, 357 : > ipos(k+nodes),nrelong(k) 358 : GOTO 100 359 : endif 360 : IF(NRELONG(K).GT.L) GOTO 110 361 : 100 CONTINUE 362 : * recherche de izcti 363 : do kk=iadj(i),iadj(i+1)-1 364 : k=jadjc(kk) 365 : if (k.ne.0) then 366 : if (nrelong(k).eq.0) then 367 : if (izcti1.eq.ipos(ipos(k+nodes)+1)) then 368 : elseif (izcti1.gt.ipos(ipos(k+nodes)+1)) then 369 : izcti6=izcti5 370 : izcti5=izcti4 371 : izcti4=izcti3 372 : izcti3=izcti2 373 : izcti2=izcti1 374 : izcti1=ipos(ipos(k+nodes)+1) 375 : elseif (izcti2.eq.ipos(ipos(k+nodes)+1)) then 376 : elseif (izcti2.gt.ipos(ipos(k+nodes)+1)) then 377 : izcti6=izcti5 378 : izcti5=izcti4 379 : izcti4=izcti3 380 : izcti3=izcti2 381 : izcti2=ipos(ipos(k+nodes)+1) 382 : elseif (izcti3.eq.ipos(ipos(k+nodes)+1)) then 383 : elseif (izcti3.gt.ipos(ipos(k+nodes)+1)) then 384 : izcti6=izcti5 385 : izcti5=izcti4 386 : izcti4=izcti3 387 : izcti3=ipos(ipos(k+nodes)+1) 388 : elseif (izcti4.eq.ipos(ipos(k+nodes)+1)) then 389 : elseif (izcti4.gt.ipos(ipos(k+nodes)+1)) then 390 : izcti6=izcti5 391 : izcti5=izcti4 392 : izcti4=ipos(ipos(k+nodes)+1) 393 : elseif (izcti5.eq.ipos(ipos(k+nodes)+1)) then 394 : elseif (izcti5.gt.ipos(ipos(k+nodes)+1)) then 395 : izcti6=izcti5 396 : izcti5=ipos(ipos(k+nodes)+1) 397 : elseif (izcti6.eq.ipos(ipos(k+nodes)+1)) then 398 : elseif (izcti6.gt.ipos(ipos(k+nodes)+1)) then 399 : izcti6=ipos(ipos(k+nodes)+1) 400 : endif 401 : endif 402 : endif 403 : enddo 404 : IPOS(I+NODES)=IPOSMAX-1 405 : IPOS(I+2*NODES)=IPOS(I+2*NODES)+1 406 : * write (6,*) ' zone ',i,IPOS(I+NODES) 407 : GOTO 20 408 : ENDIF 409 : * 410 : * L'extérieur 411 : IF(NRELONG(I).GT.L) THEN 412 : * recherche de izcte 413 : do kk=iadj(i),iadj(i+1)-1 414 : k=jadjc(kk) 415 : if (k.ne.0) then 416 : if (nrelong(k).eq.0) then 417 : if (izcte1.eq.ipos(ipos(k+nodes)+1)) then 418 : elseif (izcte1.gt.ipos(ipos(k+nodes)+1)) then 419 : izcte6=izcte5 420 : izcte5=izcte4 421 : izcte4=izcte3 422 : izcte3=izcte2 423 : izcte2=izcte1 424 : izcte1=ipos(ipos(k+nodes)+1) 425 : elseif (izcte2.eq.ipos(ipos(k+nodes)+1)) then 426 : elseif (izcte2.gt.ipos(ipos(k+nodes)+1)) then 427 : izcte6=izcte5 428 : izcte5=izcte4 429 : izcte4=izcte3 430 : izcte3=izcte2 431 : izcte2=ipos(ipos(k+nodes)+1) 432 : elseif (izcte3.eq.ipos(ipos(k+nodes)+1)) then 433 : elseif (izcte3.gt.ipos(ipos(k+nodes)+1)) then 434 : izcte6=izcte5 435 : izcte5=izcte4 436 : izcte4=izcte3 437 : izcte3=ipos(ipos(k+nodes)+1) 438 : elseif (izcte4.eq.ipos(ipos(k+nodes)+1)) then 439 : elseif (izcte4.gt.ipos(ipos(k+nodes)+1)) then 440 : izcte6=izcte5 441 : izcte5=izcte4 442 : izcte4=ipos(ipos(k+nodes)+1) 443 : elseif (izcte5.eq.ipos(ipos(k+nodes)+1)) then 444 : elseif (izcte5.gt.ipos(ipos(k+nodes)+1)) then 445 : izcte6=izcte5 446 : izcte5=ipos(ipos(k+nodes)+1) 447 : elseif (izcte6.eq.ipos(ipos(k+nodes)+1)) then 448 : elseif (izcte6.gt.ipos(ipos(k+nodes)+1)) then 449 : izcte6=ipos(ipos(k+nodes)+1) 450 : endif 451 : endif 452 : endif 453 : enddo 454 : 455 : IPOS(I+NODES)=IPOSMAX 456 : IPOS(I+2*NODES)=IPOS(I+2*NODES)+1 457 : * write (6,*) ' zone ',i,IPOS(I+NODES) 458 : GOTO 20 459 : ENDIF 460 : GOTO 21 461 : * la frontiere 462 : 110 CONTINUE 463 : * write (6,*) ' zone ',i,IPOS(I+NODES) 464 : MASQ(I)=.FALSE. 465 : IPOS(I+NODES)=IPOSMAX-2 466 : DIMSEP=DIMSEP+1 467 : GOTO 20 468 : ENDIF 469 : * mars 470 : 21 CONTINUE 471 : 472 : 20 CONTINUE 473 : * do 23 i=1,nodes 474 : * IF(MDOMN.EQ.IPOS(I+NODES).AND.NRELONG(I).EQ.0) THEN 475 : * write (6,*) ' zone non connexe 2 ',mdomn,i 476 : * endif 477 : * 23 continue 478 : 479 : 480 : * write (6,*) ' taille de frontière ',dimsep-dimseq 481 : * write (6,*) ' rang des zones ',izcti,izcte 482 : ipos1=max(IPOS(IPOSMAX+1-1),IPOS(IPOSMAX+1+0)) 483 : ipos2=min(IPOS(IPOSMAX+1-1),IPOS(IPOSMAX+1+0)) 484 : if (izcti1.gt.izcte1) then 485 : IPOS(IPOSMAX+1-1)=ipos1 486 : IPOS(IPOSMAX+1+0)=ipos2 487 : elseif (izcti1.lt.izcte1) then 488 : IPOS(IPOSMAX+1-1)=ipos2 489 : IPOS(IPOSMAX+1+0)=ipos1 490 : elseif (izcti2.gt.izcte2) then 491 : IPOS(IPOSMAX+1-1)=ipos1 492 : IPOS(IPOSMAX+1+0)=ipos2 493 : elseif (izcti2.lt.izcte2) then 494 : IPOS(IPOSMAX+1-1)=ipos2 495 : IPOS(IPOSMAX+1+0)=ipos1 496 : elseif (izcti3.gt.izcte3) then 497 : IPOS(IPOSMAX+1-1)=ipos1 498 : IPOS(IPOSMAX+1+0)=ipos2 499 : elseif (izcti3.lt.izcte3) then 500 : IPOS(IPOSMAX+1-1)=ipos2 501 : IPOS(IPOSMAX+1+0)=ipos1 502 : elseif (izcti4.gt.izcte4) then 503 : IPOS(IPOSMAX+1-1)=ipos1 504 : IPOS(IPOSMAX+1+0)=ipos2 505 : elseif (izcti4.lt.izcte4) then 506 : IPOS(IPOSMAX+1-1)=ipos2 507 : IPOS(IPOSMAX+1+0)=ipos1 508 : elseif (izcti5.gt.izcte5) then 509 : IPOS(IPOSMAX+1-1)=ipos1 510 : IPOS(IPOSMAX+1+0)=ipos2 511 : elseif (izcti5.lt.izcte5) then 512 : IPOS(IPOSMAX+1-1)=ipos2 513 : IPOS(IPOSMAX+1+0)=ipos1 514 : elseif (izcti6.gt.izcte6) then 515 : IPOS(IPOSMAX+1-1)=ipos1 516 : IPOS(IPOSMAX+1+0)=ipos2 517 : elseif (izcti6.lt.izcte6) then 518 : IPOS(IPOSMAX+1-1)=ipos2 519 : IPOS(IPOSMAX+1+0)=ipos1 520 : else 521 : * write (6,*) ' ordonnancement impossible', 522 : * > izcti1,izcti2,izcti3,izcti4,izcti5,izcti6, 523 : * > izcte1,izcte2,izcte3,izcte4,izcte5,izcte6 524 : endif 525 : 526 : 50 continue 527 : do ix=1,dimlon 528 : ii=noelon(ix) 529 : nrelong(ii)=0 530 : enddo 531 : 532 : RETURN 533 : END 534 : 535 : 536 : 537 : 538 : 539 : 540 : 541 : 542 : 543 : 544 : 545 : 546 : 547 : 548 : 549 : 550 : 551 : 552 : 553 : 554 : 555 : 556 : 557 : 558 : 559 : 560 : 561 : 562 :
© Cast3M 2003 - All rights reserved.
Disclaimer