File:  [local] / rpl / src / instructions_g3.c
Revision 1.69: download - view: text, annotated - select for diffs - revision graph
Wed Jan 17 16:57:13 2024 UTC (3 months, 1 week ago) by bertrand
Branches: MAIN
CVS tags: HEAD
En route pour la 4.1.36.

    1: /*
    2: ================================================================================
    3:   RPL/2 (R) version 4.1.36
    4:   Copyright (C) 1989-2024 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

CVSweb interface <joel.bertrand@systella.fr>