Annotation of rpl/src/instructions_q1.c, revision 1.1

1.1     ! bertrand    1: /*
        !             2: ================================================================================
        !             3:   RPL/2 (R) version 4.0.9
        !             4:   Copyright (C) 1989-2010 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 'qr'
        !            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_qr(struct_processus *s_etat_processus)
        !            40: {
        !            41:    complex16                   registre;
        !            42:    complex16                   *tau_complexe;
        !            43:    complex16                   *vecteur_complexe;
        !            44: 
        !            45:    real8                       *tau_reel;
        !            46:    real8                       *vecteur_reel;
        !            47: 
        !            48:    struct_liste_chainee        *registre_pile_last;
        !            49: 
        !            50:    struct_objet                *s_copie_argument;
        !            51:    struct_objet                *s_matrice_identite;
        !            52:    struct_objet                *s_objet;
        !            53:    struct_objet                *s_objet_argument;
        !            54:    struct_objet                *s_objet_resultat;
        !            55: 
        !            56:    unsigned long               i;
        !            57:    unsigned long               j;
        !            58:    unsigned long               k;
        !            59:    unsigned long               nombre_reflecteurs_elementaires;
        !            60: 
        !            61:    void                        *tau;
        !            62: 
        !            63:    (*s_etat_processus).erreur_execution = d_ex;
        !            64: 
        !            65:    if ((*s_etat_processus).affichage_arguments == 'Y')
        !            66:    {
        !            67:        printf("\n  QR ");
        !            68:        
        !            69:        if ((*s_etat_processus).langue == 'F')
        !            70:        {
        !            71:            printf("(décomposition QR)\n\n");
        !            72:        }
        !            73:        else
        !            74:        {
        !            75:            printf("(QR décomposition)\n\n");
        !            76:        }
        !            77: 
        !            78:        printf("    1: %s, %s\n", d_MIN, d_MRL);
        !            79:        printf("->  2: %s\n", d_MRL);
        !            80:        printf("    1: %s\n\n", d_MRL);
        !            81: 
        !            82:        printf("    1: %s\n", d_MCX);
        !            83:        printf("->  2: %s\n", d_MCX);
        !            84:        printf("    1: %s\n", d_MCX);
        !            85: 
        !            86:        return;
        !            87:    }
        !            88:    else if ((*s_etat_processus).test_instruction == 'Y')
        !            89:    {
        !            90:        (*s_etat_processus).nombre_arguments = -1;
        !            91:        return;
        !            92:    }
        !            93: 
        !            94:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
        !            95:    {
        !            96:        if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
        !            97:        {
        !            98:            return;
        !            99:        }
        !           100:    }
        !           101: 
        !           102:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
        !           103:            &s_objet_argument) == d_erreur)
        !           104:    {
        !           105:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
        !           106:        return;
        !           107:    }
        !           108: 
        !           109:    if (((*s_objet_argument).type == MIN) ||
        !           110:            ((*s_objet_argument).type == MRL))
        !           111:    {
        !           112:        /*
        !           113:         * Matrice entière ou réelle
        !           114:         */
        !           115: 
        !           116:        if ((s_copie_argument = copie_objet(s_etat_processus,
        !           117:                s_objet_argument, 'Q')) == NULL)
        !           118:        {
        !           119:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
        !           120:            return;
        !           121:        }
        !           122: 
        !           123:        factorisation_qr(s_etat_processus, (*s_copie_argument).objet, &tau);
        !           124:        (*s_copie_argument).type = MRL;
        !           125: 
        !           126:        tau_reel = (real8 *) tau;
        !           127: 
        !           128:        if ((*s_etat_processus).erreur_systeme != d_es)
        !           129:        {
        !           130:            return;
        !           131:        }
        !           132: 
        !           133:        if (((*s_etat_processus).exception != d_ep) ||
        !           134:                ((*s_etat_processus).erreur_execution != d_ex))
        !           135:        {
        !           136:            free(tau);
        !           137:            liberation(s_etat_processus, s_objet_argument);
        !           138:            liberation(s_etat_processus, s_copie_argument);
        !           139:            return;
        !           140:        }
        !           141: 
        !           142:        if ((s_objet_resultat = copie_objet(s_etat_processus,
        !           143:                s_copie_argument, 'O')) == NULL)
        !           144:        {
        !           145:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
        !           146:            return;
        !           147:        }
        !           148: 
        !           149:        // Matrice Q
        !           150: 
        !           151:        nombre_reflecteurs_elementaires = ((*((struct_matrice *)
        !           152:                (*s_copie_argument).objet)).nombre_colonnes <
        !           153:                (*((struct_matrice *) (*s_copie_argument).objet))
        !           154:                .nombre_lignes) ? (*((struct_matrice *)
        !           155:                (*s_copie_argument).objet)).nombre_colonnes
        !           156:                : (*((struct_matrice *) (*s_copie_argument).objet))
        !           157:                .nombre_lignes;
        !           158: 
        !           159:        registre_pile_last = NULL;
        !           160: 
        !           161:        if (test_cfsf(s_etat_processus, 31) == d_vrai)
        !           162:        {
        !           163:            registre_pile_last = (*s_etat_processus).l_base_pile_last;
        !           164:            (*s_etat_processus).l_base_pile_last = NULL;
        !           165:        }
        !           166: 
        !           167:        if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
        !           168:        {
        !           169:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
        !           170:            return;
        !           171:        }
        !           172: 
        !           173:        (*((integer8 *) (*s_objet).objet)) = (*((struct_matrice *)
        !           174:                (*s_copie_argument).objet)).nombre_lignes;
        !           175: 
        !           176:        if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
        !           177:                s_objet) == d_erreur)
        !           178:        {
        !           179:            return;
        !           180:        }
        !           181: 
        !           182:        instruction_idn(s_etat_processus);
        !           183: 
        !           184:        if (((*s_etat_processus).erreur_systeme != d_es) ||
        !           185:                ((*s_etat_processus).erreur_execution != d_ex) ||
        !           186:                ((*s_etat_processus).exception != d_ep))
        !           187:        {
        !           188:            liberation(s_etat_processus, s_copie_argument);
        !           189:            free(tau);
        !           190: 
        !           191:            if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
        !           192:            {
        !           193:                return;
        !           194:            }
        !           195: 
        !           196:            (*s_etat_processus).l_base_pile_last = registre_pile_last;
        !           197:            return;
        !           198:        }
        !           199: 
        !           200:        if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
        !           201:                &s_matrice_identite) == d_erreur)
        !           202:        {
        !           203:            (*s_etat_processus).erreur_execution = d_ex_manque_argument;
        !           204:            return;
        !           205:        }
        !           206: 
        !           207:        for(i = 0; i < nombre_reflecteurs_elementaires; i++)
        !           208:        {
        !           209:            // Calcul de H(i) = I - tau * v * v'
        !           210: 
        !           211:            if ((s_objet = copie_objet(s_etat_processus, s_matrice_identite,
        !           212:                    'P')) == NULL)
        !           213:            {
        !           214:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
        !           215:                return;
        !           216:            }
        !           217: 
        !           218:            if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
        !           219:                    s_objet) == d_erreur)
        !           220:            {
        !           221:                return;
        !           222:            }
        !           223: 
        !           224:            if ((s_objet = allocation(s_etat_processus, REL)) == NULL)
        !           225:            {
        !           226:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
        !           227:                return;
        !           228:            }
        !           229: 
        !           230:            (*((real8 *) (*s_objet).objet)) = tau_reel[i];
        !           231: 
        !           232:            if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
        !           233:                    s_objet) == d_erreur)
        !           234:            {
        !           235:                return;
        !           236:            }
        !           237: 
        !           238:            if ((s_objet = allocation(s_etat_processus, MRL)) == NULL)
        !           239:            {
        !           240:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
        !           241:                return;
        !           242:            }
        !           243: 
        !           244:            (*((struct_matrice *) (*s_objet).objet)).nombre_lignes =
        !           245:                    (*((struct_matrice *) (*s_copie_argument).objet))
        !           246:                    .nombre_lignes;
        !           247:            (*((struct_matrice *) (*s_objet).objet)).nombre_colonnes =
        !           248:                    (*((struct_matrice *) (*s_copie_argument).objet))
        !           249:                    .nombre_lignes;
        !           250: 
        !           251:            if ((vecteur_reel = malloc((*((struct_matrice *) (*s_objet).objet))
        !           252:                    .nombre_lignes * sizeof(real8))) == NULL)
        !           253:            {
        !           254:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
        !           255:                return;
        !           256:            }
        !           257: 
        !           258:            for(j = 0; j < (*((struct_matrice *) (*s_objet).objet))
        !           259:                    .nombre_lignes; j++)
        !           260:            {
        !           261:                if (j < i)
        !           262:                {
        !           263:                    vecteur_reel[j] = 0;
        !           264:                }
        !           265:                else if (j == i)
        !           266:                {
        !           267:                    vecteur_reel[j] = 1;
        !           268:                }
        !           269:                else
        !           270:                {
        !           271:                    vecteur_reel[j] = ((real8 **) (*((struct_matrice *)
        !           272:                            (*s_copie_argument).objet)).tableau)[j][i];
        !           273:                }
        !           274:            }
        !           275: 
        !           276:            if (((*((struct_matrice *) (*s_objet).objet)).tableau =
        !           277:                    malloc((*((struct_matrice *) (*s_objet).objet))
        !           278:                    .nombre_lignes * sizeof(real8 *))) == NULL)
        !           279:            {
        !           280:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
        !           281:                return;
        !           282:            }
        !           283: 
        !           284:            for(j = 0; j < (*((struct_matrice *) (*s_objet).objet))
        !           285:                    .nombre_lignes; j++)
        !           286:            {
        !           287:                if ((((real8 **) (*((struct_matrice *) (*s_objet).objet))
        !           288:                        .tableau)[j] = malloc((*((struct_matrice *) (*s_objet)
        !           289:                        .objet)).nombre_lignes * sizeof(real8))) == NULL)
        !           290:                {
        !           291:                    (*s_etat_processus).erreur_systeme =
        !           292:                            d_es_allocation_memoire;
        !           293:                    return;
        !           294:                }
        !           295: 
        !           296:                for(k = 0; k < (*((struct_matrice *) (*s_objet).objet))
        !           297:                        .nombre_colonnes; k++)
        !           298:                {
        !           299:                    ((real8 **) (*((struct_matrice *) (*s_objet).objet))
        !           300:                            .tableau)[j][k] = vecteur_reel[j] * vecteur_reel[k];
        !           301:                }
        !           302:            }
        !           303: 
        !           304:            free(vecteur_reel);
        !           305: 
        !           306:            if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
        !           307:                    s_objet) == d_erreur)
        !           308:            {
        !           309:                return;
        !           310:            }
        !           311: 
        !           312:            instruction_multiplication(s_etat_processus);
        !           313: 
        !           314:            if (((*s_etat_processus).erreur_systeme != d_es) ||
        !           315:                    ((*s_etat_processus).erreur_execution != d_ex) ||
        !           316:                    ((*s_etat_processus).exception != d_ep))
        !           317:            {
        !           318:                liberation(s_etat_processus, s_copie_argument);
        !           319:                liberation(s_etat_processus, s_matrice_identite);
        !           320:                free(tau);
        !           321: 
        !           322:                if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
        !           323:                {
        !           324:                    return;
        !           325:                }
        !           326: 
        !           327:                (*s_etat_processus).l_base_pile_last = registre_pile_last;
        !           328:                return;
        !           329:            }
        !           330: 
        !           331:            instruction_moins(s_etat_processus);
        !           332: 
        !           333:            if (((*s_etat_processus).erreur_systeme != d_es) ||
        !           334:                    ((*s_etat_processus).erreur_execution != d_ex) ||
        !           335:                    ((*s_etat_processus).exception != d_ep))
        !           336:            {
        !           337:                liberation(s_etat_processus, s_copie_argument);
        !           338:                liberation(s_etat_processus, s_matrice_identite);
        !           339:                free(tau);
        !           340: 
        !           341:                if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
        !           342:                {
        !           343:                    return;
        !           344:                }
        !           345: 
        !           346:                (*s_etat_processus).l_base_pile_last = registre_pile_last;
        !           347:                return;
        !           348:            }
        !           349: 
        !           350:            if (i > 0)
        !           351:            {
        !           352:                instruction_multiplication(s_etat_processus);
        !           353: 
        !           354:                if (((*s_etat_processus).erreur_systeme != d_es) ||
        !           355:                        ((*s_etat_processus).erreur_execution != d_ex) ||
        !           356:                        ((*s_etat_processus).exception != d_ep))
        !           357:                {
        !           358:                    liberation(s_etat_processus, s_copie_argument);
        !           359:                    liberation(s_etat_processus, s_matrice_identite);
        !           360:                    free(tau);
        !           361: 
        !           362:                    if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
        !           363:                    {
        !           364:                        return;
        !           365:                    }
        !           366: 
        !           367:                    (*s_etat_processus).l_base_pile_last = registre_pile_last;
        !           368:                    return;
        !           369:                }
        !           370:            }
        !           371:        }
        !           372: 
        !           373:        if (test_cfsf(s_etat_processus, 31) == d_vrai)
        !           374:        {
        !           375:            if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
        !           376:            {
        !           377:                return;
        !           378:            }
        !           379: 
        !           380:            (*s_etat_processus).l_base_pile_last = registre_pile_last;
        !           381:        }
        !           382: 
        !           383:        // Matrice R
        !           384: 
        !           385:        for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
        !           386:                .nombre_lignes; i++)
        !           387:        {
        !           388:            for(j = 0; j < i; j++)
        !           389:            {
        !           390:                ((real8 **) (*((struct_matrice *) (*s_objet_resultat).objet))
        !           391:                        .tableau)[i][j] = 0;
        !           392:            }
        !           393:        }
        !           394: 
        !           395:        if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
        !           396:                s_objet_resultat) == d_erreur)
        !           397:        {
        !           398:            return;
        !           399:        }
        !           400: 
        !           401:        liberation(s_etat_processus, s_matrice_identite);
        !           402:        liberation(s_etat_processus, s_copie_argument);
        !           403:        free(tau);
        !           404:    }
        !           405:    else if ((*s_objet_argument).type == MCX)
        !           406:    {
        !           407:        /*
        !           408:         * Matrice complexe
        !           409:         */
        !           410: 
        !           411:        if ((s_copie_argument = copie_objet(s_etat_processus,
        !           412:                s_objet_argument, 'Q')) == NULL)
        !           413:        {
        !           414:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
        !           415:            return;
        !           416:        }
        !           417: 
        !           418:        factorisation_qr(s_etat_processus, (*s_copie_argument).objet, &tau);
        !           419: 
        !           420:        tau_complexe = (complex16 *) tau;
        !           421: 
        !           422:        if ((*s_etat_processus).erreur_systeme != d_es)
        !           423:        {
        !           424:            return;
        !           425:        }
        !           426: 
        !           427:        if (((*s_etat_processus).exception != d_ep) ||
        !           428:                ((*s_etat_processus).erreur_execution != d_ex))
        !           429:        {
        !           430:            free(tau);
        !           431:            liberation(s_etat_processus, s_objet_argument);
        !           432:            liberation(s_etat_processus, s_copie_argument);
        !           433:            return;
        !           434:        }
        !           435: 
        !           436:        if ((s_objet_resultat = copie_objet(s_etat_processus,
        !           437:                s_copie_argument, 'O')) == NULL)
        !           438:        {
        !           439:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
        !           440:            return;
        !           441:        }
        !           442: 
        !           443:        // Matrice Q
        !           444: 
        !           445:        nombre_reflecteurs_elementaires = ((*((struct_matrice *)
        !           446:                (*s_copie_argument).objet)).nombre_colonnes <
        !           447:                (*((struct_matrice *) (*s_copie_argument).objet))
        !           448:                .nombre_lignes) ? (*((struct_matrice *)
        !           449:                (*s_copie_argument).objet)).nombre_colonnes
        !           450:                : (*((struct_matrice *) (*s_copie_argument).objet))
        !           451:                .nombre_lignes;
        !           452: 
        !           453:        registre_pile_last = NULL;
        !           454: 
        !           455:        if (test_cfsf(s_etat_processus, 31) == d_vrai)
        !           456:        {
        !           457:            registre_pile_last = (*s_etat_processus).l_base_pile_last;
        !           458:            (*s_etat_processus).l_base_pile_last = NULL;
        !           459:        }
        !           460: 
        !           461:        if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
        !           462:        {
        !           463:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
        !           464:            return;
        !           465:        }
        !           466: 
        !           467:        (*((integer8 *) (*s_objet).objet)) = (*((struct_matrice *)
        !           468:                (*s_copie_argument).objet)).nombre_lignes;
        !           469: 
        !           470:        if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
        !           471:                s_objet) == d_erreur)
        !           472:        {
        !           473:            return;
        !           474:        }
        !           475: 
        !           476:        instruction_idn(s_etat_processus);
        !           477: 
        !           478:        if (((*s_etat_processus).erreur_systeme != d_es) ||
        !           479:                ((*s_etat_processus).erreur_execution != d_ex) ||
        !           480:                ((*s_etat_processus).exception != d_ep))
        !           481:        {
        !           482:            liberation(s_etat_processus, s_copie_argument);
        !           483:            free(tau);
        !           484: 
        !           485:            if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
        !           486:            {
        !           487:                return;
        !           488:            }
        !           489: 
        !           490:            (*s_etat_processus).l_base_pile_last = registre_pile_last;
        !           491:            return;
        !           492:        }
        !           493: 
        !           494:        if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
        !           495:                &s_matrice_identite) == d_erreur)
        !           496:        {
        !           497:            (*s_etat_processus).erreur_execution = d_ex_manque_argument;
        !           498:            return;
        !           499:        }
        !           500: 
        !           501:        for(i = 0; i < nombre_reflecteurs_elementaires; i++)
        !           502:        {
        !           503:            // Calcul de H(i) = I - tau * v * v'
        !           504: 
        !           505:            if ((s_objet = copie_objet(s_etat_processus, s_matrice_identite,
        !           506:                    'P')) == NULL)
        !           507:            {
        !           508:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
        !           509:                return;
        !           510:            }
        !           511: 
        !           512:            if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
        !           513:                    s_objet) == d_erreur)
        !           514:            {
        !           515:                return;
        !           516:            }
        !           517: 
        !           518:            if ((s_objet = allocation(s_etat_processus, CPL)) == NULL)
        !           519:            {
        !           520:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
        !           521:                return;
        !           522:            }
        !           523: 
        !           524:            (*((complex16 *) (*s_objet).objet)) = tau_complexe[i];
        !           525: 
        !           526:            if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
        !           527:                    s_objet) == d_erreur)
        !           528:            {
        !           529:                return;
        !           530:            }
        !           531: 
        !           532:            if ((s_objet = allocation(s_etat_processus, MCX)) == NULL)
        !           533:            {
        !           534:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
        !           535:                return;
        !           536:            }
        !           537: 
        !           538:            (*((struct_matrice *) (*s_objet).objet)).nombre_lignes =
        !           539:                    (*((struct_matrice *) (*s_copie_argument).objet))
        !           540:                    .nombre_lignes;
        !           541:            (*((struct_matrice *) (*s_objet).objet)).nombre_colonnes =
        !           542:                    (*((struct_matrice *) (*s_copie_argument).objet))
        !           543:                    .nombre_lignes;
        !           544: 
        !           545:            if ((vecteur_complexe = malloc((*((struct_matrice *)
        !           546:                    (*s_objet).objet)).nombre_lignes * sizeof(complex16)))
        !           547:                    == NULL)
        !           548:            {
        !           549:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
        !           550:                return;
        !           551:            }
        !           552: 
        !           553:            for(j = 0; j < (*((struct_matrice *) (*s_objet).objet))
        !           554:                    .nombre_lignes; j++)
        !           555:            {
        !           556:                if (j < i)
        !           557:                {
        !           558:                    vecteur_complexe[j].partie_reelle = 0;
        !           559:                    vecteur_complexe[j].partie_imaginaire = 0;
        !           560:                }
        !           561:                else if (j == i)
        !           562:                {
        !           563:                    vecteur_complexe[j].partie_reelle = 1;
        !           564:                    vecteur_complexe[j].partie_imaginaire = 0;
        !           565:                }
        !           566:                else
        !           567:                {
        !           568:                    vecteur_complexe[j].partie_reelle = ((complex16 **)
        !           569:                            (*((struct_matrice *) (*s_copie_argument).objet))
        !           570:                            .tableau)[j][i].partie_reelle;
        !           571:                    vecteur_complexe[j].partie_imaginaire = ((complex16 **)
        !           572:                            (*((struct_matrice *) (*s_copie_argument).objet))
        !           573:                            .tableau)[j][i].partie_imaginaire;
        !           574:                }
        !           575:            }
        !           576: 
        !           577:            if (((*((struct_matrice *) (*s_objet).objet)).tableau =
        !           578:                    malloc((*((struct_matrice *) (*s_objet).objet))
        !           579:                    .nombre_lignes * sizeof(complex16 *))) == NULL)
        !           580:            {
        !           581:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
        !           582:                return;
        !           583:            }
        !           584: 
        !           585:            for(j = 0; j < (*((struct_matrice *) (*s_objet).objet))
        !           586:                    .nombre_lignes; j++)
        !           587:            {
        !           588:                if ((((complex16 **) (*((struct_matrice *) (*s_objet).objet))
        !           589:                        .tableau)[j] = malloc((*((struct_matrice *) (*s_objet)
        !           590:                        .objet)).nombre_lignes * sizeof(complex16))) == NULL)
        !           591:                {
        !           592:                    (*s_etat_processus).erreur_systeme =
        !           593:                            d_es_allocation_memoire;
        !           594:                    return;
        !           595:                }
        !           596: 
        !           597:                for(k = 0; k < (*((struct_matrice *) (*s_objet).objet))
        !           598:                        .nombre_colonnes; k++)
        !           599:                {
        !           600:                    registre = vecteur_complexe[k];
        !           601:                    registre.partie_imaginaire =
        !           602:                            -vecteur_complexe[k].partie_imaginaire;
        !           603: 
        !           604:                    f77multiplicationcc_(&(vecteur_complexe[j]),
        !           605:                            &registre, &(((complex16 **)
        !           606:                            (*((struct_matrice *) (*s_objet).objet)).tableau)
        !           607:                            [j][k]));
        !           608:                }
        !           609:            }
        !           610: 
        !           611:            free(vecteur_complexe);
        !           612: 
        !           613:            if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
        !           614:                    s_objet) == d_erreur)
        !           615:            {
        !           616:                return;
        !           617:            }
        !           618: 
        !           619:            instruction_multiplication(s_etat_processus);
        !           620: 
        !           621:            if (((*s_etat_processus).erreur_systeme != d_es) ||
        !           622:                    ((*s_etat_processus).erreur_execution != d_ex) ||
        !           623:                    ((*s_etat_processus).exception != d_ep))
        !           624:            {
        !           625:                liberation(s_etat_processus, s_copie_argument);
        !           626:                liberation(s_etat_processus, s_matrice_identite);
        !           627:                free(tau);
        !           628: 
        !           629:                if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
        !           630:                {
        !           631:                    return;
        !           632:                }
        !           633: 
        !           634:                (*s_etat_processus).l_base_pile_last = registre_pile_last;
        !           635:                return;
        !           636:            }
        !           637: 
        !           638:            instruction_moins(s_etat_processus);
        !           639: 
        !           640:            if (((*s_etat_processus).erreur_systeme != d_es) ||
        !           641:                    ((*s_etat_processus).erreur_execution != d_ex) ||
        !           642:                    ((*s_etat_processus).exception != d_ep))
        !           643:            {
        !           644:                liberation(s_etat_processus, s_copie_argument);
        !           645:                liberation(s_etat_processus, s_matrice_identite);
        !           646:                free(tau);
        !           647: 
        !           648:                if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
        !           649:                {
        !           650:                    return;
        !           651:                }
        !           652: 
        !           653:                (*s_etat_processus).l_base_pile_last = registre_pile_last;
        !           654:                return;
        !           655:            }
        !           656: 
        !           657:            if (i > 0)
        !           658:            {
        !           659:                instruction_multiplication(s_etat_processus);
        !           660: 
        !           661:                if (((*s_etat_processus).erreur_systeme != d_es) ||
        !           662:                        ((*s_etat_processus).erreur_execution != d_ex) ||
        !           663:                        ((*s_etat_processus).exception != d_ep))
        !           664:                {
        !           665:                    liberation(s_etat_processus, s_copie_argument);
        !           666:                    liberation(s_etat_processus, s_matrice_identite);
        !           667:                    free(tau);
        !           668: 
        !           669:                    if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
        !           670:                    {
        !           671:                        return;
        !           672:                    }
        !           673: 
        !           674:                    (*s_etat_processus).l_base_pile_last = registre_pile_last;
        !           675:                    return;
        !           676:                }
        !           677:            }
        !           678:        }
        !           679: 
        !           680:        if (test_cfsf(s_etat_processus, 31) == d_vrai)
        !           681:        {
        !           682:            if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
        !           683:            {
        !           684:                return;
        !           685:            }
        !           686: 
        !           687:            (*s_etat_processus).l_base_pile_last = registre_pile_last;
        !           688:        }
        !           689: 
        !           690:        // Matrice R
        !           691: 
        !           692:        for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
        !           693:                .nombre_lignes; i++)
        !           694:        {
        !           695:            for(j = 0; j < i; j++)
        !           696:            {
        !           697:                ((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
        !           698:                        .objet)).tableau)[i][j].partie_reelle = 0;
        !           699:                ((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
        !           700:                        .objet)).tableau)[i][j].partie_imaginaire = 0;
        !           701:            }
        !           702:        }
        !           703: 
        !           704:        if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
        !           705:                s_objet_resultat) == d_erreur)
        !           706:        {
        !           707:            return;
        !           708:        }
        !           709: 
        !           710:        liberation(s_etat_processus, s_matrice_identite);
        !           711:        liberation(s_etat_processus, s_copie_argument);
        !           712:        free(tau);
        !           713:    }
        !           714: 
        !           715:    /*
        !           716:     * Type d'argument invalide
        !           717:     */
        !           718: 
        !           719:    else
        !           720:    {
        !           721:        liberation(s_etat_processus, s_objet_argument);
        !           722: 
        !           723:        (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
        !           724:        return;
        !           725:    }
        !           726: 
        !           727:    liberation(s_etat_processus, s_objet_argument);
        !           728: 
        !           729:    return;
        !           730: }
        !           731: 
        !           732: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>