![]() ![]() | ![]() |
Passage de la branche 4.1 en branche stable.
1: /* 2: ================================================================================ 3: RPL/2 (R) version 4.1.0 4: Copyright (C) 1989-2011 Dr. BERTRAND Joël 5: 6: This file is part of RPL/2. 7: 8: RPL/2 is free software; you can redistribute it and/or modify it 9: under the terms of the CeCILL V2 License as published by the french 10: CEA, CNRS and INRIA. 11: 12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT 13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License 15: for more details. 16: 17: You should have received a copy of the CeCILL License 18: along with RPL/2. If not, write to info@cecill.info. 19: ================================================================================ 20: */ 21: 22: 23: #include "rpl-conv.h" 24: 25: 26: /* 27: ================================================================================ 28: Fonction 'gegvl' 29: ================================================================================ 30: Entrées : pointeur sur une structure struct_processus 31: -------------------------------------------------------------------------------- 32: Sorties : 33: -------------------------------------------------------------------------------- 34: Effets de bord : néant 35: ================================================================================ 36: */ 37: 38: void 39: instruction_gegvl(struct_processus *s_etat_processus) 40: { 41: struct_objet *s_objet_argument_1; 42: struct_objet *s_objet_argument_2; 43: struct_objet *s_objet_resultat; 44: 45: (*s_etat_processus).erreur_execution = d_ex; 46: 47: if ((*s_etat_processus).affichage_arguments == 'Y') 48: { 49: printf("\n GEGVL "); 50: 51: if ((*s_etat_processus).langue == 'F') 52: { 53: printf("(valeurs propres généralisées)\n\n"); 54: } 55: else 56: { 57: printf("(generalized eigenvalues)\n\n"); 58: } 59: 60: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX); 61: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX); 62: printf("-> 1: %s\n", d_VCX); 63: 64: return; 65: } 66: else if ((*s_etat_processus).test_instruction == 'Y') 67: { 68: (*s_etat_processus).nombre_arguments = -1; 69: return; 70: } 71: 72: if (test_cfsf(s_etat_processus, 31) == d_vrai) 73: { 74: if (empilement_pile_last(s_etat_processus, 2) == d_erreur) 75: { 76: return; 77: } 78: } 79: 80: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 81: &s_objet_argument_1) == d_erreur) 82: { 83: (*s_etat_processus).erreur_execution = d_ex_manque_argument; 84: return; 85: } 86: 87: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 88: &s_objet_argument_2) == d_erreur) 89: { 90: liberation(s_etat_processus, s_objet_argument_1); 91: 92: (*s_etat_processus).erreur_execution = d_ex_manque_argument; 93: return; 94: } 95: 96: /* 97: -------------------------------------------------------------------------------- 98: Les arguments sont des matrices carrées de mêmes dimensions 99: -------------------------------------------------------------------------------- 100: */ 101: 102: if ((((*s_objet_argument_1).type == MIN) || 103: ((*s_objet_argument_1).type == MRL) || 104: ((*s_objet_argument_1).type == MCX)) && 105: (((*s_objet_argument_2).type == MIN) || 106: ((*s_objet_argument_2).type == MRL) || 107: ((*s_objet_argument_2).type == MCX))) 108: { 109: if (((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes 110: != (*((struct_matrice *) (*s_objet_argument_1).objet)) 111: .nombre_colonnes) || ((*((struct_matrice *) 112: (*s_objet_argument_2).objet)).nombre_lignes != 113: (*((struct_matrice *) (*s_objet_argument_2).objet)) 114: .nombre_colonnes) || ((*((struct_matrice *) 115: (*s_objet_argument_1).objet)).nombre_lignes != 116: (*((struct_matrice *) (*s_objet_argument_2).objet)) 117: .nombre_lignes)) 118: { 119: liberation(s_etat_processus, s_objet_argument_1); 120: liberation(s_etat_processus, s_objet_argument_2); 121: 122: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides; 123: return; 124: } 125: 126: if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL) 127: { 128: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 129: return; 130: } 131: 132: valeurs_propres_generalisees(s_etat_processus, 133: (struct_matrice *) (*s_objet_argument_2).objet, 134: (struct_matrice *) (*s_objet_argument_1).objet, 135: (struct_vecteur *) (*s_objet_resultat).objet, 136: NULL, NULL); 137: 138: if ((*s_etat_processus).erreur_systeme != d_ex) 139: { 140: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 141: return; 142: } 143: 144: if (((*s_etat_processus).exception != d_ep) || 145: ((*s_etat_processus).erreur_execution != d_ex)) 146: { 147: liberation(s_etat_processus, s_objet_argument_1); 148: liberation(s_etat_processus, s_objet_argument_2); 149: liberation(s_etat_processus, s_objet_resultat); 150: return; 151: } 152: } 153: 154: /* 155: -------------------------------------------------------------------------------- 156: Type incompatible 157: -------------------------------------------------------------------------------- 158: */ 159: 160: else 161: { 162: liberation(s_etat_processus, s_objet_argument_1); 163: liberation(s_etat_processus, s_objet_argument_2); 164: 165: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; 166: return; 167: } 168: 169: liberation(s_etat_processus, s_objet_argument_1); 170: liberation(s_etat_processus, s_objet_argument_2); 171: 172: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 173: s_objet_resultat) == d_erreur) 174: { 175: return; 176: } 177: 178: return; 179: } 180: 181: 182: /* 183: ================================================================================ 184: Fonction 'gegv' 185: ================================================================================ 186: Entrées : pointeur sur une structure struct_processus 187: -------------------------------------------------------------------------------- 188: Sorties : 189: -------------------------------------------------------------------------------- 190: Effets de bord : néant 191: ================================================================================ 192: */ 193: 194: void 195: instruction_gegv(struct_processus *s_etat_processus) 196: { 197: struct_objet *s_objet_argument_1; 198: struct_objet *s_objet_argument_2; 199: struct_objet *s_objet_resultat_1; 200: struct_objet *s_objet_resultat_2; 201: struct_objet *s_objet_resultat_3; 202: 203: (*s_etat_processus).erreur_execution = d_ex; 204: 205: if ((*s_etat_processus).affichage_arguments == 'Y') 206: { 207: printf("\n GEGV "); 208: 209: if ((*s_etat_processus).langue == 'F') 210: { 211: printf("(valeurs et vecteurs propres généralisés)\n\n"); 212: } 213: else 214: { 215: printf("(generalized eigenvalues and eigenvectors)\n\n"); 216: } 217: 218: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX); 219: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX); 220: printf("-> 3: %s\n", d_MCX); 221: printf(" 2: %s\n", d_MCX); 222: printf(" 1: %s\n", d_VCX); 223: 224: return; 225: } 226: else if ((*s_etat_processus).test_instruction == 'Y') 227: { 228: (*s_etat_processus).nombre_arguments = -1; 229: return; 230: } 231: 232: if (test_cfsf(s_etat_processus, 31) == d_vrai) 233: { 234: if (empilement_pile_last(s_etat_processus, 2) == d_erreur) 235: { 236: return; 237: } 238: } 239: 240: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 241: &s_objet_argument_1) == d_erreur) 242: { 243: (*s_etat_processus).erreur_execution = d_ex_manque_argument; 244: return; 245: } 246: 247: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 248: &s_objet_argument_2) == d_erreur) 249: { 250: liberation(s_etat_processus, s_objet_argument_1); 251: 252: (*s_etat_processus).erreur_execution = d_ex_manque_argument; 253: return; 254: } 255: 256: /* 257: -------------------------------------------------------------------------------- 258: Les arguments sont des matrices carrées de mêmes dimensions 259: -------------------------------------------------------------------------------- 260: */ 261: 262: if ((((*s_objet_argument_1).type == MIN) || 263: ((*s_objet_argument_1).type == MRL) || 264: ((*s_objet_argument_1).type == MCX)) && 265: (((*s_objet_argument_2).type == MIN) || 266: ((*s_objet_argument_2).type == MRL) || 267: ((*s_objet_argument_2).type == MCX))) 268: { 269: if (((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes 270: != (*((struct_matrice *) (*s_objet_argument_1).objet)) 271: .nombre_colonnes) || ((*((struct_matrice *) 272: (*s_objet_argument_2).objet)).nombre_lignes != 273: (*((struct_matrice *) (*s_objet_argument_2).objet)) 274: .nombre_colonnes) || ((*((struct_matrice *) 275: (*s_objet_argument_1).objet)).nombre_lignes != 276: (*((struct_matrice *) (*s_objet_argument_2).objet)) 277: .nombre_lignes)) 278: { 279: liberation(s_etat_processus, s_objet_argument_1); 280: liberation(s_etat_processus, s_objet_argument_2); 281: 282: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides; 283: return; 284: } 285: 286: if ((s_objet_resultat_1 = allocation(s_etat_processus, VCX)) == NULL) 287: { 288: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 289: return; 290: } 291: 292: if ((s_objet_resultat_2 = allocation(s_etat_processus, MCX)) == NULL) 293: { 294: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 295: return; 296: } 297: 298: if ((s_objet_resultat_3 = allocation(s_etat_processus, MCX)) == NULL) 299: { 300: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 301: return; 302: } 303: 304: valeurs_propres_generalisees(s_etat_processus, 305: (struct_matrice *) (*s_objet_argument_2).objet, 306: (struct_matrice *) (*s_objet_argument_1).objet, 307: (struct_vecteur *) (*s_objet_resultat_1).objet, 308: (struct_matrice *) (*s_objet_resultat_3).objet, 309: (struct_matrice *) (*s_objet_resultat_2).objet); 310: 311: if ((*s_etat_processus).erreur_systeme != d_es) 312: { 313: return; 314: } 315: 316: if (((*s_etat_processus).exception != d_ep) || 317: ((*s_etat_processus).erreur_execution != d_ex)) 318: { 319: liberation(s_etat_processus, s_objet_argument_1); 320: liberation(s_etat_processus, s_objet_argument_2); 321: liberation(s_etat_processus, s_objet_resultat_1); 322: liberation(s_etat_processus, s_objet_resultat_2); 323: liberation(s_etat_processus, s_objet_resultat_3); 324: 325: return; 326: } 327: } 328: 329: /* 330: -------------------------------------------------------------------------------- 331: Type incompatible 332: -------------------------------------------------------------------------------- 333: */ 334: 335: else 336: { 337: liberation(s_etat_processus, s_objet_argument_1); 338: liberation(s_etat_processus, s_objet_argument_2); 339: 340: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; 341: return; 342: } 343: 344: liberation(s_etat_processus, s_objet_argument_1); 345: liberation(s_etat_processus, s_objet_argument_2); 346: 347: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 348: s_objet_resultat_3) == d_erreur) 349: { 350: return; 351: } 352: 353: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 354: s_objet_resultat_2) == d_erreur) 355: { 356: return; 357: } 358: 359: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 360: s_objet_resultat_1) == d_erreur) 361: { 362: return; 363: } 364: 365: return; 366: } 367: 368: 369: /* 370: ================================================================================ 371: Fonction 'glegv' 372: ================================================================================ 373: Entrées : pointeur sur une structure struct_processus 374: -------------------------------------------------------------------------------- 375: Sorties : 376: -------------------------------------------------------------------------------- 377: Effets de bord : néant 378: ================================================================================ 379: */ 380: 381: void 382: instruction_glegv(struct_processus *s_etat_processus) 383: { 384: struct_objet *s_objet_argument_1; 385: struct_objet *s_objet_argument_2; 386: struct_objet *s_objet_resultat_1; 387: struct_objet *s_objet_resultat_2; 388: 389: (*s_etat_processus).erreur_execution = d_ex; 390: 391: if ((*s_etat_processus).affichage_arguments == 'Y') 392: { 393: printf("\n GLEGV "); 394: 395: if ((*s_etat_processus).langue == 'F') 396: { 397: printf("(valeurs et vecteurs propres gauches généralisés)\n\n"); 398: } 399: else 400: { 401: printf("(generalized eigenvalues and left eigenvectors)\n\n"); 402: } 403: 404: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX); 405: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX); 406: printf("-> 2: %s\n", d_MCX); 407: printf(" 1: %s\n", d_VCX); 408: 409: return; 410: } 411: else if ((*s_etat_processus).test_instruction == 'Y') 412: { 413: (*s_etat_processus).nombre_arguments = -1; 414: return; 415: } 416: 417: if (test_cfsf(s_etat_processus, 31) == d_vrai) 418: { 419: if (empilement_pile_last(s_etat_processus, 2) == d_erreur) 420: { 421: return; 422: } 423: } 424: 425: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 426: &s_objet_argument_1) == d_erreur) 427: { 428: (*s_etat_processus).erreur_execution = d_ex_manque_argument; 429: return; 430: } 431: 432: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 433: &s_objet_argument_2) == d_erreur) 434: { 435: liberation(s_etat_processus, s_objet_argument_1); 436: 437: (*s_etat_processus).erreur_execution = d_ex_manque_argument; 438: return; 439: } 440: 441: /* 442: -------------------------------------------------------------------------------- 443: Les arguments sont des matrices carrées de mêmes dimensions 444: -------------------------------------------------------------------------------- 445: */ 446: 447: if ((((*s_objet_argument_1).type == MIN) || 448: ((*s_objet_argument_1).type == MRL) || 449: ((*s_objet_argument_1).type == MCX)) && 450: (((*s_objet_argument_2).type == MIN) || 451: ((*s_objet_argument_2).type == MRL) || 452: ((*s_objet_argument_2).type == MCX))) 453: { 454: if (((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes 455: != (*((struct_matrice *) (*s_objet_argument_1).objet)) 456: .nombre_colonnes) || ((*((struct_matrice *) 457: (*s_objet_argument_2).objet)).nombre_lignes != 458: (*((struct_matrice *) (*s_objet_argument_2).objet)) 459: .nombre_colonnes) || ((*((struct_matrice *) 460: (*s_objet_argument_1).objet)).nombre_lignes != 461: (*((struct_matrice *) (*s_objet_argument_2).objet)) 462: .nombre_lignes)) 463: { 464: liberation(s_etat_processus, s_objet_argument_1); 465: liberation(s_etat_processus, s_objet_argument_2); 466: 467: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides; 468: return; 469: } 470: 471: if ((s_objet_resultat_1 = allocation(s_etat_processus, VCX)) == NULL) 472: { 473: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 474: return; 475: } 476: 477: if ((s_objet_resultat_2 = allocation(s_etat_processus, MCX)) == NULL) 478: { 479: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 480: return; 481: } 482: 483: valeurs_propres_generalisees(s_etat_processus, 484: (struct_matrice *) (*s_objet_argument_2).objet, 485: (struct_matrice *) (*s_objet_argument_1).objet, 486: (struct_vecteur *) (*s_objet_resultat_1).objet, 487: (struct_matrice *) (*s_objet_resultat_2).objet, 488: NULL); 489: 490: if ((*s_etat_processus).erreur_systeme != d_es) 491: { 492: return; 493: } 494: 495: if (((*s_etat_processus).exception != d_ep) || 496: ((*s_etat_processus).erreur_execution != d_ex)) 497: { 498: liberation(s_etat_processus, s_objet_argument_1); 499: liberation(s_etat_processus, s_objet_argument_2); 500: liberation(s_etat_processus, s_objet_resultat_1); 501: liberation(s_etat_processus, s_objet_resultat_2); 502: 503: return; 504: } 505: } 506: 507: /* 508: -------------------------------------------------------------------------------- 509: Type incompatible 510: -------------------------------------------------------------------------------- 511: */ 512: 513: else 514: { 515: liberation(s_etat_processus, s_objet_argument_1); 516: liberation(s_etat_processus, s_objet_argument_2); 517: 518: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; 519: return; 520: } 521: 522: liberation(s_etat_processus, s_objet_argument_1); 523: liberation(s_etat_processus, s_objet_argument_2); 524: 525: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 526: s_objet_resultat_2) == d_erreur) 527: { 528: return; 529: } 530: 531: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 532: s_objet_resultat_1) == d_erreur) 533: { 534: return; 535: } 536: 537: return; 538: } 539: 540: 541: /* 542: ================================================================================ 543: Fonction 'gregv' 544: ================================================================================ 545: Entrées : pointeur sur une structure struct_processus 546: -------------------------------------------------------------------------------- 547: Sorties : 548: -------------------------------------------------------------------------------- 549: Effets de bord : néant 550: ================================================================================ 551: */ 552: 553: void 554: instruction_gregv(struct_processus *s_etat_processus) 555: { 556: struct_objet *s_objet_argument_1; 557: struct_objet *s_objet_argument_2; 558: struct_objet *s_objet_resultat_1; 559: struct_objet *s_objet_resultat_2; 560: 561: (*s_etat_processus).erreur_execution = d_ex; 562: 563: if ((*s_etat_processus).affichage_arguments == 'Y') 564: { 565: printf("\n GREGV "); 566: 567: if ((*s_etat_processus).langue == 'F') 568: { 569: printf("(valeurs et vecteurs propres droits généralisés)\n\n"); 570: } 571: else 572: { 573: printf("(generalized eigenvalues and right eigenvectors)\n\n"); 574: } 575: 576: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX); 577: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX); 578: printf("-> 2: %s\n", d_MCX); 579: printf(" 1: %s\n", d_VCX); 580: 581: return; 582: } 583: else if ((*s_etat_processus).test_instruction == 'Y') 584: { 585: (*s_etat_processus).nombre_arguments = -1; 586: return; 587: } 588: 589: if (test_cfsf(s_etat_processus, 31) == d_vrai) 590: { 591: if (empilement_pile_last(s_etat_processus, 2) == d_erreur) 592: { 593: return; 594: } 595: } 596: 597: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 598: &s_objet_argument_1) == d_erreur) 599: { 600: (*s_etat_processus).erreur_execution = d_ex_manque_argument; 601: return; 602: } 603: 604: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 605: &s_objet_argument_2) == d_erreur) 606: { 607: liberation(s_etat_processus, s_objet_argument_1); 608: 609: (*s_etat_processus).erreur_execution = d_ex_manque_argument; 610: return; 611: } 612: 613: /* 614: -------------------------------------------------------------------------------- 615: Les arguments sont des matrices carrées de mêmes dimensions 616: -------------------------------------------------------------------------------- 617: */ 618: 619: if ((((*s_objet_argument_1).type == MIN) || 620: ((*s_objet_argument_1).type == MRL) || 621: ((*s_objet_argument_1).type == MCX)) && 622: (((*s_objet_argument_2).type == MIN) || 623: ((*s_objet_argument_2).type == MRL) || 624: ((*s_objet_argument_2).type == MCX))) 625: { 626: if (((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes 627: != (*((struct_matrice *) (*s_objet_argument_1).objet)) 628: .nombre_colonnes) || ((*((struct_matrice *) 629: (*s_objet_argument_2).objet)).nombre_lignes != 630: (*((struct_matrice *) (*s_objet_argument_2).objet)) 631: .nombre_colonnes) || ((*((struct_matrice *) 632: (*s_objet_argument_1).objet)).nombre_lignes != 633: (*((struct_matrice *) (*s_objet_argument_2).objet)) 634: .nombre_lignes)) 635: { 636: liberation(s_etat_processus, s_objet_argument_1); 637: liberation(s_etat_processus, s_objet_argument_2); 638: 639: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides; 640: return; 641: } 642: 643: if ((s_objet_resultat_1 = allocation(s_etat_processus, VCX)) == NULL) 644: { 645: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 646: return; 647: } 648: 649: if ((s_objet_resultat_2 = allocation(s_etat_processus, MCX)) == NULL) 650: { 651: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 652: return; 653: } 654: 655: valeurs_propres_generalisees(s_etat_processus, 656: (struct_matrice *) (*s_objet_argument_2).objet, 657: (struct_matrice *) (*s_objet_argument_1).objet, 658: (struct_vecteur *) (*s_objet_resultat_1).objet, 659: NULL, 660: (struct_matrice *) (*s_objet_resultat_2).objet); 661: 662: if ((*s_etat_processus).erreur_systeme != d_es) 663: { 664: return; 665: } 666: 667: if (((*s_etat_processus).exception != d_ep) || 668: ((*s_etat_processus).erreur_execution != d_ex)) 669: { 670: /* 671: * Problème dans la diagonalisation 672: */ 673: 674: liberation(s_etat_processus, s_objet_argument_1); 675: liberation(s_etat_processus, s_objet_argument_2); 676: liberation(s_etat_processus, s_objet_resultat_1); 677: liberation(s_etat_processus, s_objet_resultat_2); 678: 679: return; 680: } 681: } 682: 683: /* 684: -------------------------------------------------------------------------------- 685: Type incompatible 686: -------------------------------------------------------------------------------- 687: */ 688: 689: else 690: { 691: liberation(s_etat_processus, s_objet_argument_1); 692: liberation(s_etat_processus, s_objet_argument_2); 693: 694: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; 695: return; 696: } 697: 698: liberation(s_etat_processus, s_objet_argument_1); 699: liberation(s_etat_processus, s_objet_argument_2); 700: 701: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 702: s_objet_resultat_2) == d_erreur) 703: { 704: return; 705: } 706: 707: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 708: s_objet_resultat_1) == d_erreur) 709: { 710: return; 711: } 712: 713: return; 714: } 715: 716: // vim: ts=4