1 : C COM443 SOURCE FANDEUR 13/01/29 21:15:16 7683 2 : C---------------------------------------------------------------------| 3 : C | 4 : SUBROUTINE COM443(II,MF1,MF2,MF3,IGAGNE) 5 : C | 6 : C CETTE SUBROUTINE TENTE DE CREER 2 PYRAMIDES ET 1 TETRAEDRE | 7 : C A PARTIR DES QUADRANGLES IF1, IF2 ET DU TRIANGLE IF3 EN | 8 : C CREANT UN POINT | 9 : C CENTRAL SUPPLEMENTAIRE | 10 : C - IGAGNE=1 EN CAS DE SUCCES | 11 : C - IGAGNE=0 EN CAS D'ECHEC | 12 : C | 13 : C---------------------------------------------------------------------| 14 : C 15 : IMPLICIT INTEGER(I-N) 16 : IMPLICIT REAL*8(A-H,O-Z) 17 : -INC TDEMAIT 18 : -INC CCOPTIO 19 : LOGICAL REPONS,FACET,SOLPYR,SOLTET,IN2,diago 20 : nfcini=nfcmax 21 : nptini=nptmax 22 : nvini=nvol 23 : ICTP=0 24 : ipin = 0 25 : C 26 : C METTRE LES FACES DANS L'ORDRE 27 : IF3=MF3 28 : IP=ISUCC(IF3,II) 29 : IF (IP.EQ.IPRED(MF1,II)) IF1=MF1 30 : IF (IP.EQ.IPRED(MF2,II)) IF1=MF2 31 : IP=ISUCC(IF1,II) 32 : IF (IP.EQ.IPRED(MF1,II)) IF2=MF1 33 : IF (IP.EQ.IPRED(MF2,II)) IF2=MF2 34 : * WRITE(6,1000)IF1,IF2,IF3 35 : 1000 FORMAT(' COM443 IF1=',I5,' IF2=',I5,' IF3=',I5) 36 : C 37 : ICTF=0 38 : ICTV=0 39 : C 40 : C 41 : C CREATION DU POINT CENTRAL : IP 42 : C ------------------------------ 43 : IP1=II 44 : IP2=ISUCC(IF1,IP1) 45 : IP3=ISUCC(IF1,IP2) 46 : IP4=ISUCC(IF1,IP3) 47 : ICTP=1 48 : NPTMAX=NPTMAX+1 49 : IP=NPTMAX 50 : C 51 : DO 100 I=1,4 52 : * XYZ(I,IP)=(XYZ(I,IP1)+XYZ(I,IP2)+XYZ(I,IP3) 53 : * # +XYZ(I,IP4))/4. 54 : XYZ(I,IP)=(XYZ(I,IP2)+XYZ(I,IP4))/2. 55 : 100 CONTINUE 56 : JP1=II 57 : JP2=ISUCC(IF2,JP1) 58 : JP3=ISUCC(IF2,JP2) 59 : JP4=ISUCC(IF2,JP3) 60 : C 61 : DO 102 I=1,4 62 : * XYZ(I,IP)=XYZ(I,IP)+ 63 : * # (XYZ(I,JP1)+XYZ(I,JP2)+XYZ(I,JP3)+XYZ(I,JP4))/4. 64 : XYZ(I,IP)=XYZ(I,IP)+ 65 : # (XYZ(I,JP2)+XYZ(I,JP4))/2. 66 : 102 CONTINUE 67 : KP1=II 68 : KP2=ISUCC(IF3,KP1) 69 : KP3=ISUCC(IF3,KP2) 70 : C 71 : DO 104 I=1,4 72 : XYZ(I,IP)=(XYZ(I,IP)+ 73 : # (XYZ(I,KP2)+XYZ(I,KP3))/2.)/3. 74 : 104 CONTINUE 75 : DO 103 I=1,3 76 : XYZ(I,IP)=XYZ(I,II)+expcom*(XYZ(I,IP)-XYZ(I,II)) 77 : 103 CONTINUE 78 : C 79 : * WRITE(6,1010)IP,(XYZ(I,IP),I=1,4) 80 : 1010 FORMAT(' POINT:',I3,':',4F7.2) 81 : * verif des volumes 82 : if ((vol(ip,ii,ip2,ip4).gt.0).or. 83 : > (vol(ip,ii,jp2,jp4).gt.0).or. 84 : > (vol(ip,ii,kp2,kp3).gt.0)) then 85 : write (6,*) ' com443 volume positif ' 86 : nptmax=nptini 87 : return 88 : endif 89 : C 89 : CALL DIST(IP,JP,GL,IOK,IP1,IP2,IP3,IP4,JP2,JP3,JP4,KP2,KP3,0) 90 : IF (IOK.EQ.0) THEN 91 : NPTMAX=NPTini 92 : RETURN 93 : ICTP=0 94 : NPTMAX=NPTMAX-1 95 : IP=JP 96 : * WRITE (6,*) ' COM443 POINT ASSIMILE ',JP 97 : ENDIF 98 : REPONS=IN2(ii,IP,nfcini) 99 : IF (REPONS) GOTO 110 100 : NPTMAX=NPTini 101 : RETURN 102 : C 103 : 110 CONTINUE 104 : C 105 : C CREATION D'UNE PYRAMIDE : IF1+IP 106 : C -------------------------------- 107 : IP1=ISUCC(IF1,II) 108 : IP2=ISUCC(IF1,IP1) 109 : IP3=ISUCC(IF1,IP2) 110 : * recherche existence de la face 111 : jf1=IFACE3(ip,ii,ip1) 112 : * IF (jf1.ne.0) write (6,*) ' com443 facette assimilee' 113 : IF (jf1.eq.0) THEN 114 : nfcmax=nfcmax+1 115 : jf1=nfcmax 116 : NFC(1,jf1)=ip 117 : NFC(2,jf1)=ii 118 : NFC(3,jf1)=ip1 119 : NFC(4,jf1)=0 120 : elseif (NFC(4,jf1).ne.0.or.ipred(jf1,ip).ne.ii) then 121 : jf1=0 122 : endif 123 : * write (6,*) ' com443 jf1 passe ',jf1 124 : C 125 : * recherche existence de la face 126 : jf2=IFACE3(ip,ip1,ip2) 127 : * IF (jf2.ne.0) write (6,*) ' com443 facette assimilee' 128 : IF (jf2.eq.0) THEN 129 : nfcmax=nfcmax+1 130 : jf2=nfcmax 131 : NFC(1,jf2)=ip 132 : NFC(2,jf2)=ip1 133 : NFC(3,jf2)=ip2 134 : NFC(4,jf2)=0 135 : elseif (NFC(4,jf2).ne.0.or.ipred(jf2,ip).ne.ip1) then 136 : jf2=0 137 : endif 138 : * write (6,*) ' com443 jf2 passe ',jf2 139 : C 140 : * recherche existence de la face 141 : jf3=IFACE3(ip,ip2,ip3) 142 : * IF (jf3.ne.0) write (6,*) ' com443 facette assimilee' 143 : IF (jf3.eq.0) THEN 144 : nfcmax=nfcmax+1 145 : jf3=nfcmax 146 : NFC(1,jf3)=ip 147 : NFC(2,jf3)=ip2 148 : NFC(3,jf3)=ip3 149 : NFC(4,jf3)=0 150 : elseif (NFC(4,jf3).ne.0.or.ipred(jf3,ip).ne.ip2) then 151 : jf3=0 152 : endif 153 : * write (6,*) ' com443 jf3 passe ',jf3 154 : C 155 : * recherche existence de la face 156 : jf4=IFACE3(ip,ip3,ii) 157 : * IF (jf4.ne.0) write (6,*) ' com443 facette assimilee' 158 : IF (jf4.eq.0) THEN 159 : nfcmax=nfcmax+1 160 : jf4=nfcmax 161 : NFC(1,jf4)=ip 162 : NFC(2,jf4)=ip3 163 : NFC(3,jf4)=ii 164 : NFC(4,jf4)=0 165 : elseif (NFC(4,jf4).ne.0.or.ipred(jf4,ip).ne.ip3) then 166 : jf4=0 167 : endif 168 : * write (6,*) ' com443 jf4 passe ',jf4 169 : C 170 : if (diago(ip,ii,diacrd)) then 171 : jf4=0 172 : jf1=0 173 : endif 174 : if (diago(ip,ip1,diacrd)) then 175 : jf1=0 176 : jf2=0 177 : endif 178 : if (diago(ip,ip2,diacrd)) then 179 : jf2=0 180 : jf3=0 181 : endif 182 : if (diago(ip,ip3,diacrd)) then 183 : jf3=0 184 : jf4=0 185 : endif 186 : if (jf1*jf2*jf3*jf4.eq.0) then 187 : * write (6,*) 'com443 impossibilite ' 188 : nfcmax=nfcini 189 : jf1=0 190 : jf2=0 191 : jf3=0 192 : jf4=0 193 : goto 131 194 : endif 194 : CALL REPSUB(IF1) 194 : CALL REPSUB(JF1) 194 : CALL REPSUB(JF2) 194 : CALL REPSUB(JF3) 194 : CALL REPSUB(JF4) 195 : C 196 : C LE VOLUME CREE EST-IL VALIDE ? 197 : C ------------------------------ 198 : IF (.not.SOLPYR(IF1,JF1,JF2,JF3,JF4)) GOTO 129 199 : IF (.NOT.FACET(jF1)) GOTO 129 200 : IF (.NOT.FACET(jF2)) GOTO 129 201 : IF (.NOT.FACET(jF3)) GOTO 129 202 : IF (.NOT.FACET(jF4)) GOTO 129 203 : goto 130 204 : C 205 : C LE VOLUME EST INVALIDE 206 : C ---------------------- 207 : 129 continue 208 : * write (6,*) ' solpyr 1 invalide' 209 : NFCMAX=NFCini 209 : CALL REPSUB(JF4) 209 : CALL REPSUB(JF3) 209 : CALL REPSUB(JF2) 209 : CALL REPSUB(JF1) 209 : CALL REPSUB(IF1) 210 : jf1=0 211 : jf2=0 212 : jf3=0 213 : jf4=0 214 : goto 131 215 : C 216 : 130 CONTINUE 217 : C 218 : C MEMORISATION DU VOLUME OBTENU : IF1, JF1, JF2, JF3 ET JF4 219 : C --------------------------------------------------------- 220 : ICTV=ICTV+1 221 : NVOL=NVOL+1 222 : IF (NFV(1,IF1).EQ.0) NFV(1,IF1)=NVOL 223 : IF (NFV(1,IF1).NE.NVOL) NFV(2,IF1)=NVOL 224 : IF (NFV(1,JF1).EQ.0) NFV(1,JF1)=NVOL 225 : IF (NFV(1,JF1).NE.NVOL) NFV(2,JF1)=NVOL 226 : IF (NFV(1,JF2).EQ.0) NFV(1,JF2)=NVOL 227 : IF (NFV(1,JF2).NE.NVOL) NFV(2,JF2)=NVOL 228 : IF (NFV(1,JF3).EQ.0) NFV(1,JF3)=NVOL 229 : IF (NFV(1,JF3).NE.NVOL) NFV(2,JF3)=NVOL 230 : IF (NFV(1,JF4).EQ.0) NFV(1,JF4)=NVOL 231 : IF (NFV(1,JF4).NE.NVOL) NFV(2,JF4)=NVOL 232 : IVOL(9,NVOL)=35 233 : C 234 : DO 140 I=1,4 235 : IVOL(I,NVOL)=NFC(I,IF1) 236 : 140 CONTINUE 237 : IVOL(5,NVOL)=IP 238 : *C 239 : * WRITE(6,1100)NVOL,(IVOL(I,NVOL),I=1,9) 240 : *1100 FORMAT(I4,4X,14I4) 241 : if (iimpi.eq.1) write (6,1100) nfacet,(ivol(i,nvol),i=1,5) 242 : 1100 FORMAT(' COM443-1 facettes ',i5,' PYR5 ',8i5) 243 : *C 244 : * DO 150 J=1,NPTMAX 245 : * WRITE(6,1110)J,(NPF(I,J),I=1,40) 246 : *1110 FORMAT(I4,4X,40I3) 247 : *150 CONTINUE 248 : C PV INC 249 : C 250 : 131 continue 251 : nfcini=nfcmax 252 : C 2EME VOLUME : IF2+IP 253 : C -------------------- 254 : IP1=ISUCC(IF2,II) 255 : IP2=ISUCC(IF2,IP1) 256 : IP3=ISUCC(IF2,IP2) 257 : C 258 : * recherche existence de la face 259 : kf1=IFACE3(ip,ii,ip1) 260 : * IF (kf1.ne.0) write (6,*) ' com443 facette assimilee' 261 : IF (kf1.eq.0) THEN 262 : nfcmax=nfcmax+1 263 : kf1=nfcmax 264 : NFC(1,kf1)=ip 265 : NFC(2,kf1)=ii 266 : NFC(3,kf1)=ip1 267 : NFC(4,kf1)=0 268 : elseif (NFC(4,kf1).ne.0.or.ipred(kf1,ip).ne.ii) then 269 : kf1=0 270 : endif 271 : * write (6,*) ' com443 kf1 passe ',kf1 272 : C 273 : * recherche existence de la face 274 : kf2=IFACE3(ip,ip1,ip2) 275 : * IF (kf2.ne.0) write (6,*) ' com443 facette assimilee' 276 : IF (kf2.eq.0) THEN 277 : nfcmax=nfcmax+1 278 : kf2=nfcmax 279 : NFC(1,kf2)=ip 280 : NFC(2,kf2)=ip1 281 : NFC(3,kf2)=ip2 282 : NFC(4,kf2)=0 283 : elseif (NFC(4,kf2).ne.0.or.ipred(kf2,ip).ne.ip1) then 284 : kf2=0 285 : endif 286 : * write (6,*) ' com443 kf2 passe ',kf2 287 : C 288 : * recherche existence de la face 289 : kf3=IFACE3(ip,ip2,ip3) 290 : * IF (kf3.ne.0) write (6,*) ' com443 facette assimilee' 291 : IF (kf3.eq.0) THEN 292 : nfcmax=nfcmax+1 293 : kf3=nfcmax 294 : NFC(1,kf3)=ip 295 : NFC(2,kf3)=ip2 296 : NFC(3,kf3)=ip3 297 : NFC(4,kf3)=0 298 : elseif (NFC(4,kf3).ne.0.or.ipred(kf3,ip).ne.ip2) then 299 : kf3=0 300 : endif 301 : * write (6,*) ' com443 kf3 passe ',kf3 302 : C 303 : C ON RETOMBE SUR JF1 (si on ne l'a pas detruit) 304 : C 305 : kf4=IFACE3(ip,ip3,ii) 306 : * IF (kf4.ne.0) write (6,*) ' com443 facette deja existante' 307 : IF (kf4.eq.0) THEN 308 : nfcmax=nfcmax+1 309 : kf4=nfcmax 310 : NFC(1,kf4)=ip 311 : NFC(2,kf4)=ip3 312 : NFC(3,kf4)=ii 313 : NFC(4,kf4)=0 314 : elseif (NFC(4,kf4).ne.0.or.ipred(kf4,ip).ne.ip3) then 315 : kf4=0 316 : endif 317 : * write (6,*) ' com443 kf4 passe ',kf4 318 : C 319 : C 320 : if (diago(ip,ii,diacrd)) then 321 : kf4=0 322 : kf1=0 323 : endif 324 : if (diago(ip,ip1,diacrd)) then 325 : kf1=0 326 : kf2=0 327 : endif 328 : if (diago(ip,ip2,diacrd)) then 329 : kf2=0 330 : kf3=0 331 : endif 332 : if (diago(ip,ip3,diacrd)) then 333 : kf3=0 334 : kf4=0 335 : endif 336 : if (kf1*kf2*kf3*kf4.eq.0) then 337 : * write (6,*) 'com443 impossibilite ' 338 : nfcmax=nfcini 339 : kf1=0 340 : kf2=0 341 : kf3=0 342 : kf4=0 343 : goto 161 344 : endif 344 : CALL REPSUB(IF2) 344 : CALL REPSUB(KF1) 344 : CALL REPSUB(KF2) 344 : CALL REPSUB(KF3) 344 : CALL REPSUB(KF4) 345 : C 346 : C LE VOLUME CREE EST-IL VALIDE ? 347 : C ------------------------------ 348 : if (.not.SOLPYR(IF2,KF1,KF2,KF3,KF4)) GOTO 160 349 : IF (.NOT.FACET(KF1)) GOTO 160 350 : IF (.NOT.FACET(KF2)) GOTO 160 351 : IF (.NOT.FACET(KF3)) GOTO 160 352 : IF (.NOT.FACET(KF4)) GOTO 160 353 : goto 170 354 : C 355 : 160 CONTINUE 356 : C 357 : * write (6,*) ' solpyr 2 invalide' 358 : NFCMAX=NFCini 358 : CALL REPSUB(KF4) 358 : CALL REPSUB(KF3) 358 : CALL REPSUB(KF2) 358 : CALL REPSUB(KF1) 358 : CALL REPSUB(IF2) 359 : kf1=0 360 : kf2=0 361 : kf3=0 362 : kf4=0 363 : goto 161 364 : C 365 : 170 CONTINUE 366 : C 367 : C MEMORISATION DU VOLUME IF2, LF1, KF2, KF3 ET LF4 368 : C ------------------------------------------------ 369 : ICTV=ICTV+1 370 : NVOL=NVOL+1 371 : IF (NFV(1,IF2).EQ.0) NFV(1,IF2)=NVOL 372 : IF (NFV(1,IF2).NE.NVOL) NFV(2,IF2)=NVOL 373 : IF (NFV(1,kF1).EQ.0) NFV(1,kF1)=NVOL 374 : IF (NFV(1,kF1).NE.NVOL) NFV(2,kF1)=NVOL 375 : IF (NFV(1,kF2).EQ.0) NFV(1,kF2)=NVOL 376 : IF (NFV(1,kF2).NE.NVOL) NFV(2,kF2)=NVOL 377 : IF (NFV(1,kF3).EQ.0) NFV(1,kF3)=NVOL 378 : IF (NFV(1,kF3).NE.NVOL) NFV(2,kF3)=NVOL 379 : IF (NFV(1,kF4).EQ.0) NFV(1,kF4)=NVOL 380 : IF (NFV(1,kF4).NE.NVOL) NFV(2,kF4)=NVOL 381 : IVOL(9,NVOL)=35 382 : C 383 : DO 180 I=1,4 384 : IVOL(I,NVOL)=NFC(I,IF2) 385 : 180 CONTINUE 386 : IVOL(5,NVOL)=IP 387 : * WRITE(6,1180)NVOL,(IVOL(I,NVOL),I=1,9) 388 : *1180 FORMAT(I4,4X,14I4) 389 : if (iimpi.eq.1) write (6,1180) nfacet,(ivol(i,nvol),i=1,5) 390 : 1180 FORMAT(' COM443-2 facettes ',i5,' PYR5 ',8i5) 391 : *C 392 : * DO 190 J=1,NPTMAX 393 : * WRITE(6,1190)J,(NPF(I,J),I=1,40) 394 : *1190 FORMAT(I4,4X,40I3) 395 : *190 CONTINUE 396 : C 397 : 161 continue 398 : nfcini=nfcmax 399 : C 400 : C 3EME VOLUME : IF3+IP 401 : C -------------------- 402 : IP1=ISUCC(IF3,II) 403 : IP2=ISUCC(IF3,IP1) 404 : C ON RETOMBE SUR JF4 (si on ne l'a pas detruit) 405 : C 406 : lf1=IFACE3(ip,ii,ip1) 407 : * IF (lf1.ne.0) write (6,*) ' com443 facette deja existante' 408 : IF (lf1.eq.0) THEN 409 : nfcmax=nfcmax+1 410 : lf1=nfcmax 411 : NFC(1,lf1)=ip 412 : NFC(2,lf1)=ii 413 : NFC(3,lf1)=ip1 414 : NFC(4,lf1)=0 415 : elseif (NFC(4,lf1).ne.0.or.ipred(lf1,ip).ne.ii) then 416 : lf1=0 417 : endif 418 : * write (6,*) ' com443 lf1 passe ',lf1 419 : C 420 : C 421 : * recherche existence de la face 422 : lf2=IFACE3(ip,ip1,ip2) 423 : * IF (lf2.ne.0) write (6,*) ' com443 facette assimilee' 424 : IF (lf2.eq.0) THEN 425 : nfcmax=nfcmax+1 426 : lf2=nfcmax 427 : NFC(1,lf2)=ip 428 : NFC(2,lf2)=ip1 429 : NFC(3,lf2)=ip2 430 : NFC(4,lf2)=0 431 : elseif (NFC(4,lf2).ne.0.or.ipred(lf2,ip).ne.ip1) then 432 : lf2=0 433 : endif 434 : * write (6,*) ' com443 lf2 passe ',lf2 435 : C 436 : C ON RETOMBE SUR KF1 (si on ne l'a pas detruit) 437 : C 438 : lf3=IFACE3(ip,ip2,ii) 439 : * IF (lf3.ne.0) write (6,*) ' com443 facette deja existante' 440 : IF (lf3.eq.0) THEN 441 : nfcmax=nfcmax+1 442 : lf3=nfcmax 443 : NFC(1,lf3)=ip 444 : NFC(2,lf3)=ip2 445 : NFC(3,lf3)=ii 446 : NFC(4,lf3)=0 447 : elseif (NFC(4,lf3).ne.0.or.ipred(lf3,ip).ne.ip2) then 448 : lf3=0 449 : endif 450 : * write (6,*) ' com443 lf3 passe ',lf3 451 : C 452 : if (diago(ip,ii,diacrd)) then 453 : lf3=0 454 : lf1=0 455 : endif 456 : if (diago(ip,ip1,diacrd)) then 457 : lf1=0 458 : lf2=0 459 : endif 460 : if (diago(ip,ip2,diacrd)) then 461 : lf2=0 462 : lf3=0 463 : endif 464 : if (lf1*lf2*lf3.eq.0) then 465 : * write (6,*) 'com443 impossibilite ' 466 : NFCMAX=NFCini 467 : goto 201 468 : endif 469 : C 470 : C 470 : CALL REPSUB(IF3) 470 : CALL REPSUB(LF1) 470 : CALL REPSUB(LF2) 470 : CALL REPSUB(LF3) 471 : C 472 : C LE VOLUME CREE EST-IL VALIDE ? 473 : C ------------------------------ 474 : IF (.NOT.SOLTET(IF3,LF1,LF2,LF3,ipin)) GOTO 200 475 : IF (.NOT.FACET(LF1)) GOTO 200 476 : IF (.NOT.FACET(LF2)) GOTO 200 477 : IF (.NOT.FACET(LF3)) GOTO 200 478 : GOTO 210 479 : C 480 : 200 CONTINUE 481 : * write (6,*) ' soltet 3 invalide' 482 : C 483 : NFCMAX=NFCini 483 : CALL REPSUB(LF3) 483 : CALL REPSUB(LF2) 483 : CALL REPSUB(LF1) 483 : CALL REPSUB(IF3) 484 : goto 201 485 : C 486 : 210 CONTINUE 487 : C 488 : C MEMORISATION DU VOLUME IF3, JF2, KF1, LF1 ET LF2 489 : C ------------------------------------------------ 490 : ICTV=ICTV+1 491 : NVOL=NVOL+1 492 : IF (NFV(1,IF3).EQ.0) NFV(1,IF3)=NVOL 493 : IF (NFV(1,IF3).NE.NVOL) NFV(2,IF3)=NVOL 494 : IF (NFV(1,lF1).EQ.0) NFV(1,lF1)=NVOL 495 : IF (NFV(1,lF1).NE.NVOL) NFV(2,lF1)=NVOL 496 : IF (NFV(1,lF2).EQ.0) NFV(1,lF2)=NVOL 497 : IF (NFV(1,lF2).NE.NVOL) NFV(2,lF2)=NVOL 498 : IF (NFV(1,lF3).EQ.0) NFV(1,lF3)=NVOL 499 : IF (NFV(1,lF3).NE.NVOL) NFV(2,lF3)=NVOL 500 : IVOL(9,NVOL)=25 501 : C 502 : DO 220 I=1,3 503 : IVOL(I,NVOL)=NFC(I,IF3) 504 : 220 CONTINUE 505 : IVOL(4,NVOL)=IP 506 : * WRITE(6,1240)NVOL,(IVOL(I,NVOL),I=1,9) 507 : *1240 FORMAT(I4,4X,14I4) 508 : if (iimpi.eq.1) write (6,1240) nfacet,(ivol(i,nvol),i=1,4) 509 : 1240 FORMAT(' COM443-3 facettes ',i5,' TET4 ',8i5) 510 : C 511 : * DO 230 J=1,NPTMAX 512 : * WRITE(6,1250)J,(NPF(I,J),I=1,40) 513 : *1250 FORMAT(I4,4X,40I3) 514 : *230 CONTINUE 515 : C 516 : 201 continue 517 : if (nvol.eq.nvini) then 518 : nptmax=nptini 519 : return 520 : endif 521 : C 522 : 290 CONTINUE 523 : C 524 : * if (iimpi.ne.0) write (6,*) ' comm443 point ',nptmax 525 : IGAGNE=1 525 : * CALL CONS33(IPRED(KF3,IP),IP,KF3,JF2,IGAG,1) 526 : RETURN 527 : C 528 : C FIN DE LA SUBROUTINE COM443 529 : END 530 : 531 : 532 :
© Cast3M 2003 - All rights reserved.
Disclaimer