1 : C TRIALU SOURCE GOUNAND 11/10/07 21:16:16 7149 2 : SUBROUTINE TRIALU(MATRIK,AMORS,AISA, 3 : $ IDMAT, 4 : $ IMPR,IRET) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : IMPLICIT INTEGER (I-N) 7 : C************************************************************************ 8 : C 9 : C Triangulation d'une matrice symetrique ou non 10 : C On decoupe la matrice en bloc 11 : C Si IDMAT ne 0 la matrice est deja triangulee on saute 12 : C 13 : C HISTORIQUE : 22/03/00 gounand 14 : C Amélioration de la détection des pivots nulles (pas encore parfaite) 15 : C HISTORIQUE : 13/01/00 Adaptation au nouvel assemblage : 16 : C Modifications cosmétiques. 17 : C Correction sur la détection des diagonales nulles (pas encore 18 : C parfaite). 19 : C Modification de la taille des paquets pour tenir dans le cache 20 : C (dépendant machine). 21 : C Inlining manuel des produits scalaires de vecteurs (sdot) qui 22 : C sont appelés de nombreuses fois... 23 : C Gestion correcte des allocations mémoire. 24 : C HISTORIQUE : 25 : C HISTORIQUE : 26 : C************************************************************************ 27 : * REAL*8 SDOT 28 : -INC CCOPTIO 29 : -INC CCREEL 30 : -INC SMMATRIK 31 : INTEGER NTT,NPT,NBLK,KTRING 32 : INTEGER NBVA 33 : POINTEUR ISAU.IZA,ISAL.IZA 34 : POINTEUR ISAU0.IZA,ISAL0.IZA 35 : POINTEUR ISAU00.IZA,ISAL00.IZA 36 : POINTEUR AMORS.PMORS 37 : POINTEUR AISA.IZA 38 : POINTEUR PMTRAN.PMORS 39 : POINTEUR MYMINC.MINC 40 : -INC SMELEME 41 : POINTEUR MYPTS.MELEME 42 : -INC SMLREEL 43 : POINTEUR GGIS.MLREEL 44 : *STAT-INC SMSTAT 45 : INTEGER IMPR,IRET 46 : * 47 : INTEGER NBVD 48 : SEGMENT IZD 49 : REAL*8 D(NBVD) 50 : ENDSEGMENT 51 : INTEGER IBLSIZ 52 : * REAL*8 GGIS 53 : LOGICAL LACTL,LACTU 54 : * Le logique LISDDL indique si l'on est capable de faire 55 : * la correspondance numéro DDL <-> numéro de point, nom d'inconnue 56 : LOGICAL LISDDL 57 : INTEGER TRAMIN 58 : INTEGER I,ISTRT,ISTOP 59 : INTEGER J,JSTRT,JSTOP 60 : INTEGER NTTDDL 61 : REAL*8 TNORM,YZPREC,US 62 : C******************************************************************* 63 : C 64 : C 65 : IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans trialu' 66 : IKOMPT=0 67 : * GGIS=XZPREC 68 : SEGACT MATRIK 69 : KTRING=MATRIK.KIDMAT(9) 70 : KSIM=MATRIK.KSYM 71 : IDMAT=MATRIK.KIDMAT(1) 72 : MYMINC=MATRIK.KMINC 73 : MYPTS=MATRIK.KISPGT 74 : SEGDES MATRIK 75 : IF(KTRING.NE.2) THEN 75 : *STAT CALL INMSTA(MSTAT,1) 76 : SEGACT MATRIK*MOD 77 : MATRIK.KIDMAT(9)=2 78 : SEGDES MATRIK 79 : SEGACT IDMAT*MOD 80 : C Initialisation des KZA 81 : SEGACT AMORS 82 : NTT=AMORS.IA(/1)-1 83 : NPT=IDMAT.NUAN(/1) 84 : LISDDL=(MYMINC.NE.0.AND.MYPTS.NE.0.AND.NPT.GT.0) 85 : NBLK=0 86 : SEGADJ,IDMAT 87 : DO 9 ITT=1,NTT 88 : IDMAT.KZA(ITT)=ITT-AMORS.JA(AMORS.IA(ITT))+1 89 : 9 CONTINUE 90 : SEGDES AMORS 91 : C On construit la transposée du profil 92 : C (La matrice Skyline est supposée avoir une structure symétrique) 93 : C La transposée du profil n'a pas ses colonnes ordonnées... 93 : CALL MAKPMT(AMORS, 94 : $ PMTRAN, 95 : $ IMPR,IRET) 96 : IF (IRET.NE.0) GOTO 9999 97 : SEGACT PMTRAN 98 : DO 91 ITT=1,NTT 99 : JSTRT=PMTRAN.IA(ITT) 100 : JSTOP=PMTRAN.IA(ITT+1)-1 101 : TRAMIN=PMTRAN.JA(JSTRT) 102 : DO 912 J=JSTRT+1,JSTOP 103 : TRAMIN=MIN(TRAMIN,PMTRAN.JA(J)) 104 : 912 CONTINUE 105 : TRAMIN=DIM(ITT,TRAMIN)+1 106 : IDMAT.KZA(ITT)=MAX(IDMAT.KZA(ITT),TRAMIN) 107 : 91 CONTINUE 108 : SEGSUP PMTRAN 108 : *STAT CALL PRMSTA('Init. KZA',MSTAT,1) 109 : C 110 : C On cree les blocs 111 : C 112 : C La matrice est stockée par blocs de plusieurs lignes. En effet, il faut 113 : C l'équivalent de 900 opérations pour activer/désactiver un segment. Si 114 : C une ligne de la matrice comprend 50 éléments, on fait 100 opérations 115 : C utiles et 900 inutiles lors de la résolution. 116 : C La taille des blocs est fixée par le paramètre IBLSIZ. La diagonale est 117 : C stockée dans un segment à part. 118 : C 119 : C Il nous faut constituer un certain nombre de tableaux. Le premier segment 120 : C décrit la matrice. Il contient un tableau donnant les numéros des premières 121 : C lignes de chaque bloc et un tableau de pointeurs sur des segments 122 : C descripteurs de bloc. 123 : C 124 : C Calcul de la longueur des blocs, on choisit ce qu'il faut 125 : C 126 : C Attention !! il y a au moins deux blocs activés en même temps et au plus 4 127 : C Peut-être qu'une bonne formule fait intervenir la taille du cache... 128 : C (Cache-Place(KZA,NUIA,DESCL...)) / 4 (blocs simultanés) 129 : * IBLSIZ=OOOVAL(1,1)/100000 130 : * Pour 128Ko de cache => 8 KMots 131 : IBLSIZ=8000 132 : C 133 : C Il faut d'abord déterminer le nombre de blocs. 134 : C 135 : LONG=0 136 : NTT=KZA(/1) 137 : DO 96 I=1,NTT 138 : LONG=LONG+KZA(I) 139 : 96 CONTINUE 140 : NBLK=1 141 : IF(LONG-NTT.GT.IBLSIZ) THEN 142 : ILBL=0 143 : DO 12 KK=2,NTT 144 : LA=KZA(KK)-1 145 : IF(LA.GT.IBLSIZ) THEN 146 : NBLK=NBLK+2 147 : ILBL=0 148 : ELSE 149 : ILBL=ILBL+LA 150 : IF(ILBL.GT.IBLSIZ) THEN 151 : NBLK=NBLK+1 152 : ILBL=LA 153 : ENDIF 154 : ENDIF 155 : 12 CONTINUE 156 : ENDIF 157 : C 158 : C On peut allouer le segment descripteur de la matrice. On va pouvoir 159 : C remplir des numéros de ligne des débuts de bloc. 160 : C 161 : NTT=KZA(/1) 162 : NPT=NUAN(/1) 163 : SEGADJ IDMAT 164 : IF(NBLK.EQ.1) THEN 165 : NLDBLK(1)=1 166 : NLDBLK(2)=NTT+1 167 : ELSE 168 : IBLK=1 169 : ILBL=0 170 : NLDBLK(1)=1 171 : NLDBLK(NBLK+1)=NTT+1 172 : DO 13 KK=2,NTT 173 : LA=KZA(KK)-1 174 : IF(LA.GT.IBLSIZ) THEN 175 : NLDBLK(IBLK+1)=KK 176 : NLDBLK(IBLK+2)=KK+1 177 : IBLK=IBLK+2 178 : ILBL=0 179 : ELSE 180 : ILBL=ILBL+LA 181 : IF(ILBL.GT.IBLSIZ) THEN 182 : NLDBLK(IBLK+1)=KK 183 : ILBL=LA 184 : IBLK=IBLK+1 185 : ENDIF 186 : ENDIF 187 : 13 CONTINUE 188 : ENDIF 189 : IF(IMPR.GE.2) THEN 190 : IF(KSIM.EQ.0) THEN 191 : WRITE(IOIMP,*) '* NOMBRE DE BLOCS DE ',IBLSIZ, 192 : $ ' MOTS : ',NBLK 193 : ELSE 194 : WRITE(IOIMP,*)'* NOMBRE DE BLOCS DE ',IBLSIZ, 195 : $ ' MOTS : 2 X ',NBLK 196 : ENDIF 197 : ENDIF 198 : C 199 : C On Remplit les blocs 200 : C 201 : SEGACT AMORS 202 : SEGACT AISA 203 : * On construit le vecteurs des normes des lignes 204 : NTTDDL=AMORS.IA(/1)-1 205 : JG=NTTDDL 206 : SEGINI GGIS 207 : YZPREC=XZPREC**(0.9D0) 208 : * YZPREC=1.D-9 209 : DO 152 ITTDDL=1,NTTDDL 210 : * Calcul de la norme de la ittème ligne 211 : ISTRT=AMORS.IA(ITTDDL) 212 : ISTOP=AMORS.IA(ITTDDL+1)-1 213 : TNORM=XZERO 214 : DO 1521 IJA=ISTRT,ISTOP 215 : TNORM=TNORM+ABS(AISA.A(IJA)) 216 : 1521 CONTINUE 217 : * WRITE(IOIMP,*) 'ITTDDL=',ITTDDL,' TNORM=',TNORM 218 : * 219 : C IF (TNORM.EQ.0.D0) THEN 220 : C WRITE(IOIMP,*) 'The ',ITTDDL,'th line is zero' 221 : CC Résolution impossible détectée au noeud %i1 pour l'inconnue %m1:4 222 : C SEGACT MYMINC 223 : C SEGACT MYPTS 224 : C N2=IDMAT.NUNA(ITTDDL) 224 : C CALL DDL2PI(N2,MYMINC, 225 : C $ IPT,IBI, 226 : C $ IMPR,IRET) 227 : C IF (IRET.NE.0) GOTO 9999 228 : C INTERR(1)=MYPTS.NUM(1,IPT) 229 : C MOTERR(1:8)=MYMINC.LISINC(IBI) 229 : C CALL ERREUR(143) 230 : C SEGDES MYPTS 231 : C SEGDES MYMINC 232 : C GOTO 9999 233 : C ENDIF 234 : GGIS.PROG(ITTDDL)=(TNORM/DBLE(ISTOP-ISTRT+1))*YZPREC 235 : 152 CONTINUE 236 : NBVD=KZA(/1) 237 : SEGINI IZD 238 : IDMAT.IDIAG=IZD 239 : ISAU=0 240 : DO 601 IBLK=1,NBLK 241 : C NUMÉROS DES LIGNES DE DÉBUT ET DE FIN DE BLOC KJD,KJF 242 : KJD=NLDBLK(IBLK) 243 : KJF=NLDBLK(IBLK+1)-1 244 : KA=0 245 : KA=KA+KZA(1)-1 246 : NUIA(1,1)=1 247 : DO 600 KJ=KJD,KJF 248 : NUIA(KJ,1)=IBLK 249 : NUIA(KJ,2)=KA 250 : KA=KA+KZA(KJ)-1 251 : 600 CONTINUE 252 : C ALLOCATION DE LA MÉMOIRE POUR LE BLOC 253 : NBVA=KA 254 : * WRITE(IOIMP,*) '* BLOC LOWER NUMERO : ',IBLK,' TAILLE = ' 255 : * $ ,NBVA,' MOTS' 256 : SEGINI IZA 257 : IDESCL(IBLK)=IZA 258 : IDESCU(IBLK)=IZA 259 : IF(KSIM.EQ.2)IDESCU(IBLK)=NBVA 260 : IF(IBLK.EQ.1)THEN 261 : KJD=1 262 : D(1)=AISA.A(1) 263 : ENDIF 264 : DO 602 LI=KJD,KJF 265 : NBK=AMORS.IA(LI+1)-AMORS.IA(LI) 266 : I1=AMORS.IA(LI) 267 : DO 603 K=1,NBK 268 : MA=I1+K-1 269 : KO=AMORS.JA(MA) 270 : IF(LI.GT.KO)THEN 271 : NA=KO-LI+KZA(LI)+NUIA(LI,2) 272 : A(NA)=AISA.A(MA) 273 : ELSEIF(LI.EQ.KO.AND.LI.NE.1)THEN 274 : D(LI)=AISA.A(MA) 275 : ELSE 276 : GO TO 602 277 : ENDIF 278 : 603 CONTINUE 279 : 602 CONTINUE 280 : SEGDES IZA 281 : 601 CONTINUE 282 : IF(KSIM.EQ.2)THEN 283 : DO 604 IBLK=1,NBLK 284 : KJD=NLDBLK(IBLK) 285 : KJF=NLDBLK(IBLK+1)-1 286 : NBVA=IDESCU(IBLK) 287 : SEGINI IZA 288 : IDESCU(IBLK)=IZA 289 : IF(IBLK.EQ.1)THEN 290 : KJD=1 291 : ENDIF 292 : LDEB=KJD 293 : DO 605 KO=KJD,KJF 294 : L0=KO-KZA(KO)+1 295 : IF(LDEB.GT.L0)LDEB=L0 296 : 605 CONTINUE 297 : DO 606 LI=LDEB,KJF 298 : NBK=AMORS.IA(LI+1)-AMORS.IA(LI) 299 : I1=AMORS.IA(LI) 300 : DO 607 K=NBK,1,-1 301 : MA=I1+K-1 302 : KO=AMORS.JA(MA) 303 : IF(KO.GT.KJF)GO TO 607 304 : IF(KO.LT.KJD)GO TO 606 305 : IF(LI.LT.KO)THEN 306 : NA=LI-KO+KZA(KO)+NUIA(KO,2) 307 : A(NA)=AISA.A(MA) 308 : ELSE 309 : GO TO 606 310 : ENDIF 311 : 607 CONTINUE 312 : 606 CONTINUE 313 : SEGDES IZA 314 : 604 CONTINUE 315 : ENDIF 316 : SEGDES AISA 317 : SEGDES AMORS 317 : *STAT CALL PRMSTA('Remplissage des blocs',MSTAT,1) 318 : IF(KSIM.EQ.0.OR.KSIM.EQ.2)THEN 319 : DO 200 IBLK=1,NBLK 320 : KJD=NLDBLK(IBLK) 321 : KJF=NLDBLK(IBLK+1)-1 322 : ISAU=IDESCU(IBLK) 323 : ISAL=IDESCL(IBLK) 324 : SEGACT ISAU*MOD 325 : SEGACT ISAL*MOD 326 : IF(IBLK.NE.1)THEN 327 : ISAL0=0 328 : ISAU0=0 329 : C SEGACT ISAL0 330 : C SEGACT ISAU0 331 : ISAL00=0 332 : ISAU00=0 333 : LACTL=.FALSE. 334 : LACTU=.FALSE. 335 : KJD0=KJD-KZA(KJD)+1 336 : DO 304 I=KJD+1,KJF 337 : KLD=I-KZA(I)+1 338 : IF(KLD.LT.KJD0)KJD0=KLD 339 : 304 CONTINUE 340 : DO 302 I=KJD0,KJD-1 341 : LDEB=I-KZA(I)+1 342 : DO 301 N=KJD,KJF 343 : KDEB=N-KZA(N)+1 344 : IF(KDEB.LE.I) THEN 345 : C Calcul colonne n 346 : K1=MAX(KDEB,LDEB) 347 : LG=I-K1 348 : KL=NUIA(I,2)+K1-LDEB+1 349 : KU=NUIA(N,2)+K1-KDEB+1 350 : ISAL00=IDESCL(NUIA(I,1)) 351 : LACTL=(ISAL00.NE.ISAL0.AND.ISAL00.NE.ISAL) 352 : IF (LACTL) THEN 353 : IF (ISAL0.NE.0) THEN 354 : SEGDES ISAL0 355 : ENDIF 356 : SEGACT ISAL00 357 : ENDIF 358 : ISAL0=ISAL00 359 : * US=SDOT(LG,ISAL00.A(KL),1,ISAU.A(KU),1) 360 : US=0.D0 361 : DO ILG=0,LG-1 362 : US=US+ISAL00.A(KL+ILG)*ISAU.A(KU+ILG) 363 : ENDDO 364 : KU=NUIA(N,2)+I-KDEB+1 365 : ISAU.A(KU)=(ISAU.A(KU)-US) 366 : C WRITE(IOIMP,*)' KU=',KU,' I=',I,' A(KU)=',ISAU.A(KU) 367 : IF(KSIM.NE.0)THEN 368 : C Calcul ligne n 369 : KU=NUIA(I,2)+K1-LDEB+1 370 : KL=NUIA(N,2)+K1-KDEB+1 371 : ISAU00=IDESCU(NUIA(I,1)) 372 : LACTU=(ISAU00.NE.ISAU0.AND.ISAU00.NE.ISAU) 373 : IF (LACTU) THEN 374 : IF (ISAU0.NE.0) THEN 375 : SEGDES ISAU0 376 : ENDIF 377 : SEGACT ISAU00 378 : ENDIF 379 : ISAU0=ISAU00 380 : * US=SDOT(LG,ISAL.A(KL),1,ISAU00.A(KU),1) 381 : US=0.D0 382 : DO ILG=0,LG-1 383 : US=US+ISAL.A(KL+ILG)*ISAU00.A(KU+ILG) 384 : ENDDO 385 : KL=NUIA(N,2)+I-KDEB+1 386 : ISAL.A(KL)=(ISAL.A(KL)-US) 387 : ENDIF 388 : ENDIF 389 : 301 CONTINUE 390 : 302 CONTINUE 391 : IF (ISAL00.NE.ISAL.AND.ISAL00.NE.0) THEN 392 : SEGDES ISAL00 393 : ENDIF 394 : IF (ISAU00.NE.ISAU.AND.ISAU00.NE.0) THEN 395 : SEGDES ISAU00 396 : ENDIF 397 : ENDIF 398 : DO 202 I=KJD,KJF 399 : LDEB=I-KZA(I)+1 400 : KL=NUIA(I,2) 401 : DO 2011 II=LDEB,I-1 402 : ISAL.A(KL+II-LDEB+1)=ISAL.A(KL+II-LDEB+1)/D(II) 403 : 2011 CONTINUE 404 : IF(KSIM.EQ.2)THEN 405 : KL=NUIA(I,2) 406 : DO 2012 II=LDEB,I-1 407 : ISAU.A(KL+II-LDEB+1)=ISAU.A(KL+II-LDEB+1)/D(II) 408 : 2012 CONTINUE 409 : ENDIF 410 : C Calcul diagonale 411 : N=I 412 : IF(N.NE.1) THEN 413 : LG=N-LDEB 414 : KK=NUIA(N,2)+1 415 : US=0.D0 416 : DO 3003 II=1,LG 417 : US=US+ 418 : $ ISAL.A(KK+II-1) 419 : $ *D(II+LDEB-1)*ISAU.A(KK+II-1) 420 : 3003 CONTINUE 421 : D(N)=D(N)-US 422 : ENDIF 423 : C! DEBUT 424 : ADK=ABS(D(N)) 425 : * WRITE(IOIMP,*) 'N=',N,' ADK=',ADK 426 : IF(ADK.LE.GGIS.PROG(N))THEN 427 : IKOMPT=IKOMPT+1 428 : * 429 : * Désactivation temporaire, sinon des cas-tests (mal conçus !) plantent 430 : * 431 : C Résolution impossible détectée au noeud %i1 pour l'inconnue %m1:4 432 : * INTERR(1)=N 433 : * MOTERR(1: 8) = ' ' 433 : * CALL ERREUR(143) 434 : IF (IKOMPT.EQ.1) THEN 435 : WRITE(IOIMP,*) '!!!!!!!!!!!!! WARNING !!!!!!!!!' 436 : IF (LISDDL) THEN 437 : SEGACT MYMINC 438 : SEGACT MYPTS 439 : DO IDDL=1,MIN(10,NTTDDL) 440 : N2=IDMAT.NUNA(IDDL) 440 : CALL DDL2PI(N2,MYMINC, 441 : $ IPT,IBI, 442 : $ IMPR,IRET) 443 : IF (IRET.NE.0) GOTO 9999 444 : WRITE(IOIMP,*) 'ddl ',IDDL 445 : $ ,' = point numero ',MYPTS.NUM(1,IPT), 446 : $ ' inconnue ',MYMINC.LISINC(IBI) 447 : ENDDO 448 : SEGDES MYPTS 449 : SEGDES MYMINC 450 : ENDIF 451 : ENDIF 452 : IF (IKOMPT.LE.10.OR.ADK.EQ.0.D0) THEN 453 : WRITE(IOIMP,*) 'Au ddl ',N,'le pivot vaut ',ADK, 454 : $ ' ; norme de la ligne =',GGIS.PROG(N) 455 : $ /YZPREC 456 : IF (LISDDL) THEN 457 : N2=IDMAT.NUNA(N) 457 : CALL DDL2PI(N2,MYMINC, 458 : $ IPT,IBI, 459 : $ IMPR,IRET) 460 : IF (IRET.NE.0) GOTO 9999 461 : SEGACT MYMINC 462 : SEGACT MYPTS 463 : IF (ADK.EQ.0.D0) THEN 464 : INTERR(1)=MYPTS.NUM(1,IPT) 465 : MOTERR(1:8)=MYMINC.LISINC(IBI) 465 : CALL ERREUR(143) 466 : GOTO 9999 467 : ELSE 468 : WRITE(IOIMP,*) 'ddl ',N,' = point numero ' 469 : $ ,MYPTS.NUM(1,IPT),' inconnue ',MYMINC 470 : $ .LISINC(IBI) 471 : ENDIF 472 : SEGDES MYPTS 473 : SEGDES MYMINC 474 : ELSE 475 : IF (ADK.EQ.0.D0) THEN 476 : INTERR(1)=N 477 : * 49 2 478 : *Matrice singulière. Numéro de ligne =%i1 478 : CALL ERREUR(49) 479 : GOTO 9999 480 : ENDIF 481 : ENDIF 482 : IF (ADK.EQ.0.D0) RETURN 483 : ELSE IF (IKOMPT.EQ.11) THEN 484 : WRITE(IOIMP,*) 'Plus de 10 pivots petits' 485 : ELSE 486 : * Temporairement désactivé pour cause de mauvais cas-tests : difasyk2Dax.dgibi 487 : * GOTO 9999 488 : ENDIF 489 : D(N)=GGIS.PROG(N) 490 : * D(N)=1.D-200 491 : ENDIF 492 : C! FIN 493 : I1=I+1 494 : DO 201 N=I1,KJF 495 : KDEB=N-KZA(N)+1 496 : IF(KDEB.LE.I) THEN 497 : C Calcul colonne n 498 : K1=MAX(KDEB,LDEB) 499 : LG=I-K1 500 : KL=NUIA(I,2)+K1-LDEB+1 501 : KU=NUIA(N,2)+K1-KDEB+1 502 : * US=SDOT(LG,ISAL.A(KL),1,ISAU.A(KU),1) 503 : US=0.D0 504 : DO ILG=0,LG-1 505 : US=US+ISAL.A(KL+ILG)*ISAU.A(KU+ILG) 506 : ENDDO 507 : * 508 : KU=NUIA(N,2)+I-KDEB+1 509 : ISAU.A(KU)=(ISAU.A(KU)-US) 510 : IF(KSIM.NE.0) THEN 511 : C Calcul ligne n 512 : KU=NUIA(I,2)+K1-LDEB+1 513 : KL=NUIA(N,2)+K1-KDEB+1 514 : * US=SDOT(LG,ISAL.A(KL),1,ISAU.A(KU),1) 515 : US=0.D0 516 : DO ILG=0,LG-1 517 : US=US+ISAL.A(KL+ILG)*ISAU.A(KU+ILG) 518 : ENDDO 519 : * 520 : KL=NUIA(N,2)+I-KDEB+1 521 : ISAL.A(KL)=(ISAL.A(KL)-US) 522 : ENDIF 523 : ENDIF 524 : 201 CONTINUE 525 : 202 CONTINUE 526 : SEGDES ISAL 527 : SEGDES ISAU 528 : 200 CONTINUE 529 : SEGSUP GGIS 530 : ELSE 531 : WRITE(IOIMP,*)' TRIALU : KSIM=',KSIM,' Cas non prevu ' 532 : GOTO 9999 533 : ENDIF 533 : *STAT CALL PRMSTA('Triangulation',MSTAT,1) 534 : SEGDES IZD 535 : SEGDES IDMAT 536 : ENDIF 537 : * 538 : * Normal termination 539 : * 540 : IRET=0 541 : RETURN 542 : * 543 : * Format handling 544 : * 545 : * 546 : * Error handling 547 : * 548 : 9999 CONTINUE 549 : IRET=1 550 : WRITE(IOIMP,*) 'An error was detected in subroutine trialu.eso' 551 : RETURN 552 : * 553 : * End of subroutine TRIALU 554 : * 555 : END 556 : 557 : 558 : 559 : 560 : 561 : 562 : 563 : 564 : 565 : 566 : 567 : 568 : 569 : 570 : 571 : 572 : 573 : 574 : 575 :
© Cast3M 2003 - All rights reserved.
Disclaimer