|
version 1.11, 2010/08/06 15:26:42
|
version 1.74, 2024/01/17 16:57:08
|
|
Line 1
|
Line 1
|
| /*
|
/* |
| ================================================================================
|
================================================================================ |
| RPL/2 (R) version 4.0.18
|
RPL/2 (R) version 4.1.36 |
| Copyright (C) 1989-2010 Dr. BERTRAND Joël
|
Copyright (C) 1989-2024 Dr. BERTRAND Joël |
|
|
|
| This file is part of RPL/2.
|
This file is part of RPL/2. |
|
|
|
| RPL/2 is free software; you can redistribute it and/or modify it
|
RPL/2 is free software; you can redistribute it and/or modify it |
| under the terms of the CeCILL V2 License as published by the french
|
under the terms of the CeCILL V2 License as published by the french |
| CEA, CNRS and INRIA.
|
CEA, CNRS and INRIA. |
|
|
|
| RPL/2 is distributed in the hope that it will be useful, but WITHOUT
|
RPL/2 is distributed in the hope that it will be useful, but WITHOUT |
| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
| FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
|
FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License |
| for more details.
|
for more details. |
|
|
|
| You should have received a copy of the CeCILL License
|
You should have received a copy of the CeCILL License |
| along with RPL/2. If not, write to info@cecill.info.
|
along with RPL/2. If not, write to info@cecill.info. |
| ================================================================================
|
================================================================================ |
| */
|
*/ |
|
|
|
|
|
|
| #include "rpl-conv.h"
|
#include "rpl-conv.h" |
|
|
|
|
|
|
| /*
|
/* |
| ================================================================================
|
================================================================================ |
| Fonction réalisation la factorisation de Schur d'une matrice carrée
|
Fonction réalisation la factorisation de Schur d'une matrice carrée |
| ================================================================================
|
================================================================================ |
| Entrées : struct_matrice
|
Entrées : struct_matrice |
| --------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------- |
| Sorties : décomposition de Schur de la matrice d'entrée et drapeau d'erreur.
|
Sorties : décomposition de Schur de la matrice d'entrée et drapeau d'erreur. |
| La matrice en entrée est écrasée. La matrice de sortie est
|
La matrice en entrée est écrasée. La matrice de sortie est |
| la forme de Schur.
|
la forme de Schur. |
| La routine renvoie aussi une matrice de complexes correspondant
|
La routine renvoie aussi une matrice de complexes correspondant |
| aux vecteurs de Schur. Cette matrice est allouée par
|
aux vecteurs de Schur. Cette matrice est allouée par |
| la routine et vaut NULL sinon.
|
la routine et vaut NULL sinon. |
| --------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------- |
| Effets de bord : néant
|
Effets de bord : néant |
| ================================================================================
|
================================================================================ |
| */
|
*/ |
|
|
|
| void
|
void |
| factorisation_schur(struct_processus *s_etat_processus,
|
factorisation_schur(struct_processus *s_etat_processus, |
| struct_matrice *s_matrice, struct_matrice **s_schur)
|
struct_matrice *s_matrice, struct_matrice **s_schur) |
| {
|
{ |
| complex16 *w;
|
complex16 *w; |
|
|
|
| integer4 info;
|
integer4 info; |
| integer4 lwork;
|
integer4 lwork; |
| integer4 nombre_colonnes_a;
|
integer4 nombre_colonnes_a; |
| integer4 nombre_lignes_a;
|
integer4 nombre_lignes_a; |
| integer4 sdim;
|
integer4 sdim; |
|
|
|
| real8 *rwork;
|
real8 *rwork; |
| real8 *wi;
|
real8 *wi; |
| real8 *wr;
|
real8 *wr; |
|
|
|
| unsigned char calcul_vecteurs_schur;
|
unsigned char calcul_vecteurs_schur; |
| unsigned char tri_vecteurs_schur;
|
unsigned char tri_vecteurs_schur; |
|
|
|
| unsigned long i;
|
integer8 i; |
| unsigned long j;
|
integer8 j; |
| unsigned long k;
|
integer8 k; |
| unsigned long taille_matrice_f77;
|
integer8 taille_matrice_f77; |
|
|
|
| void *matrice_a_f77;
|
void *matrice_a_f77; |
| void *matrice_vs_f77;
|
void *matrice_vs_f77; |
| void *tampon;
|
void *tampon; |
| void *work;
|
void *work; |
|
|
|
| nombre_lignes_a = (integer4) (*s_matrice).nombre_lignes;
|
nombre_lignes_a = (integer4) (*s_matrice).nombre_lignes; |
| nombre_colonnes_a = (integer4) (*s_matrice).nombre_colonnes;
|
nombre_colonnes_a = (integer4) (*s_matrice).nombre_colonnes; |
| taille_matrice_f77 = nombre_lignes_a * nombre_colonnes_a;
|
taille_matrice_f77 = nombre_lignes_a * nombre_colonnes_a; |
|
|
|
| calcul_vecteurs_schur = 'V';
|
calcul_vecteurs_schur = 'V'; |
| tri_vecteurs_schur = 'N';
|
tri_vecteurs_schur = 'N'; |
|
|
|
| switch((*s_matrice).type)
|
switch((*s_matrice).type) |
| {
|
{ |
| case 'I' :
|
case 'I' : |
| {
|
{ |
| /* Conversion de la matrice en matrice réelle */
|
/* Conversion de la matrice en matrice réelle */ |
|
|
|
| for(i = 0; i < (unsigned long) nombre_lignes_a; i++)
|
for(i = 0; i < nombre_lignes_a; i++) |
| {
|
{ |
| tampon = (*s_matrice).tableau[i];
|
tampon = (*s_matrice).tableau[i]; |
|
|
|
| if ((((real8 **) (*s_matrice).tableau)[i] = (real8 *)
|
if ((((real8 **) (*s_matrice).tableau)[i] = (real8 *) |
| malloc(nombre_colonnes_a * sizeof(real8))) == NULL)
|
malloc(((size_t) nombre_colonnes_a) * sizeof(real8))) |
| {
|
== NULL) |
| (*s_etat_processus).erreur_systeme =
|
{ |
| d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = |
| return;
|
d_es_allocation_memoire; |
| }
|
return; |
|
|
} |
| for(j = 0; j < (unsigned long) nombre_colonnes_a; j++)
|
|
| {
|
for(j = 0; j < nombre_colonnes_a; j++) |
| ((real8 **) (*s_matrice).tableau)[i][j] =
|
{ |
| ((integer8 *) tampon)[j];
|
((real8 **) (*s_matrice).tableau)[i][j] = (real8) |
| }
|
((integer8 *) tampon)[j]; |
|
|
} |
| free(tampon);
|
|
| }
|
free(tampon); |
|
|
} |
| (*s_matrice).type = 'R';
|
|
| }
|
(*s_matrice).type = 'R'; |
|
|
# if __GNUC__ >= 7 |
| case 'R' :
|
__attribute__ ((fallthrough)); |
| {
|
# endif |
| if ((matrice_a_f77 = (void *) malloc(taille_matrice_f77 *
|
} |
| sizeof(real8))) == NULL)
|
|
| {
|
case 'R' : |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
{ |
| return;
|
if ((matrice_a_f77 = malloc(((size_t) taille_matrice_f77) * |
| }
|
sizeof(real8))) == NULL) |
|
|
{ |
| if ((matrice_vs_f77 = (void *) malloc(taille_matrice_f77 *
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| sizeof(real8))) == NULL)
|
return; |
| {
|
} |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
|
| return;
|
if ((matrice_vs_f77 = malloc(((size_t) taille_matrice_f77) * |
| }
|
sizeof(real8))) == NULL) |
|
|
{ |
| for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| {
|
return; |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
} |
| {
|
|
| ((real8 *) matrice_a_f77)[k++] = ((real8 **)
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| (*s_matrice).tableau)[j][i];
|
{ |
| }
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| }
|
{ |
|
|
((real8 *) matrice_a_f77)[k++] = ((real8 **) |
| if ((wr = (real8 *) malloc(nombre_lignes_a * sizeof(real8)))
|
(*s_matrice).tableau)[j][i]; |
| == NULL)
|
} |
| {
|
} |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
|
| return;
|
if ((wr = (real8 *) malloc(((size_t) nombre_lignes_a) * |
| }
|
sizeof(real8))) == NULL) |
|
|
{ |
| if ((wi = (real8 *) malloc(nombre_lignes_a * sizeof(real8)))
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| == NULL)
|
return; |
| {
|
} |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
|
| return;
|
if ((wi = (real8 *) malloc(((size_t) nombre_lignes_a) * |
| }
|
sizeof(real8))) == NULL) |
|
|
{ |
| lwork = -1;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
|
|
return; |
| if ((work = (real8 *) malloc(sizeof(real8))) == NULL)
|
} |
| {
|
|
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
lwork = -1; |
| return;
|
|
| }
|
if ((work = (real8 *) malloc(sizeof(real8))) == NULL) |
|
|
{ |
| dgees_(&calcul_vecteurs_schur, &tri_vecteurs_schur,
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| NULL, &nombre_lignes_a, matrice_a_f77,
|
return; |
| &nombre_colonnes_a, &sdim, wr, wi,
|
} |
| matrice_vs_f77, &nombre_colonnes_a,
|
|
| work, &lwork, NULL, &info, 1, 1);
|
dgees_(&calcul_vecteurs_schur, &tri_vecteurs_schur, |
|
|
NULL, &nombre_lignes_a, matrice_a_f77, |
| lwork = ((real8 *) work)[0];
|
&nombre_colonnes_a, &sdim, wr, wi, |
| free(work);
|
matrice_vs_f77, &nombre_colonnes_a, |
|
|
work, &lwork, NULL, &info, 1, 1); |
| if ((work = (real8 *) malloc(lwork * sizeof(real8))) == NULL)
|
|
| {
|
lwork = (integer4) ((real8 *) work)[0]; |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
free(work); |
| return;
|
|
| }
|
if ((work = (real8 *) malloc(((size_t) lwork) * sizeof(real8))) |
|
|
== NULL) |
| dgees_(&calcul_vecteurs_schur, &tri_vecteurs_schur,
|
{ |
| NULL, &nombre_lignes_a, matrice_a_f77,
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| &nombre_colonnes_a, &sdim, wr, wi,
|
return; |
| matrice_vs_f77, &nombre_colonnes_a,
|
} |
| work, &lwork, NULL, &info, 1, 1);
|
|
|
|
dgees_(&calcul_vecteurs_schur, &tri_vecteurs_schur, |
| free(work);
|
NULL, &nombre_lignes_a, matrice_a_f77, |
| free(wr);
|
&nombre_colonnes_a, &sdim, wr, wi, |
| free(wi);
|
matrice_vs_f77, &nombre_colonnes_a, |
|
|
work, &lwork, NULL, &info, 1, 1); |
| if (info != 0)
|
|
| {
|
free(work); |
| if (info > 0)
|
free(wr); |
| {
|
free(wi); |
| (*s_etat_processus).exception = d_ep_decomposition_QR;
|
|
| }
|
if (info != 0) |
| else
|
{ |
| {
|
if (info > 0) |
| (*s_etat_processus).erreur_execution =
|
{ |
| d_ex_routines_mathematiques;
|
(*s_etat_processus).exception = d_ep_decomposition_QR; |
| }
|
} |
|
|
else |
| free(matrice_a_f77);
|
{ |
| free(matrice_vs_f77);
|
(*s_etat_processus).erreur_execution = |
| return;
|
d_ex_routines_mathematiques; |
| }
|
} |
|
|
|
| for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
free(matrice_a_f77); |
| {
|
free(matrice_vs_f77); |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
return; |
| {
|
} |
| ((real8 **) (*s_matrice).tableau)[j][i] =
|
|
| ((real8 *) matrice_a_f77)[k++];
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| }
|
{ |
| }
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
|
|
{ |
| (**s_schur).nombre_colonnes = (*s_matrice).nombre_colonnes;
|
((real8 **) (*s_matrice).tableau)[j][i] = |
| (**s_schur).nombre_lignes = (*s_matrice).nombre_lignes;
|
((real8 *) matrice_a_f77)[k++]; |
| (**s_schur).type = 'R';
|
} |
|
|
} |
| if (((**s_schur).tableau = malloc((**s_schur)
|
|
| .nombre_lignes * sizeof(real8 *))) == NULL)
|
(**s_schur).nombre_colonnes = (*s_matrice).nombre_colonnes; |
| {
|
(**s_schur).nombre_lignes = (*s_matrice).nombre_lignes; |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(**s_schur).type = 'R'; |
| return;
|
|
| }
|
if (((**s_schur).tableau = malloc(((size_t) (**s_schur) |
|
|
.nombre_lignes) * sizeof(real8 *))) == NULL) |
| for(i = 0; i < (**s_schur).nombre_lignes; i++)
|
{ |
| {
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| if ((((real8 **) (**s_schur).tableau)[i] = (real8 *)
|
return; |
| malloc((**s_schur).nombre_colonnes *
|
} |
| sizeof(real8))) == NULL)
|
|
| {
|
for(i = 0; i < (**s_schur).nombre_lignes; i++) |
| (*s_etat_processus).erreur_systeme =
|
{ |
| d_es_allocation_memoire;
|
if ((((real8 **) (**s_schur).tableau)[i] = (real8 *) |
| return;
|
malloc(((size_t) (**s_schur).nombre_colonnes) * |
| }
|
sizeof(real8))) == NULL) |
| }
|
{ |
|
|
(*s_etat_processus).erreur_systeme = |
| for(k = 0, i = 0; i < (**s_schur).nombre_colonnes; i++)
|
d_es_allocation_memoire; |
| {
|
return; |
| for(j = 0; j < (**s_schur).nombre_lignes; j++)
|
} |
| {
|
} |
| ((real8 **) (**s_schur).tableau)[j][i] = ((real8 *)
|
|
| matrice_vs_f77)[k++];
|
for(k = 0, i = 0; i < (**s_schur).nombre_colonnes; i++) |
| }
|
{ |
| }
|
for(j = 0; j < (**s_schur).nombre_lignes; j++) |
|
|
{ |
| free(matrice_a_f77);
|
((real8 **) (**s_schur).tableau)[j][i] = ((real8 *) |
| free(matrice_vs_f77);
|
matrice_vs_f77)[k++]; |
|
|
} |
| break;
|
} |
| }
|
|
|
|
free(matrice_a_f77); |
| case 'C' :
|
free(matrice_vs_f77); |
| {
|
|
| if ((matrice_a_f77 = (void *) malloc(taille_matrice_f77 *
|
break; |
| sizeof(complex16))) == NULL)
|
} |
| {
|
|
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
case 'C' : |
| return;
|
{ |
| }
|
if ((matrice_a_f77 = malloc(((size_t) taille_matrice_f77) * |
|
|
sizeof(complex16))) == NULL) |
| if ((matrice_vs_f77 = (void *) malloc(taille_matrice_f77 *
|
{ |
| sizeof(complex16))) == NULL)
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| {
|
return; |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
} |
| return;
|
|
| }
|
if ((matrice_vs_f77 = malloc(((size_t) taille_matrice_f77) * |
|
|
sizeof(complex16))) == NULL) |
| for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
{ |
| {
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
return; |
| {
|
} |
| ((complex16 *) matrice_a_f77)[k].partie_reelle =
|
|
| ((complex16 **) (*s_matrice).tableau)[j][i]
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| .partie_reelle;
|
{ |
| ((complex16 *) matrice_a_f77)[k++].partie_imaginaire =
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| ((complex16 **) (*s_matrice).tableau)[j][i]
|
{ |
| .partie_imaginaire;
|
((complex16 *) matrice_a_f77)[k].partie_reelle = |
| }
|
((complex16 **) (*s_matrice).tableau)[j][i] |
| }
|
.partie_reelle; |
|
|
((complex16 *) matrice_a_f77)[k++].partie_imaginaire = |
| if ((w = (complex16 *) malloc(nombre_lignes_a * sizeof(complex16)))
|
((complex16 **) (*s_matrice).tableau)[j][i] |
| == NULL)
|
.partie_imaginaire; |
| {
|
} |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
} |
| return;
|
|
| }
|
if ((w = (complex16 *) malloc(((size_t) nombre_lignes_a) * |
|
|
sizeof(complex16))) == NULL) |
| lwork = -1;
|
{ |
|
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| if ((work = (complex16 *) malloc(sizeof(complex16))) == NULL)
|
return; |
| {
|
} |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
|
| return;
|
lwork = -1; |
| }
|
|
|
|
if ((work = (complex16 *) malloc(sizeof(complex16))) == NULL) |
| if ((rwork = (real8 *) malloc(nombre_lignes_a * sizeof(real8)))
|
{ |
| == NULL)
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| {
|
return; |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
} |
| return;
|
|
| }
|
if ((rwork = (real8 *) malloc(((size_t) nombre_lignes_a) * |
|
|
sizeof(real8))) == NULL) |
| zgees_(&calcul_vecteurs_schur, &tri_vecteurs_schur,
|
{ |
| NULL, &nombre_lignes_a, matrice_a_f77,
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| &nombre_colonnes_a, &sdim, w,
|
return; |
| matrice_vs_f77, &nombre_colonnes_a,
|
} |
| work, &lwork, rwork, NULL, &info, 1, 1);
|
|
|
|
zgees_(&calcul_vecteurs_schur, &tri_vecteurs_schur, |
| lwork = ((complex16 *) work)[0].partie_reelle;
|
NULL, &nombre_lignes_a, matrice_a_f77, |
| free(work);
|
&nombre_colonnes_a, &sdim, w, |
|
|
matrice_vs_f77, &nombre_colonnes_a, |
| if ((work = (complex16 *) malloc(lwork * sizeof(complex16)))
|
work, &lwork, rwork, NULL, &info, 1, 1); |
| == NULL)
|
|
| {
|
lwork = (integer4) ((complex16 *) work)[0].partie_reelle; |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
free(work); |
| return;
|
|
| }
|
if ((work = (complex16 *) malloc(((size_t) lwork) * |
|
|
sizeof(complex16))) == NULL) |
| zgees_(&calcul_vecteurs_schur, &tri_vecteurs_schur,
|
{ |
| NULL, &nombre_lignes_a, matrice_a_f77,
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| &nombre_colonnes_a, &sdim, w,
|
return; |
| matrice_vs_f77, &nombre_colonnes_a,
|
} |
| work, &lwork, rwork, NULL, &info, 1, 1);
|
|
|
|
zgees_(&calcul_vecteurs_schur, &tri_vecteurs_schur, |
| free(work);
|
NULL, &nombre_lignes_a, matrice_a_f77, |
| free(rwork);
|
&nombre_colonnes_a, &sdim, w, |
| free(w);
|
matrice_vs_f77, &nombre_colonnes_a, |
|
|
work, &lwork, rwork, NULL, &info, 1, 1); |
| if (info != 0)
|
|
| {
|
free(work); |
| if (info > 0)
|
free(rwork); |
| {
|
free(w); |
| (*s_etat_processus).exception = d_ep_decomposition_QR;
|
|
| }
|
if (info != 0) |
| else
|
{ |
| {
|
if (info > 0) |
| (*s_etat_processus).erreur_execution =
|
{ |
| d_ex_routines_mathematiques;
|
(*s_etat_processus).exception = d_ep_decomposition_QR; |
| }
|
} |
|
|
else |
| free(matrice_a_f77);
|
{ |
| free(matrice_vs_f77);
|
(*s_etat_processus).erreur_execution = |
| return;
|
d_ex_routines_mathematiques; |
| }
|
} |
|
|
|
| for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
free(matrice_a_f77); |
| {
|
free(matrice_vs_f77); |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
return; |
| {
|
} |
| ((complex16 **) (*s_matrice).tableau)[j][i]
|
|
| .partie_reelle = ((complex16 *) matrice_a_f77)[k]
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| .partie_reelle;
|
{ |
| ((complex16 **) (*s_matrice).tableau)[j][i]
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| .partie_imaginaire = ((complex16 *) matrice_a_f77)
|
{ |
| [k++].partie_imaginaire;
|
((complex16 **) (*s_matrice).tableau)[j][i] |
| }
|
.partie_reelle = ((complex16 *) matrice_a_f77)[k] |
| }
|
.partie_reelle; |
|
|
((complex16 **) (*s_matrice).tableau)[j][i] |
| (**s_schur).nombre_colonnes = (*s_matrice).nombre_colonnes;
|
.partie_imaginaire = ((complex16 *) matrice_a_f77) |
| (**s_schur).nombre_lignes = (*s_matrice).nombre_lignes;
|
[k++].partie_imaginaire; |
| (**s_schur).type = 'C';
|
} |
|
|
} |
| if (((**s_schur).tableau = malloc((**s_schur)
|
|
| .nombre_lignes * sizeof(complex16 *))) == NULL)
|
(**s_schur).nombre_colonnes = (*s_matrice).nombre_colonnes; |
| {
|
(**s_schur).nombre_lignes = (*s_matrice).nombre_lignes; |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(**s_schur).type = 'C'; |
| return;
|
|
| }
|
if (((**s_schur).tableau = malloc(((size_t) (**s_schur) |
|
|
.nombre_lignes) * sizeof(complex16 *))) == NULL) |
| for(i = 0; i < (**s_schur).nombre_lignes; i++)
|
{ |
| {
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| if ((((complex16 **) (**s_schur).tableau)[i] = (complex16 *)
|
return; |
| malloc((**s_schur).nombre_colonnes *
|
} |
| sizeof(complex16))) == NULL)
|
|
| {
|
for(i = 0; i < (**s_schur).nombre_lignes; i++) |
| (*s_etat_processus).erreur_systeme =
|
{ |
| d_es_allocation_memoire;
|
if ((((complex16 **) (**s_schur).tableau)[i] = (complex16 *) |
| return;
|
malloc(((size_t) (**s_schur).nombre_colonnes) * |
| }
|
sizeof(complex16))) == NULL) |
| }
|
{ |
|
|
(*s_etat_processus).erreur_systeme = |
| for(k = 0, i = 0; i < (**s_schur).nombre_colonnes; i++)
|
d_es_allocation_memoire; |
| {
|
return; |
| for(j = 0; j < (**s_schur).nombre_lignes; j++)
|
} |
| {
|
} |
| ((complex16 **) (**s_schur).tableau)[j][i].partie_reelle =
|
|
| ((complex16 *) matrice_vs_f77)[k].partie_reelle;
|
for(k = 0, i = 0; i < (**s_schur).nombre_colonnes; i++) |
| ((complex16 **) (**s_schur).tableau)[j][i]
|
{ |
| .partie_imaginaire = ((complex16 *) matrice_vs_f77)
|
for(j = 0; j < (**s_schur).nombre_lignes; j++) |
| [k++].partie_imaginaire;
|
{ |
| }
|
((complex16 **) (**s_schur).tableau)[j][i].partie_reelle = |
| }
|
((complex16 *) matrice_vs_f77)[k].partie_reelle; |
|
|
((complex16 **) (**s_schur).tableau)[j][i] |
| free(matrice_a_f77);
|
.partie_imaginaire = ((complex16 *) matrice_vs_f77) |
| free(matrice_vs_f77);
|
[k++].partie_imaginaire; |
|
|
} |
| break;
|
} |
| }
|
|
| }
|
free(matrice_a_f77); |
|
|
free(matrice_vs_f77); |
| return;
|
|
| }
|
break; |
|
|
} |
|
|
} |
| /*
|
|
| ================================================================================
|
return; |
| Fonction réalisation la factorisation LQ d'une matrice quelconque
|
} |
| ================================================================================
|
|
| Entrées : struct_matrice
|
|
| --------------------------------------------------------------------------------
|
/* |
| Sorties : décomposition de LQ de la matrice d'entrée. Le tableau tau
|
================================================================================ |
| est initialisé par la fonction
|
Fonction réalisation la factorisation LQ d'une matrice quelconque |
| --------------------------------------------------------------------------------
|
================================================================================ |
| Effets de bord : néant
|
Entrées : struct_matrice |
| ================================================================================
|
-------------------------------------------------------------------------------- |
| */
|
Sorties : décomposition de LQ de la matrice d'entrée. Le tableau tau |
|
|
est initialisé par la fonction |
| void
|
-------------------------------------------------------------------------------- |
| factorisation_lq(struct_processus *s_etat_processus, struct_matrice *s_matrice,
|
Effets de bord : néant |
| void **tau)
|
================================================================================ |
| {
|
*/ |
| integer4 nombre_colonnes_a;
|
|
| integer4 nombre_lignes_a;
|
void |
| integer4 erreur;
|
factorisation_lq(struct_processus *s_etat_processus, struct_matrice *s_matrice, |
|
|
void **tau) |
| unsigned long i;
|
{ |
| unsigned long j;
|
integer4 nombre_colonnes_a; |
| unsigned long k;
|
integer4 nombre_lignes_a; |
| unsigned long taille_matrice_f77;
|
integer4 erreur; |
|
|
|
| void *matrice_a_f77;
|
integer8 i; |
| void *tampon;
|
integer8 j; |
| void *work;
|
integer8 k; |
|
|
integer8 taille_matrice_f77; |
| nombre_lignes_a = (integer4) (*s_matrice).nombre_lignes;
|
|
| nombre_colonnes_a = (integer4) (*s_matrice).nombre_colonnes;
|
void *matrice_a_f77; |
| taille_matrice_f77 = nombre_lignes_a * nombre_colonnes_a;
|
void *tampon; |
|
|
void *work; |
| switch((*s_matrice).type)
|
|
| {
|
nombre_lignes_a = (integer4) (*s_matrice).nombre_lignes; |
| case 'I' :
|
nombre_colonnes_a = (integer4) (*s_matrice).nombre_colonnes; |
| {
|
taille_matrice_f77 = nombre_lignes_a * nombre_colonnes_a; |
| /* Conversion de la matrice en matrice réelle */
|
|
|
|
switch((*s_matrice).type) |
| for(i = 0; i < (unsigned long) nombre_lignes_a; i++)
|
{ |
| {
|
case 'I' : |
| tampon = (*s_matrice).tableau[i];
|
{ |
|
|
/* Conversion de la matrice en matrice réelle */ |
| if ((((real8 **) (*s_matrice).tableau)[i] = (real8 *)
|
|
| malloc(nombre_colonnes_a * sizeof(real8))) == NULL)
|
for(i = 0; i < nombre_lignes_a; i++) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme =
|
tampon = (*s_matrice).tableau[i]; |
| d_es_allocation_memoire;
|
|
| return;
|
if ((((real8 **) (*s_matrice).tableau)[i] = (real8 *) |
| }
|
malloc(((size_t) nombre_colonnes_a) * sizeof(real8))) |
|
|
== NULL) |
| for(j = 0; j < (unsigned long) nombre_colonnes_a; j++)
|
{ |
| {
|
(*s_etat_processus).erreur_systeme = |
| ((real8 **) (*s_matrice).tableau)[i][j] =
|
d_es_allocation_memoire; |
| ((integer8 *) tampon)[j];
|
return; |
| }
|
} |
|
|
|
| free(tampon);
|
for(j = 0; j < nombre_colonnes_a; j++) |
| }
|
{ |
|
|
((real8 **) (*s_matrice).tableau)[i][j] = (real8) |
| (*s_matrice).type = 'R';
|
((integer8 *) tampon)[j]; |
| }
|
} |
|
|
|
| case 'R' :
|
free(tampon); |
| {
|
} |
| if ((matrice_a_f77 = (void *) malloc(taille_matrice_f77 *
|
|
| sizeof(real8))) == NULL)
|
(*s_matrice).type = 'R'; |
| {
|
# if __GNUC__ >= 7 |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
__attribute__ ((fallthrough)); |
| return;
|
# endif |
| }
|
} |
|
|
|
| if (((*tau) = malloc(((nombre_colonnes_a < nombre_lignes_a)
|
case 'R' : |
| ? nombre_colonnes_a : nombre_lignes_a) * sizeof(real8)))
|
{ |
| == NULL)
|
if ((matrice_a_f77 = malloc(((size_t) taille_matrice_f77) * |
| {
|
sizeof(real8))) == NULL) |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
{ |
| return;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| }
|
return; |
|
|
} |
| if ((work = malloc(nombre_lignes_a * sizeof(real8))) == NULL)
|
|
| {
|
if (((*tau) = malloc(((size_t) ((nombre_colonnes_a < |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
nombre_lignes_a) ? nombre_colonnes_a : nombre_lignes_a)) * |
| return;
|
sizeof(real8))) == NULL) |
| }
|
{ |
|
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
return; |
| {
|
} |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
|
| {
|
if ((work = malloc(((size_t) nombre_lignes_a) * sizeof(real8))) |
| ((real8 *) matrice_a_f77)[k++] = ((real8 **)
|
== NULL) |
| (*s_matrice).tableau)[j][i];
|
{ |
| }
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| }
|
return; |
|
|
} |
| dgelq2_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77,
|
|
| &nombre_lignes_a, (*((real8 **) tau)), work, &erreur);
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
|
|
{ |
| if (erreur != 0)
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| {
|
{ |
| // L'erreur ne peut être que négative.
|
((real8 *) matrice_a_f77)[k++] = ((real8 **) |
|
|
(*s_matrice).tableau)[j][i]; |
| (*s_etat_processus).erreur_execution =
|
} |
| d_ex_routines_mathematiques;
|
} |
| free(work);
|
|
| free(matrice_a_f77);
|
dgelq2_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77, |
| return;
|
&nombre_lignes_a, (*((real8 **) tau)), work, &erreur); |
| }
|
|
|
|
if (erreur != 0) |
| for(k = 0, i = 0; i < (unsigned long) nombre_colonnes_a; i++)
|
{ |
| {
|
// L'erreur ne peut être que négative. |
| for(j = 0; j < (unsigned long) nombre_lignes_a; j++)
|
|
| {
|
(*s_etat_processus).erreur_execution = |
| ((real8 **) (*s_matrice).tableau)[j][i] = ((real8 *)
|
d_ex_routines_mathematiques; |
| matrice_a_f77)[k++];
|
free(work); |
| }
|
free(matrice_a_f77); |
| }
|
return; |
|
|
} |
| free(work);
|
|
| free(matrice_a_f77);
|
for(k = 0, i = 0; i < nombre_colonnes_a; i++) |
|
|
{ |
| break;
|
for(j = 0; j < nombre_lignes_a; j++) |
| }
|
{ |
|
|
((real8 **) (*s_matrice).tableau)[j][i] = ((real8 *) |
| case 'C' :
|
matrice_a_f77)[k++]; |
| {
|
} |
| if ((matrice_a_f77 = (void *) malloc(taille_matrice_f77 *
|
} |
| sizeof(complex16))) == NULL)
|
|
| {
|
free(work); |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
free(matrice_a_f77); |
| return;
|
|
| }
|
break; |
|
|
} |
| if (((*tau) = malloc(((nombre_colonnes_a < nombre_lignes_a)
|
|
| ? nombre_colonnes_a : nombre_lignes_a) *
|
case 'C' : |
| sizeof(complex16))) == NULL)
|
{ |
| {
|
if ((matrice_a_f77 = malloc(((size_t) taille_matrice_f77) * |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
sizeof(complex16))) == NULL) |
| return;
|
{ |
| }
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
|
|
return; |
| if ((work = malloc(nombre_lignes_a * sizeof(complex16))) == NULL)
|
} |
| {
|
|
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
if (((*tau) = malloc(((size_t) ((nombre_colonnes_a < |
| return;
|
nombre_lignes_a) ? nombre_colonnes_a : nombre_lignes_a)) * |
| }
|
sizeof(complex16))) == NULL) |
|
|
{ |
| for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| {
|
return; |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
} |
| {
|
|
| ((complex16 *) matrice_a_f77)[k].partie_reelle =
|
if ((work = malloc(((size_t) nombre_lignes_a) * sizeof(complex16))) |
| ((complex16 **) (*s_matrice).tableau)[j][i]
|
== NULL) |
| .partie_reelle;
|
{ |
| ((complex16 *) matrice_a_f77)[k++].partie_imaginaire =
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| ((complex16 **) (*s_matrice).tableau)[j][i]
|
return; |
| .partie_imaginaire;
|
} |
| }
|
|
| }
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
|
|
{ |
| zgelq2_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77,
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| &nombre_lignes_a, (*((complex16 **) tau)), work, &erreur);
|
{ |
|
|
((complex16 *) matrice_a_f77)[k].partie_reelle = |
| if (erreur != 0)
|
((complex16 **) (*s_matrice).tableau)[j][i] |
| {
|
.partie_reelle; |
| // L'erreur ne peut être que négative.
|
((complex16 *) matrice_a_f77)[k++].partie_imaginaire = |
|
|
((complex16 **) (*s_matrice).tableau)[j][i] |
| (*s_etat_processus).erreur_execution =
|
.partie_imaginaire; |
| d_ex_routines_mathematiques;
|
} |
| free(work);
|
} |
| free(matrice_a_f77);
|
|
| return;
|
zgelq2_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77, |
| }
|
&nombre_lignes_a, (*((complex16 **) tau)), work, &erreur); |
|
|
|
| for(k = 0, i = 0; i < (unsigned long) nombre_colonnes_a; i++)
|
if (erreur != 0) |
| {
|
{ |
| for(j = 0; j < (unsigned long) nombre_lignes_a; j++)
|
// L'erreur ne peut être que négative. |
| {
|
|
| ((complex16 **) (*s_matrice).tableau)[j][i].partie_reelle =
|
(*s_etat_processus).erreur_execution = |
| ((complex16 *) matrice_a_f77)[k].partie_reelle;
|
d_ex_routines_mathematiques; |
| ((complex16 **) (*s_matrice).tableau)[j][i]
|
free(work); |
| .partie_imaginaire = ((complex16 *) matrice_a_f77)
|
free(matrice_a_f77); |
| [k++].partie_imaginaire;
|
return; |
| }
|
} |
| }
|
|
|
|
for(k = 0, i = 0; i < nombre_colonnes_a; i++) |
| free(work);
|
{ |
| free(matrice_a_f77);
|
for(j = 0; j < nombre_lignes_a; j++) |
|
|
{ |
| break;
|
((complex16 **) (*s_matrice).tableau)[j][i].partie_reelle = |
| }
|
((complex16 *) matrice_a_f77)[k].partie_reelle; |
| }
|
((complex16 **) (*s_matrice).tableau)[j][i] |
|
|
.partie_imaginaire = ((complex16 *) matrice_a_f77) |
| return;
|
[k++].partie_imaginaire; |
| }
|
} |
|
|
} |
|
|
|
| /*
|
free(work); |
| ================================================================================
|
free(matrice_a_f77); |
| Fonction réalisation la factorisation QR d'une matrice quelconque
|
|
| ================================================================================
|
break; |
| Entrées : struct_matrice
|
} |
| --------------------------------------------------------------------------------
|
} |
| Sorties : décomposition de QR de la matrice d'entrée. Le tableau tau
|
|
| est initialisé par la fonction
|
return; |
| --------------------------------------------------------------------------------
|
} |
| Effets de bord : néant
|
|
| ================================================================================
|
|
| */
|
/* |
|
|
================================================================================ |
| void
|
Fonction réalisation la factorisation QR d'une matrice quelconque |
| factorisation_qr(struct_processus *s_etat_processus, struct_matrice *s_matrice,
|
================================================================================ |
| void **tau)
|
Entrées : struct_matrice |
| {
|
-------------------------------------------------------------------------------- |
| integer4 lwork;
|
Sorties : décomposition de QR de la matrice d'entrée. Le tableau tau |
| integer4 nombre_colonnes_a;
|
est initialisé par la fonction |
| integer4 nombre_lignes_a;
|
-------------------------------------------------------------------------------- |
| integer4 erreur;
|
Effets de bord : néant |
| integer4 *pivot;
|
================================================================================ |
|
|
*/ |
| real8 *rwork;
|
|
|
|
void |
| unsigned long i;
|
factorisation_qr(struct_processus *s_etat_processus, struct_matrice *s_matrice, |
| unsigned long j;
|
void **tau) |
| unsigned long k;
|
{ |
| unsigned long taille_matrice_f77;
|
integer4 lwork; |
|
|
integer4 nombre_colonnes_a; |
| void *matrice_a_f77;
|
integer4 nombre_lignes_a; |
| void *registre;
|
integer4 erreur; |
| void *tampon;
|
integer4 *pivot; |
| void *work;
|
|
|
|
real8 *rwork; |
| nombre_lignes_a = (integer4) (*s_matrice).nombre_lignes;
|
|
| nombre_colonnes_a = (integer4) (*s_matrice).nombre_colonnes;
|
integer8 i; |
| taille_matrice_f77 = nombre_lignes_a * nombre_colonnes_a;
|
integer8 j; |
|
|
integer8 k; |
| switch((*s_matrice).type)
|
integer8 taille_matrice_f77; |
| {
|
|
| case 'I' :
|
void *matrice_a_f77; |
| {
|
void *registre; |
| /* Conversion de la matrice en matrice réelle */
|
void *tampon; |
|
|
void *work; |
| for(i = 0; i < (unsigned long) nombre_lignes_a; i++)
|
|
| {
|
nombre_lignes_a = (integer4) (*s_matrice).nombre_lignes; |
| tampon = (*s_matrice).tableau[i];
|
nombre_colonnes_a = (integer4) (*s_matrice).nombre_colonnes; |
|
|
taille_matrice_f77 = nombre_lignes_a * nombre_colonnes_a; |
| if ((((real8 **) (*s_matrice).tableau)[i] = (real8 *)
|
|
| malloc(nombre_colonnes_a * sizeof(real8))) == NULL)
|
switch((*s_matrice).type) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme =
|
case 'I' : |
| d_es_allocation_memoire;
|
{ |
| return;
|
/* Conversion de la matrice en matrice réelle */ |
| }
|
|
|
|
for(i = 0; i < nombre_lignes_a; i++) |
| for(j = 0; j < (unsigned long) nombre_colonnes_a; j++)
|
{ |
| {
|
tampon = (*s_matrice).tableau[i]; |
| ((real8 **) (*s_matrice).tableau)[i][j] =
|
|
| ((integer8 *) tampon)[j];
|
if ((((real8 **) (*s_matrice).tableau)[i] = (real8 *) |
| }
|
malloc(((size_t) nombre_colonnes_a) * sizeof(real8))) |
|
|
== NULL) |
| free(tampon);
|
{ |
| }
|
(*s_etat_processus).erreur_systeme = |
|
|
d_es_allocation_memoire; |
| (*s_matrice).type = 'R';
|
return; |
| }
|
} |
|
|
|
| case 'R' :
|
for(j = 0; j < nombre_colonnes_a; j++) |
| {
|
{ |
| if ((matrice_a_f77 = (void *) malloc(taille_matrice_f77 *
|
((real8 **) (*s_matrice).tableau)[i][j] = (real8) |
| sizeof(real8))) == NULL)
|
((integer8 *) tampon)[j]; |
| {
|
} |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
|
| return;
|
free(tampon); |
| }
|
} |
|
|
|
| if (((*tau) = malloc(((nombre_colonnes_a < nombre_lignes_a)
|
(*s_matrice).type = 'R'; |
| ? nombre_colonnes_a : nombre_lignes_a) * sizeof(real8)))
|
# if __GNUC__ >= 7 |
| == NULL)
|
__attribute__ ((fallthrough)); |
| {
|
# endif |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
} |
| return;
|
|
| }
|
case 'R' : |
|
|
{ |
| for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
if ((matrice_a_f77 = malloc(((size_t) taille_matrice_f77) * |
| {
|
sizeof(real8))) == NULL) |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
{ |
| {
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| ((real8 *) matrice_a_f77)[k++] = ((real8 **)
|
return; |
| (*s_matrice).tableau)[j][i];
|
} |
| }
|
|
| }
|
if (((*tau) = malloc(((size_t) ((nombre_colonnes_a < |
|
|
nombre_lignes_a) ? nombre_colonnes_a : nombre_lignes_a)) * |
| if ((pivot = malloc(nombre_colonnes_a * sizeof(integer4))) == NULL)
|
sizeof(real8))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| for(i = 0; i < (unsigned long) nombre_colonnes_a; pivot[i++] = 0);
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
|
|
{ |
| lwork = -1;
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
|
|
{ |
| if ((work = malloc(sizeof(real8))) == NULL)
|
((real8 *) matrice_a_f77)[k++] = ((real8 **) |
| {
|
(*s_matrice).tableau)[j][i]; |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
} |
| return;
|
} |
| }
|
|
|
|
if ((pivot = malloc(((size_t) nombre_colonnes_a) * |
| // Calcul de la taille de l'espace
|
sizeof(integer4))) == NULL) |
|
|
{ |
| dgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77,
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| &nombre_lignes_a, pivot, (*((real8 **) tau)),
|
return; |
| work, &lwork, &erreur);
|
} |
|
|
|
| lwork = ((real8 *) work)[0];
|
for(i = 0; i < nombre_colonnes_a; pivot[i++] = 0); |
|
|
|
| free(work);
|
lwork = -1; |
|
|
|
| if ((work = malloc(lwork * sizeof(real8))) == NULL)
|
if ((work = malloc(sizeof(real8))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| // Calcul de la permutation
|
// Calcul de la taille de l'espace |
|
|
|
| if ((registre = (void *) malloc(taille_matrice_f77 *
|
dgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77, |
| sizeof(real8))) == NULL)
|
&nombre_lignes_a, pivot, (*((real8 **) tau)), |
| {
|
work, &lwork, &erreur); |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
|
| return;
|
lwork = (integer4) ((real8 *) work)[0]; |
| }
|
|
|
|
free(work); |
| memcpy(registre, matrice_a_f77, taille_matrice_f77 * sizeof(real8));
|
|
|
|
if ((work = malloc(((size_t) lwork) * sizeof(real8))) == NULL) |
| dgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, registre,
|
{ |
| &nombre_lignes_a, pivot, (*((real8 **) tau)),
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| work, &lwork, &erreur);
|
return; |
|
|
} |
| free(registre);
|
|
|
|
// Calcul de la permutation |
| if (erreur != 0)
|
|
| {
|
if ((registre = malloc(((size_t) taille_matrice_f77) * |
| // L'erreur ne peut être que négative.
|
sizeof(real8))) == NULL) |
|
|
{ |
| (*s_etat_processus).erreur_execution =
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| d_ex_routines_mathematiques;
|
return; |
| free(work);
|
} |
| free(matrice_a_f77);
|
|
| free(tau);
|
memcpy(registre, matrice_a_f77, ((size_t) taille_matrice_f77) * |
| return;
|
sizeof(real8)); |
| }
|
|
|
|
dgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, registre, |
| // La permutation doit maintenant être unitaire
|
&nombre_lignes_a, pivot, (*((real8 **) tau)), |
|
|
work, &lwork, &erreur); |
| dgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77,
|
|
| &nombre_lignes_a, pivot, (*((real8 **) tau)),
|
free(registre); |
| work, &lwork, &erreur);
|
|
|
|
if (erreur != 0) |
| if (erreur != 0)
|
{ |
| {
|
// L'erreur ne peut être que négative. |
| // L'erreur ne peut être que négative.
|
|
|
|
(*s_etat_processus).erreur_execution = |
| (*s_etat_processus).erreur_execution =
|
d_ex_routines_mathematiques; |
| d_ex_routines_mathematiques;
|
free(work); |
| free(work);
|
free(matrice_a_f77); |
| free(matrice_a_f77);
|
free(tau); |
| free(tau);
|
return; |
| return;
|
} |
| }
|
|
|
|
// La permutation doit maintenant être unitaire |
| for(i = 0; i < (unsigned long) nombre_colonnes_a; i++)
|
|
| {
|
dgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77, |
| if ((i + 1) != (unsigned long) pivot[i])
|
&nombre_lignes_a, pivot, (*((real8 **) tau)), |
| {
|
work, &lwork, &erreur); |
| (*s_etat_processus).erreur_execution =
|
|
| d_ex_routines_mathematiques;
|
if (erreur != 0) |
|
|
{ |
| free(pivot);
|
// L'erreur ne peut être que négative. |
| free(work);
|
|
| free(matrice_a_f77);
|
(*s_etat_processus).erreur_execution = |
| free(tau);
|
d_ex_routines_mathematiques; |
|
|
free(work); |
| return;
|
free(matrice_a_f77); |
| }
|
free(tau); |
| }
|
return; |
|
|
} |
| free(pivot);
|
|
|
|
for(i = 0; i < nombre_colonnes_a; i++) |
| for(k = 0, i = 0; i < (unsigned long) nombre_colonnes_a; i++)
|
{ |
| {
|
if ((i + 1) != pivot[i]) |
| for(j = 0; j < (unsigned long) nombre_lignes_a; j++)
|
{ |
| {
|
(*s_etat_processus).erreur_execution = |
| ((real8 **) (*s_matrice).tableau)[j][i] = ((real8 *)
|
d_ex_routines_mathematiques; |
| matrice_a_f77)[k++];
|
|
| }
|
free(pivot); |
| }
|
free(work); |
|
|
free(matrice_a_f77); |
| free(work);
|
free(tau); |
| free(matrice_a_f77);
|
|
|
|
return; |
| break;
|
} |
| }
|
} |
|
|
|
| case 'C' :
|
free(pivot); |
| {
|
|
| if ((matrice_a_f77 = (void *) malloc(taille_matrice_f77 *
|
for(k = 0, i = 0; i < nombre_colonnes_a; i++) |
| sizeof(complex16))) == NULL)
|
{ |
| {
|
for(j = 0; j < nombre_lignes_a; j++) |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
{ |
| return;
|
((real8 **) (*s_matrice).tableau)[j][i] = ((real8 *) |
| }
|
matrice_a_f77)[k++]; |
|
|
} |
| if (((*tau) = malloc(((nombre_colonnes_a < nombre_lignes_a)
|
} |
| ? nombre_colonnes_a : nombre_lignes_a) * sizeof(complex16)))
|
|
| == NULL)
|
free(work); |
| {
|
free(matrice_a_f77); |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
|
| return;
|
break; |
| }
|
} |
|
|
|
| for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
case 'C' : |
| {
|
{ |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
if ((matrice_a_f77 = malloc(((size_t) taille_matrice_f77) * |
| {
|
sizeof(complex16))) == NULL) |
| ((complex16 *) matrice_a_f77)[k].partie_reelle =
|
{ |
| ((complex16 **) (*s_matrice).tableau)[j][i]
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| .partie_reelle;
|
return; |
| ((complex16 *) matrice_a_f77)[k++].partie_imaginaire =
|
} |
| ((complex16 **) (*s_matrice).tableau)[j][i]
|
|
| .partie_imaginaire;
|
if (((*tau) = malloc(((size_t) ((nombre_colonnes_a < |
| }
|
nombre_lignes_a) ? nombre_colonnes_a : nombre_lignes_a)) * |
| }
|
sizeof(complex16))) == NULL) |
|
|
{ |
| if ((pivot = malloc(nombre_colonnes_a * sizeof(integer4))) == NULL)
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| {
|
return; |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
} |
| return;
|
|
| }
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
|
|
{ |
| if ((rwork = malloc(2 * nombre_colonnes_a * sizeof(real8))) == NULL)
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
((complex16 *) matrice_a_f77)[k].partie_reelle = |
| return;
|
((complex16 **) (*s_matrice).tableau)[j][i] |
| }
|
.partie_reelle; |
|
|
((complex16 *) matrice_a_f77)[k++].partie_imaginaire = |
| for(i = 0; i < (unsigned long) nombre_colonnes_a; pivot[i++] = 0);
|
((complex16 **) (*s_matrice).tableau)[j][i] |
|
|
.partie_imaginaire; |
| lwork = -1;
|
} |
|
|
} |
| if ((work = malloc(sizeof(complex16))) == NULL)
|
|
| {
|
if ((pivot = malloc(((size_t) nombre_colonnes_a) * |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
sizeof(integer4))) == NULL) |
| return;
|
{ |
| }
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
|
|
return; |
| // Calcul de la taille de l'espace
|
} |
|
|
|
| zgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77,
|
if ((rwork = malloc(2 * ((size_t) nombre_colonnes_a) * |
| &nombre_lignes_a, pivot, (*((complex16 **) tau)),
|
sizeof(real8))) == NULL) |
| work, &lwork, rwork, &erreur);
|
{ |
|
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| if (erreur != 0)
|
return; |
| {
|
} |
| // L'erreur ne peut être que négative.
|
|
|
|
for(i = 0; i < nombre_colonnes_a; pivot[i++] = 0); |
| (*s_etat_processus).erreur_execution =
|
|
| d_ex_routines_mathematiques;
|
lwork = -1; |
|
|
|
| free(work);
|
if ((work = malloc(sizeof(complex16))) == NULL) |
| free(rwork);
|
{ |
| free(pivot);
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| free(matrice_a_f77);
|
return; |
| free(tau);
|
} |
| return;
|
|
| }
|
// Calcul de la taille de l'espace |
|
|
|
| lwork = ((complex16 *) work)[0].partie_reelle;
|
zgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77, |
|
|
&nombre_lignes_a, pivot, (*((complex16 **) tau)), |
| free(work);
|
work, &lwork, rwork, &erreur); |
|
|
|
| if ((work = malloc(lwork * sizeof(complex16))) == NULL)
|
if (erreur != 0) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
// L'erreur ne peut être que négative. |
| return;
|
|
| }
|
(*s_etat_processus).erreur_execution = |
|
|
d_ex_routines_mathematiques; |
| // Calcul de la permutation
|
|
|
|
free(work); |
| if ((registre = (void *) malloc(taille_matrice_f77 *
|
free(rwork); |
| sizeof(complex16))) == NULL)
|
free(pivot); |
| {
|
free(matrice_a_f77); |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
free(tau); |
| return;
|
return; |
| }
|
} |
|
|
|
| memcpy(registre, matrice_a_f77,
|
lwork = (integer4) ((complex16 *) work)[0].partie_reelle; |
| taille_matrice_f77 * sizeof(complex16));
|
|
|
|
free(work); |
| zgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, registre,
|
|
| &nombre_lignes_a, pivot, (*((complex16 **) tau)),
|
if ((work = malloc(((size_t) lwork) * sizeof(complex16))) == NULL) |
| work, &lwork, rwork, &erreur);
|
{ |
|
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| free(registre);
|
return; |
|
|
} |
| if (erreur != 0)
|
|
| {
|
// Calcul de la permutation |
| // L'erreur ne peut être que négative.
|
|
|
|
if ((registre = malloc(((size_t) taille_matrice_f77) * |
| (*s_etat_processus).erreur_execution =
|
sizeof(complex16))) == NULL) |
| d_ex_routines_mathematiques;
|
{ |
|
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| free(work);
|
return; |
| free(rwork);
|
} |
| free(pivot);
|
|
| free(matrice_a_f77);
|
memcpy(registre, matrice_a_f77, |
| free(tau);
|
((size_t) taille_matrice_f77) * sizeof(complex16)); |
| return;
|
|
| }
|
zgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, registre, |
|
|
&nombre_lignes_a, pivot, (*((complex16 **) tau)), |
| // La permutation doit maintenant être unitaire
|
work, &lwork, rwork, &erreur); |
|
|
|
| zgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77,
|
free(registre); |
| &nombre_lignes_a, pivot, (*((complex16 **) tau)),
|
|
| work, &lwork, rwork, &erreur);
|
if (erreur != 0) |
|
|
{ |
| if (erreur != 0)
|
// L'erreur ne peut être que négative. |
| {
|
|
| // L'erreur ne peut être que négative.
|
(*s_etat_processus).erreur_execution = |
|
|
d_ex_routines_mathematiques; |
| (*s_etat_processus).erreur_execution =
|
|
| d_ex_routines_mathematiques;
|
free(work); |
|
|
free(rwork); |
| free(work);
|
free(pivot); |
| free(rwork);
|
free(matrice_a_f77); |
| free(pivot);
|
free(tau); |
| free(matrice_a_f77);
|
return; |
| free(tau);
|
} |
| return;
|
|
| }
|
// La permutation doit maintenant être unitaire |
|
|
|
| free(rwork);
|
zgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77, |
|
|
&nombre_lignes_a, pivot, (*((complex16 **) tau)), |
| for(i = 0; i < (unsigned long) nombre_colonnes_a; i++)
|
work, &lwork, rwork, &erreur); |
| {
|
|
| if ((i + 1) != (unsigned long) pivot[i])
|
if (erreur != 0) |
| {
|
{ |
| (*s_etat_processus).erreur_execution =
|
// L'erreur ne peut être que négative. |
| d_ex_routines_mathematiques;
|
|
|
|
(*s_etat_processus).erreur_execution = |
| free(pivot);
|
d_ex_routines_mathematiques; |
| free(work);
|
|
| free(matrice_a_f77);
|
free(work); |
| free(tau);
|
free(rwork); |
|
|
free(pivot); |
| return;
|
free(matrice_a_f77); |
| }
|
free(tau); |
| }
|
return; |
|
|
} |
| free(pivot);
|
|
|
|
free(rwork); |
| for(k = 0, i = 0; i < (unsigned long) nombre_colonnes_a; i++)
|
|
| {
|
for(i = 0; i < nombre_colonnes_a; i++) |
| for(j = 0; j < (unsigned long) nombre_lignes_a; j++)
|
{ |
| {
|
if ((i + 1) != pivot[i]) |
| ((complex16 **) (*s_matrice).tableau)[j][i].partie_reelle =
|
{ |
| ((complex16 *) matrice_a_f77)[k].partie_reelle;
|
(*s_etat_processus).erreur_execution = |
| ((complex16 **) (*s_matrice).tableau)[j][i]
|
d_ex_routines_mathematiques; |
| .partie_imaginaire = ((complex16 *)
|
|
| matrice_a_f77)[k++].partie_imaginaire;
|
free(pivot); |
| }
|
free(work); |
| }
|
free(matrice_a_f77); |
|
|
free(tau); |
| free(work);
|
|
| free(matrice_a_f77);
|
return; |
|
|
} |
| break;
|
} |
| }
|
|
| }
|
free(pivot); |
|
|
|
| return;
|
for(k = 0, i = 0; i < nombre_colonnes_a; i++) |
| }
|
{ |
|
|
for(j = 0; j < nombre_lignes_a; j++) |
|
|
{ |
| /*
|
((complex16 **) (*s_matrice).tableau)[j][i].partie_reelle = |
| ================================================================================
|
((complex16 *) matrice_a_f77)[k].partie_reelle; |
| Fonctions calculant le déterminant ou le rang d'une matrice quelconque
|
((complex16 **) (*s_matrice).tableau)[j][i] |
| ================================================================================
|
.partie_imaginaire = ((complex16 *) |
| Entrées : struct_matrice
|
matrice_a_f77)[k++].partie_imaginaire; |
| --------------------------------------------------------------------------------
|
} |
| Sorties : déterminant
|
} |
| --------------------------------------------------------------------------------
|
|
| Effets de bord : néant
|
free(work); |
| ================================================================================
|
free(matrice_a_f77); |
| */
|
|
|
|
break; |
|
|
} |
| static integer4
|
} |
| calcul_rang(struct_processus *s_etat_processus, void *matrice_f77,
|
|
| integer4 nombre_lignes_a, integer4 nombre_colonnes_a,
|
return; |
| integer4 *pivot, integer4 dimension_vecteur_pivot, unsigned char type)
|
} |
| {
|
|
| integer4 erreur;
|
|
| integer4 *iwork;
|
/* |
| integer4 *jpvt;
|
================================================================================ |
| integer4 lwork;
|
Fonctions calculant le déterminant ou le rang d'une matrice quelconque |
| integer4 longueur;
|
================================================================================ |
| integer4 nombre_colonnes_b;
|
Entrées : struct_matrice |
| integer4 nombre_lignes_b;
|
-------------------------------------------------------------------------------- |
| integer4 ordre;
|
Sorties : déterminant |
| integer4 rang;
|
-------------------------------------------------------------------------------- |
|
|
Effets de bord : néant |
| real8 anorme;
|
================================================================================ |
| real8 rcond;
|
*/ |
| real8 *rwork;
|
|
|
|
|
| unsigned char norme;
|
static integer4 |
|
|
calcul_rang(struct_processus *s_etat_processus, void *matrice_f77, |
| unsigned long i;
|
integer4 nombre_lignes_a, integer4 nombre_colonnes_a, |
|
|
integer4 *pivot, integer4 dimension_vecteur_pivot, unsigned char type) |
| void *matrice_b;
|
{ |
| void *matrice_c;
|
integer4 erreur; |
| void *work;
|
integer4 *iwork; |
|
|
integer4 *jpvt; |
| #undef NORME_I
|
integer4 lwork; |
| #ifdef NORME_I
|
integer4 longueur; |
| norme = 'I';
|
integer4 nombre_colonnes_b; |
|
|
integer4 nombre_lignes_b; |
| if ((work = malloc(nombre_lignes_a * sizeof(real8))) == NULL)
|
integer4 ordre; |
| {
|
integer4 rang; |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
|
| return(-1);
|
real8 anorme; |
| }
|
real8 rcond; |
| #else
|
real8 *rwork; |
| norme = '1';
|
|
| work = NULL;
|
unsigned char norme; |
| #endif
|
|
|
|
integer8 i; |
| longueur = 1;
|
|
|
|
void *matrice_b; |
| if (type == 'R')
|
void *matrice_c; |
| {
|
void *work; |
| anorme = dlange_(&norme, &nombre_lignes_a, &nombre_colonnes_a,
|
|
| matrice_f77, &nombre_lignes_a, work, longueur);
|
#undef NORME_I |
|
|
#ifdef NORME_I |
| #ifndef NORME_I
|
norme = 'I'; |
| free(work);
|
|
| #endif
|
if ((work = malloc(((size_t) nombre_lignes_a) * sizeof(real8))) == NULL) |
|
|
{ |
| if ((matrice_c = malloc(nombre_lignes_a * nombre_colonnes_a *
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| sizeof(real8))) == NULL)
|
return(-1); |
| {
|
} |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
#else |
| return(-1);
|
norme = '1'; |
| }
|
work = NULL; |
|
|
#endif |
| memcpy(matrice_c, matrice_f77, nombre_lignes_a * nombre_colonnes_a *
|
|
| sizeof(real8));
|
longueur = 1; |
|
|
|
| dgetrf_(&nombre_lignes_a, &nombre_colonnes_a, matrice_f77,
|
if (type == 'R') |
| &nombre_lignes_a, pivot, &erreur);
|
{ |
|
|
anorme = dlange_(&norme, &nombre_lignes_a, &nombre_colonnes_a, |
| if (erreur < 0)
|
matrice_f77, &nombre_lignes_a, work, longueur); |
| {
|
|
| (*s_etat_processus).erreur_execution =
|
#ifndef NORME_I |
| d_ex_routines_mathematiques;
|
free(work); |
|
|
#endif |
| free(matrice_f77);
|
|
| return(-1);
|
if ((matrice_c = malloc(((size_t) (nombre_lignes_a * nombre_colonnes_a)) |
| }
|
* sizeof(real8))) == NULL) |
|
|
{ |
| if ((iwork = malloc(nombre_colonnes_a * sizeof(integer4))) == NULL)
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| {
|
return(-1); |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
} |
| return(-1);
|
|
| }
|
memcpy(matrice_c, matrice_f77, ((size_t) (nombre_lignes_a * |
|
|
nombre_colonnes_a)) * sizeof(real8)); |
| if ((work = malloc(4 * nombre_colonnes_a * sizeof(real8))) == NULL)
|
|
| {
|
dgetrf_(&nombre_lignes_a, &nombre_colonnes_a, matrice_f77, |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
&nombre_lignes_a, pivot, &erreur); |
| return(-1);
|
|
| }
|
if (erreur < 0) |
|
|
{ |
| ordre = (nombre_lignes_a > nombre_colonnes_a)
|
(*s_etat_processus).erreur_execution = |
| ? nombre_colonnes_a : nombre_lignes_a;
|
d_ex_routines_mathematiques; |
|
|
|
| dgecon_(&norme, &ordre, matrice_f77,
|
free(matrice_f77); |
| &nombre_lignes_a, &anorme, &rcond, work, iwork, &erreur,
|
return(-1); |
| longueur);
|
} |
|
|
|
| free(work);
|
if ((iwork = malloc(((size_t) nombre_colonnes_a) * sizeof(integer4))) |
| free(iwork);
|
== NULL) |
|
|
{ |
| if (erreur < 0)
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| {
|
return(-1); |
| (*s_etat_processus).erreur_execution =
|
} |
| d_ex_routines_mathematiques;
|
|
|
|
if ((work = malloc(4 * ((size_t) nombre_colonnes_a) * sizeof(real8))) |
| free(matrice_f77);
|
== NULL) |
| return(-1);
|
{ |
| }
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
|
|
return(-1); |
| if ((jpvt = malloc(nombre_colonnes_a * sizeof(integer4))) == NULL)
|
} |
| {
|
|
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
ordre = (nombre_lignes_a > nombre_colonnes_a) |
| return(-1);
|
? nombre_colonnes_a : nombre_lignes_a; |
| }
|
|
|
|
dgecon_(&norme, &ordre, matrice_f77, |
| for(i = 0; i < (unsigned long) nombre_colonnes_a; i++)
|
&nombre_lignes_a, &anorme, &rcond, work, iwork, &erreur, |
| {
|
longueur); |
| ((integer4 *) jpvt)[i] = 0;
|
|
| }
|
free(work); |
|
|
free(iwork); |
| lwork = -1;
|
|
|
|
if (erreur < 0) |
| if ((work = malloc(sizeof(real8))) == NULL)
|
{ |
| {
|
(*s_etat_processus).erreur_execution = |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
d_ex_routines_mathematiques; |
| return(-1);
|
|
| }
|
free(matrice_f77); |
|
|
return(-1); |
| nombre_colonnes_b = 1;
|
} |
| nombre_lignes_b = (nombre_lignes_a > nombre_colonnes_a)
|
|
| ? nombre_lignes_a : nombre_colonnes_a;
|
if ((jpvt = malloc(((size_t) nombre_colonnes_a) * sizeof(integer4))) |
|
|
== NULL) |
| if ((matrice_b = malloc(nombre_lignes_b * sizeof(real8))) == NULL)
|
{ |
| {
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
return(-1); |
| return(-1);
|
} |
| }
|
|
|
|
for(i = 0; i < nombre_colonnes_a; i++) |
| for(i = 0; i < (unsigned long) nombre_lignes_b; i++)
|
{ |
| {
|
((integer4 *) jpvt)[i] = 0; |
| ((real8 *) matrice_b)[i] = 0;
|
} |
| }
|
|
|
|
lwork = -1; |
| dgelsy_(&nombre_lignes_a, &nombre_colonnes_a,
|
|
| &nombre_colonnes_b, matrice_c, &nombre_lignes_a,
|
if ((work = malloc(sizeof(real8))) == NULL) |
| matrice_b, &nombre_lignes_b, jpvt, &rcond, &rang,
|
{ |
| work, &lwork, &erreur);
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
|
|
return(-1); |
| lwork = ((real8 *) work)[0];
|
} |
| free(work);
|
|
|
|
nombre_colonnes_b = 1; |
| if ((work = malloc(lwork * sizeof(real8))) == NULL)
|
nombre_lignes_b = (nombre_lignes_a > nombre_colonnes_a) |
| {
|
? nombre_lignes_a : nombre_colonnes_a; |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
|
| return(-1);
|
if ((matrice_b = malloc(((size_t) nombre_lignes_b) * sizeof(real8))) |
| }
|
== NULL) |
|
|
{ |
| dgelsy_(&nombre_lignes_a, &nombre_colonnes_a,
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| &nombre_colonnes_b, matrice_c, &nombre_lignes_a,
|
return(-1); |
| matrice_b, &nombre_lignes_b, jpvt, &rcond, &rang,
|
} |
| work, &lwork, &erreur);
|
|
|
|
for(i = 0; i < nombre_lignes_b; i++) |
| free(matrice_b);
|
{ |
| free(matrice_c);
|
((real8 *) matrice_b)[i] = 0; |
| free(work);
|
} |
| free(jpvt);
|
|
|
|
dgelsy_(&nombre_lignes_a, &nombre_colonnes_a, |
| if (erreur < 0)
|
&nombre_colonnes_b, matrice_c, &nombre_lignes_a, |
| {
|
matrice_b, &nombre_lignes_b, jpvt, &rcond, &rang, |
| (*s_etat_processus).erreur_execution =
|
work, &lwork, &erreur); |
| d_ex_routines_mathematiques;
|
|
|
|
lwork = (integer4) ((real8 *) work)[0]; |
| free(matrice_f77);
|
free(work); |
| return(-1);
|
|
| }
|
if ((work = malloc(((size_t) lwork) * sizeof(real8))) == NULL) |
| }
|
{ |
| else
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| {
|
return(-1); |
| anorme = zlange_(&norme, &nombre_lignes_a, &nombre_colonnes_a,
|
} |
| matrice_f77, &nombre_lignes_a, work, longueur);
|
|
|
|
dgelsy_(&nombre_lignes_a, &nombre_colonnes_a, |
| #ifndef NORME_I
|
&nombre_colonnes_b, matrice_c, &nombre_lignes_a, |
| free(work);
|
matrice_b, &nombre_lignes_b, jpvt, &rcond, &rang, |
| #endif
|
work, &lwork, &erreur); |
|
|
|
| if ((matrice_c = malloc(nombre_lignes_a * nombre_colonnes_a *
|
free(matrice_b); |
| sizeof(complex16))) == NULL)
|
free(matrice_c); |
| {
|
free(work); |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
free(jpvt); |
| return(-1);
|
|
| }
|
if (erreur < 0) |
|
|
{ |
| memcpy(matrice_c, matrice_f77, nombre_lignes_a * nombre_colonnes_a *
|
(*s_etat_processus).erreur_execution = |
| sizeof(complex16));
|
d_ex_routines_mathematiques; |
|
|
|
| zgetrf_(&nombre_lignes_a, &nombre_colonnes_a, matrice_f77,
|
free(matrice_f77); |
| &nombre_lignes_a, pivot, &erreur);
|
return(-1); |
|
|
} |
| if (erreur < 0)
|
} |
| {
|
else |
| (*s_etat_processus).erreur_execution =
|
{ |
| d_ex_routines_mathematiques;
|
anorme = zlange_(&norme, &nombre_lignes_a, &nombre_colonnes_a, |
|
|
matrice_f77, &nombre_lignes_a, work, longueur); |
| free(matrice_f77);
|
|
| return(-1);
|
#ifndef NORME_I |
| }
|
free(work); |
|
|
#endif |
| if ((rwork = malloc(2 * nombre_colonnes_a * sizeof(real8))) == NULL)
|
|
| {
|
if ((matrice_c = malloc(((size_t) (nombre_lignes_a * nombre_colonnes_a)) |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
* sizeof(complex16))) == NULL) |
| return(-1);
|
{ |
| }
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
|
|
return(-1); |
| if ((work = malloc(2 * nombre_colonnes_a * sizeof(complex16))) == NULL)
|
} |
| {
|
|
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
memcpy(matrice_c, matrice_f77, ((size_t) (nombre_lignes_a * |
| return(-1);
|
nombre_colonnes_a)) * sizeof(complex16)); |
| }
|
|
|
|
zgetrf_(&nombre_lignes_a, &nombre_colonnes_a, matrice_f77, |
| ordre = (nombre_lignes_a > nombre_colonnes_a)
|
&nombre_lignes_a, pivot, &erreur); |
| ? nombre_colonnes_a : nombre_lignes_a;
|
|
|
|
if (erreur < 0) |
| zgecon_(&norme, &ordre, matrice_f77,
|
{ |
| &nombre_lignes_a, &anorme, &rcond, work, rwork, &erreur,
|
(*s_etat_processus).erreur_execution = |
| longueur);
|
d_ex_routines_mathematiques; |
|
|
|
| free(work);
|
free(matrice_f77); |
|
|
return(-1); |
| if (erreur < 0)
|
} |
| {
|
|
| (*s_etat_processus).erreur_execution =
|
if ((rwork = malloc(2 * ((size_t) nombre_colonnes_a) * sizeof(real8))) |
| d_ex_routines_mathematiques;
|
== NULL) |
|
|
{ |
| free(matrice_f77);
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return(-1);
|
return(-1); |
| }
|
} |
|
|
|
| if ((jpvt = malloc(nombre_colonnes_a * sizeof(integer4))) == NULL)
|
if ((work = malloc(2 * ((size_t) nombre_colonnes_a) * |
| {
|
sizeof(complex16))) == NULL) |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
{ |
| return(-1);
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| }
|
return(-1); |
|
|
} |
| for(i = 0; i < (unsigned long) nombre_colonnes_a; i++)
|
|
| {
|
ordre = (nombre_lignes_a > nombre_colonnes_a) |
| ((integer4 *) jpvt)[i] = 0;
|
? nombre_colonnes_a : nombre_lignes_a; |
| }
|
|
|
|
zgecon_(&norme, &ordre, matrice_f77, |
| lwork = -1;
|
&nombre_lignes_a, &anorme, &rcond, work, rwork, &erreur, |
|
|
longueur); |
| if ((work = malloc(sizeof(complex16))) == NULL)
|
|
| {
|
free(work); |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
|
| return(-1);
|
if (erreur < 0) |
| }
|
{ |
|
|
(*s_etat_processus).erreur_execution = |
| nombre_colonnes_b = 1;
|
d_ex_routines_mathematiques; |
| nombre_lignes_b = (nombre_lignes_a > nombre_colonnes_a)
|
|
| ? nombre_lignes_a : nombre_colonnes_a;
|
free(matrice_f77); |
|
|
return(-1); |
| if ((matrice_b = malloc(nombre_lignes_b * sizeof(complex16))) == NULL)
|
} |
| {
|
|
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
if ((jpvt = malloc(((size_t) nombre_colonnes_a) * sizeof(integer4))) |
| return(-1);
|
== NULL) |
| }
|
{ |
|
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| for(i = 0; i < (unsigned long) nombre_lignes_b; i++)
|
return(-1); |
| {
|
} |
| ((complex16 *) matrice_b)[i].partie_reelle = 0;
|
|
| ((complex16 *) matrice_b)[i].partie_imaginaire = 0;
|
for(i = 0; i < nombre_colonnes_a; i++) |
| }
|
{ |
|
|
((integer4 *) jpvt)[i] = 0; |
| zgelsy_(&nombre_lignes_a, &nombre_colonnes_a,
|
} |
| &nombre_colonnes_b, matrice_c, &nombre_lignes_a,
|
|
| matrice_b, &nombre_lignes_b, jpvt, &rcond, &rang,
|
lwork = -1; |
| work, &lwork, rwork, &erreur);
|
|
|
|
if ((work = malloc(sizeof(complex16))) == NULL) |
| lwork = ((complex16 *) work)[0].partie_reelle;
|
{ |
| free(work);
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
|
|
return(-1); |
| if ((work = malloc(lwork * sizeof(complex16))) == NULL)
|
} |
| {
|
|
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
nombre_colonnes_b = 1; |
| return(-1);
|
nombre_lignes_b = (nombre_lignes_a > nombre_colonnes_a) |
| }
|
? nombre_lignes_a : nombre_colonnes_a; |
|
|
|
| zgelsy_(&nombre_lignes_a, &nombre_colonnes_a,
|
if ((matrice_b = malloc(((size_t) nombre_lignes_b) * |
| &nombre_colonnes_b, matrice_c, &nombre_lignes_a,
|
sizeof(complex16))) == NULL) |
| matrice_b, &nombre_lignes_b, jpvt, &rcond, &rang,
|
{ |
| work, &lwork, rwork, &erreur);
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
|
|
return(-1); |
| free(rwork);
|
} |
| free(matrice_b);
|
|
| free(matrice_c);
|
for(i = 0; i < nombre_lignes_b; i++) |
| free(work);
|
{ |
| free(jpvt);
|
((complex16 *) matrice_b)[i].partie_reelle = 0; |
|
|
((complex16 *) matrice_b)[i].partie_imaginaire = 0; |
| if (erreur < 0)
|
} |
| {
|
|
| (*s_etat_processus).erreur_execution =
|
zgelsy_(&nombre_lignes_a, &nombre_colonnes_a, |
| d_ex_routines_mathematiques;
|
&nombre_colonnes_b, matrice_c, &nombre_lignes_a, |
|
|
matrice_b, &nombre_lignes_b, jpvt, &rcond, &rang, |
| free(matrice_f77);
|
work, &lwork, rwork, &erreur); |
| return(-1);
|
|
| }
|
lwork = (integer4) ((complex16 *) work)[0].partie_reelle; |
| }
|
free(work); |
|
|
|
| return(rang);
|
if ((work = malloc(((size_t) lwork) * sizeof(complex16))) == NULL) |
| }
|
{ |
|
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
|
|
return(-1); |
| void
|
} |
| determinant(struct_processus *s_etat_processus, struct_matrice *s_matrice,
|
|
| void *valeur)
|
zgelsy_(&nombre_lignes_a, &nombre_colonnes_a, |
| {
|
&nombre_colonnes_b, matrice_c, &nombre_lignes_a, |
| complex16 *vecteur_complexe;
|
matrice_b, &nombre_lignes_b, jpvt, &rcond, &rang, |
|
|
work, &lwork, rwork, &erreur); |
| integer4 dimension_vecteur_pivot;
|
|
| integer4 nombre_colonnes_a;
|
free(rwork); |
| integer4 nombre_lignes_a;
|
free(matrice_b); |
| integer4 *pivot;
|
free(matrice_c); |
| integer4 rang;
|
free(work); |
|
|
free(jpvt); |
| integer8 signe;
|
|
|
|
if (erreur < 0) |
| real8 *vecteur_reel;
|
{ |
|
|
(*s_etat_processus).erreur_execution = |
| unsigned long i;
|
d_ex_routines_mathematiques; |
| unsigned long j;
|
|
| unsigned long k;
|
free(matrice_f77); |
| unsigned long taille_matrice_f77;
|
return(-1); |
|
|
} |
| void *matrice_f77;
|
} |
|
|
|
| nombre_lignes_a = (integer4) (*s_matrice).nombre_lignes;
|
return(rang); |
| nombre_colonnes_a = (integer4) (*s_matrice).nombre_colonnes;
|
} |
| dimension_vecteur_pivot = (nombre_lignes_a < nombre_colonnes_a)
|
|
| ? nombre_lignes_a : nombre_colonnes_a;
|
|
| taille_matrice_f77 = nombre_lignes_a * nombre_colonnes_a;
|
void |
|
|
determinant(struct_processus *s_etat_processus, struct_matrice *s_matrice, |
| switch((*s_matrice).type)
|
void *valeur) |
| {
|
{ |
| case 'I' :
|
complex16 *vecteur_complexe; |
| {
|
|
| if ((matrice_f77 = (void *) malloc(taille_matrice_f77 *
|
integer4 dimension_vecteur_pivot; |
| sizeof(real8))) == NULL)
|
integer4 nombre_colonnes_a; |
| {
|
integer4 nombre_lignes_a; |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
integer4 *pivot; |
| return;
|
integer4 rang; |
| }
|
|
|
|
integer8 i; |
| for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
integer8 j; |
| {
|
integer8 k; |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
integer8 signe; |
| {
|
integer8 taille_matrice_f77; |
| ((real8 *) matrice_f77)[k++] = ((integer8 **)
|
|
| (*s_matrice).tableau)[j][i];
|
real8 *vecteur_reel; |
| }
|
|
| }
|
void *matrice_f77; |
|
|
|
| if ((pivot = (integer4 *) malloc(dimension_vecteur_pivot *
|
nombre_lignes_a = (integer4) (*s_matrice).nombre_lignes; |
| sizeof(integer4))) == NULL)
|
nombre_colonnes_a = (integer4) (*s_matrice).nombre_colonnes; |
| {
|
dimension_vecteur_pivot = (nombre_lignes_a < nombre_colonnes_a) |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
? nombre_lignes_a : nombre_colonnes_a; |
| return;
|
taille_matrice_f77 = nombre_lignes_a * nombre_colonnes_a; |
| }
|
|
|
|
switch((*s_matrice).type) |
| if ((rang = calcul_rang(s_etat_processus, matrice_f77,
|
{ |
| nombre_lignes_a, nombre_colonnes_a, pivot,
|
case 'I' : |
| dimension_vecteur_pivot, 'R')) < 0)
|
{ |
| {
|
if ((matrice_f77 = malloc(((size_t) taille_matrice_f77) * |
| return;
|
sizeof(real8))) == NULL) |
| }
|
{ |
|
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| if (rang < nombre_lignes_a)
|
return; |
| {
|
} |
| (*((real8 *) valeur)) = 0;
|
|
| }
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| else
|
{ |
| {
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| if ((vecteur_reel = malloc((*s_matrice).nombre_colonnes *
|
{ |
| sizeof(real8))) == NULL)
|
((real8 *) matrice_f77)[k++] = (real8) ((integer8 **) |
| {
|
(*s_matrice).tableau)[j][i]; |
| (*s_etat_processus).erreur_systeme =
|
} |
| d_es_allocation_memoire;
|
} |
| return;
|
|
| }
|
if ((pivot = (integer4 *) malloc(((size_t) dimension_vecteur_pivot) |
|
|
* sizeof(integer4))) == NULL) |
| signe = 1;
|
{ |
|
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| for(i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
return; |
| {
|
} |
| if ((unsigned long) pivot[i] != (i + 1))
|
|
| {
|
if ((rang = calcul_rang(s_etat_processus, matrice_f77, |
| signe = (signe == 1) ? -1 : 1;
|
nombre_lignes_a, nombre_colonnes_a, pivot, |
| }
|
dimension_vecteur_pivot, 'R')) < 0) |
|
|
{ |
| vecteur_reel[i] = ((real8 *) matrice_f77)
|
return; |
| [(i * nombre_colonnes_a) + i];
|
} |
| }
|
|
|
|
if (rang < nombre_lignes_a) |
| for(i = 1; i < (*s_matrice).nombre_colonnes; i++)
|
{ |
| {
|
(*((real8 *) valeur)) = 0; |
| vecteur_reel[0] *= vecteur_reel[i];
|
} |
| }
|
else |
|
|
{ |
| (*((real8 *) valeur)) = vecteur_reel[0] * signe;
|
if ((vecteur_reel = malloc(((size_t) ((*s_matrice) |
|
|
.nombre_colonnes)) * sizeof(real8))) == NULL) |
| free(vecteur_reel);
|
{ |
| }
|
(*s_etat_processus).erreur_systeme = |
|
|
d_es_allocation_memoire; |
| free(matrice_f77);
|
return; |
| free(pivot);
|
} |
|
|
|
| break;
|
signe = 1; |
| }
|
|
|
|
for(i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| case 'R' :
|
{ |
| {
|
if (pivot[i] != (i + 1)) |
| if ((matrice_f77 = (void *) malloc(taille_matrice_f77 *
|
{ |
| sizeof(real8))) == NULL)
|
signe = (signe == 1) ? -1 : 1; |
| {
|
} |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
|
| return;
|
vecteur_reel[i] = ((real8 *) matrice_f77) |
| }
|
[(i * nombre_colonnes_a) + i]; |
|
|
} |
| for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
|
| {
|
for(i = 1; i < (*s_matrice).nombre_colonnes; i++) |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
{ |
| {
|
vecteur_reel[0] *= vecteur_reel[i]; |
| ((real8 *) matrice_f77)[k++] = ((real8 **)
|
} |
| (*s_matrice).tableau)[j][i];
|
|
| }
|
(*((real8 *) valeur)) = vecteur_reel[0] * ((real8) signe); |
| }
|
free(vecteur_reel); |
|
|
} |
| if ((pivot = (integer4 *) malloc(dimension_vecteur_pivot *
|
|
| sizeof(integer4))) == NULL)
|
free(matrice_f77); |
| {
|
free(pivot); |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
|
| return;
|
break; |
| }
|
} |
|
|
|
| if ((rang = calcul_rang(s_etat_processus, matrice_f77,
|
case 'R' : |
| nombre_lignes_a, nombre_colonnes_a, pivot,
|
{ |
| dimension_vecteur_pivot, 'R')) < 0)
|
if ((matrice_f77 = malloc(((size_t) taille_matrice_f77) * |
| {
|
sizeof(real8))) == NULL) |
| return;
|
{ |
| }
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
|
|
return; |
| if (rang < nombre_lignes_a)
|
} |
| {
|
|
| (*((real8 *) valeur)) = 0;
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| }
|
{ |
| else
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| {
|
{ |
| if ((vecteur_reel = malloc((*s_matrice).nombre_colonnes *
|
((real8 *) matrice_f77)[k++] = ((real8 **) |
| sizeof(real8))) == NULL)
|
(*s_matrice).tableau)[j][i]; |
| {
|
} |
| (*s_etat_processus).erreur_systeme =
|
} |
| d_es_allocation_memoire;
|
|
| return;
|
if ((pivot = (integer4 *) malloc(((size_t) dimension_vecteur_pivot) |
| }
|
* sizeof(integer4))) == NULL) |
|
|
{ |
| signe = 1;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
|
|
return; |
| for(i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
} |
| {
|
|
| if ((unsigned long) pivot[i] != (i + 1))
|
if ((rang = calcul_rang(s_etat_processus, matrice_f77, |
| {
|
nombre_lignes_a, nombre_colonnes_a, pivot, |
| signe = (signe == 1) ? -1 : 1;
|
dimension_vecteur_pivot, 'R')) < 0) |
| }
|
{ |
|
|
return; |
| vecteur_reel[i] = ((real8 *) matrice_f77)
|
} |
| [(i * nombre_colonnes_a) + i];
|
|
| }
|
if (rang < nombre_lignes_a) |
|
|
{ |
| for(i = 1; i < (*s_matrice).nombre_colonnes; i++)
|
(*((real8 *) valeur)) = 0; |
| {
|
} |
| vecteur_reel[0] *= vecteur_reel[i];
|
else |
| }
|
{ |
|
|
if ((vecteur_reel = malloc(((size_t) (*s_matrice) |
| (*((real8 *) valeur)) = vecteur_reel[0] * signe;
|
.nombre_colonnes) * sizeof(real8))) == NULL) |
|
|
{ |
| free(vecteur_reel);
|
(*s_etat_processus).erreur_systeme = |
| }
|
d_es_allocation_memoire; |
|
|
return; |
| free(matrice_f77);
|
} |
| free(pivot);
|
|
|
|
signe = 1; |
| break;
|
|
| }
|
for(i = 0; i < (*s_matrice).nombre_colonnes; i++) |
|
|
{ |
| case 'C' :
|
if (pivot[i] != (i + 1)) |
| {
|
{ |
| if ((matrice_f77 = (void *) malloc(taille_matrice_f77 *
|
signe = (signe == 1) ? -1 : 1; |
| sizeof(complex16))) == NULL)
|
} |
| {
|
|
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
vecteur_reel[i] = ((real8 *) matrice_f77) |
| return;
|
[(i * nombre_colonnes_a) + i]; |
| }
|
} |
|
|
|
| for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
for(i = 1; i < (*s_matrice).nombre_colonnes; i++) |
| {
|
{ |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
vecteur_reel[0] *= vecteur_reel[i]; |
| {
|
} |
| ((complex16 *) matrice_f77)[k++] = ((complex16 **)
|
|
| (*s_matrice).tableau)[j][i];
|
(*((real8 *) valeur)) = vecteur_reel[0] * ((real8) signe); |
| }
|
|
| }
|
free(vecteur_reel); |
|
|
} |
| if ((pivot = (integer4 *) malloc(dimension_vecteur_pivot *
|
|
| sizeof(integer4))) == NULL)
|
free(matrice_f77); |
| {
|
free(pivot); |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
|
| return;
|
break; |
| }
|
} |
|
|
|
| if ((rang = calcul_rang(s_etat_processus, matrice_f77,
|
case 'C' : |
| nombre_lignes_a, nombre_colonnes_a, pivot,
|
{ |
| dimension_vecteur_pivot, 'C')) < 0)
|
if ((matrice_f77 = malloc(((size_t) taille_matrice_f77) * |
| {
|
sizeof(complex16))) == NULL) |
| return;
|
{ |
| }
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
|
|
return; |
| if (rang < nombre_lignes_a)
|
} |
| {
|
|
| (*((complex16 *) valeur)).partie_reelle = 0;
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| (*((complex16 *) valeur)).partie_imaginaire = 0;
|
{ |
| }
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| else
|
{ |
| {
|
((complex16 *) matrice_f77)[k++] = ((complex16 **) |
| if ((vecteur_complexe = malloc((*s_matrice).nombre_colonnes *
|
(*s_matrice).tableau)[j][i]; |
| sizeof(complex16))) == NULL)
|
} |
| {
|
} |
| (*s_etat_processus).erreur_systeme =
|
|
| d_es_allocation_memoire;
|
if ((pivot = (integer4 *) malloc(((size_t) dimension_vecteur_pivot) |
| return;
|
* sizeof(integer4))) == NULL) |
| }
|
{ |
|
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| signe = 1;
|
return; |
|
|
} |
| for(i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
|
| {
|
if ((rang = calcul_rang(s_etat_processus, matrice_f77, |
| if ((unsigned long) pivot[i] != (i + 1))
|
nombre_lignes_a, nombre_colonnes_a, pivot, |
| {
|
dimension_vecteur_pivot, 'C')) < 0) |
| signe = (signe == 1) ? -1 : 1;
|
{ |
| }
|
return; |
|
|
} |
| vecteur_complexe[i] = ((complex16 *) matrice_f77)
|
|
| [(i * nombre_colonnes_a) + i];
|
if (rang < nombre_lignes_a) |
| }
|
{ |
|
|
(*((complex16 *) valeur)).partie_reelle = 0; |
| for(i = 1; i < (*s_matrice).nombre_colonnes; i++)
|
(*((complex16 *) valeur)).partie_imaginaire = 0; |
| {
|
} |
| f77multiplicationcc_(&(vecteur_complexe[0]),
|
else |
| &(vecteur_complexe[i]), &(vecteur_complexe[0]));
|
{ |
| }
|
if ((vecteur_complexe = malloc(((size_t) (*s_matrice) |
|
|
.nombre_colonnes) * sizeof(complex16))) == NULL) |
| f77multiplicationci_(&(vecteur_complexe[0]), &signe,
|
{ |
| ((complex16 *) valeur));
|
(*s_etat_processus).erreur_systeme = |
|
|
d_es_allocation_memoire; |
| free(vecteur_complexe);
|
return; |
| }
|
} |
|
|
|
| free(matrice_f77);
|
signe = 1; |
| free(pivot);
|
|
|
|
for(i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| break;
|
{ |
| }
|
if (pivot[i] != (i + 1)) |
| }
|
{ |
|
|
signe = (signe == 1) ? -1 : 1; |
| return;
|
} |
| }
|
|
|
|
vecteur_complexe[i] = ((complex16 *) matrice_f77) |
|
|
[(i * nombre_colonnes_a) + i]; |
| void
|
} |
| rang(struct_processus *s_etat_processus, struct_matrice *s_matrice,
|
|
| integer8 *valeur)
|
for(i = 1; i < (*s_matrice).nombre_colonnes; i++) |
| {
|
{ |
| integer4 dimension_vecteur_pivot;
|
f77multiplicationcc_(&(vecteur_complexe[0]), |
| integer4 nombre_lignes_a;
|
&(vecteur_complexe[i]), &(vecteur_complexe[0])); |
| integer4 nombre_colonnes_a;
|
} |
| integer4 *pivot;
|
|
| integer4 rang;
|
f77multiplicationci_(&(vecteur_complexe[0]), &signe, |
| integer4 taille_matrice_f77;
|
((complex16 *) valeur)); |
|
|
|
| unsigned long i;
|
free(vecteur_complexe); |
| unsigned long j;
|
} |
| unsigned long k;
|
|
|
|
free(matrice_f77); |
| void *matrice_f77;
|
free(pivot); |
|
|
|
| nombre_lignes_a = (integer4) (*s_matrice).nombre_lignes;
|
break; |
| nombre_colonnes_a = (integer4) (*s_matrice).nombre_colonnes;
|
} |
| dimension_vecteur_pivot = (nombre_lignes_a < nombre_colonnes_a)
|
} |
| ? nombre_lignes_a : nombre_colonnes_a;
|
|
| taille_matrice_f77 = nombre_lignes_a * nombre_colonnes_a;
|
return; |
|
|
} |
| if ((pivot = (integer4 *) malloc(dimension_vecteur_pivot *
|
|
| sizeof(integer4))) == NULL)
|
|
| {
|
void |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
rang(struct_processus *s_etat_processus, struct_matrice *s_matrice, |
| return;
|
integer8 *valeur) |
| }
|
{ |
|
|
integer4 dimension_vecteur_pivot; |
| switch((*s_matrice).type)
|
integer4 nombre_lignes_a; |
| {
|
integer4 nombre_colonnes_a; |
| case 'I' :
|
integer4 *pivot; |
| {
|
integer4 rang; |
| if ((matrice_f77 = (void *) malloc(taille_matrice_f77 *
|
integer4 taille_matrice_f77; |
| sizeof(real8))) == NULL)
|
|
| {
|
integer8 i; |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
integer8 j; |
| return;
|
integer8 k; |
| }
|
|
|
|
void *matrice_f77; |
| for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
|
| {
|
nombre_lignes_a = (integer4) (*s_matrice).nombre_lignes; |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
nombre_colonnes_a = (integer4) (*s_matrice).nombre_colonnes; |
| {
|
dimension_vecteur_pivot = (nombre_lignes_a < nombre_colonnes_a) |
| ((real8 *) matrice_f77)[k++] = ((integer8 **)
|
? nombre_lignes_a : nombre_colonnes_a; |
| (*s_matrice).tableau)[j][i];
|
taille_matrice_f77 = nombre_lignes_a * nombre_colonnes_a; |
| }
|
|
| }
|
if ((pivot = (integer4 *) malloc(((size_t) dimension_vecteur_pivot) * |
|
|
sizeof(integer4))) == NULL) |
| if ((rang = calcul_rang(s_etat_processus, matrice_f77,
|
{ |
| nombre_lignes_a, nombre_colonnes_a, pivot,
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| dimension_vecteur_pivot, 'R')) < 0)
|
return; |
| {
|
} |
| free(pivot);
|
|
| free(matrice_f77);
|
switch((*s_matrice).type) |
| return;
|
{ |
| }
|
case 'I' : |
|
|
{ |
| free(matrice_f77);
|
if ((matrice_f77 = malloc(((size_t) taille_matrice_f77) * |
| (*valeur) = rang;
|
sizeof(real8))) == NULL) |
| break;
|
{ |
| }
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
|
|
return; |
| case 'R' :
|
} |
| {
|
|
| if ((matrice_f77 = (void *) malloc(taille_matrice_f77 *
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| sizeof(real8))) == NULL)
|
{ |
| {
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
{ |
| return;
|
((real8 *) matrice_f77)[k++] = (real8) ((integer8 **) |
| }
|
(*s_matrice).tableau)[j][i]; |
|
|
} |
| for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
} |
| {
|
|
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
if ((rang = calcul_rang(s_etat_processus, matrice_f77, |
| {
|
nombre_lignes_a, nombre_colonnes_a, pivot, |
| ((real8 *) matrice_f77)[k++] = ((real8 **)
|
dimension_vecteur_pivot, 'R')) < 0) |
| (*s_matrice).tableau)[j][i];
|
{ |
| }
|
free(pivot); |
| }
|
free(matrice_f77); |
|
|
return; |
| if ((rang = calcul_rang(s_etat_processus, matrice_f77,
|
} |
| nombre_lignes_a, nombre_colonnes_a, pivot,
|
|
| dimension_vecteur_pivot, 'R')) < 0)
|
free(matrice_f77); |
| {
|
(*valeur) = rang; |
| free(pivot);
|
break; |
| free(matrice_f77);
|
} |
| return;
|
|
| }
|
case 'R' : |
|
|
{ |
| free(matrice_f77);
|
if ((matrice_f77 = malloc(((size_t) taille_matrice_f77) * |
| (*valeur) = rang;
|
sizeof(real8))) == NULL) |
| break;
|
{ |
| }
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
|
|
return; |
| case 'C' :
|
} |
| {
|
|
| if ((matrice_f77 = (void *) malloc(taille_matrice_f77 *
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| sizeof(complex16))) == NULL)
|
{ |
| {
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
{ |
| return;
|
((real8 *) matrice_f77)[k++] = ((real8 **) |
| }
|
(*s_matrice).tableau)[j][i]; |
|
|
} |
| for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
} |
| {
|
|
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
if ((rang = calcul_rang(s_etat_processus, matrice_f77, |
| {
|
nombre_lignes_a, nombre_colonnes_a, pivot, |
| ((complex16 *) matrice_f77)[k++] = ((complex16 **)
|
dimension_vecteur_pivot, 'R')) < 0) |
| (*s_matrice).tableau)[j][i];
|
{ |
| }
|
free(pivot); |
| }
|
free(matrice_f77); |
|
|
return; |
| if ((rang = calcul_rang(s_etat_processus, matrice_f77,
|
} |
| nombre_lignes_a, nombre_colonnes_a, pivot,
|
|
| dimension_vecteur_pivot, 'C')) < 0)
|
free(matrice_f77); |
| {
|
(*valeur) = rang; |
| free(pivot);
|
break; |
| free(matrice_f77);
|
} |
| return;
|
|
| }
|
case 'C' : |
|
|
{ |
| free(matrice_f77);
|
if ((matrice_f77 = malloc(((size_t) taille_matrice_f77) * |
| (*valeur) = rang;
|
sizeof(complex16))) == NULL) |
| break;
|
{ |
| }
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| }
|
return; |
|
|
} |
| free(pivot);
|
|
|
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| return;
|
{ |
| }
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
|
|
{ |
| // vim: ts=4
|
((complex16 *) matrice_f77)[k++] = ((complex16 **) |
| |
(*s_matrice).tableau)[j][i]; |
| |
} |
| |
} |
| |
|
| |
if ((rang = calcul_rang(s_etat_processus, matrice_f77, |
| |
nombre_lignes_a, nombre_colonnes_a, pivot, |
| |
dimension_vecteur_pivot, 'C')) < 0) |
| |
{ |
| |
free(pivot); |
| |
free(matrice_f77); |
| |
return; |
| |
} |
| |
|
| |
free(matrice_f77); |
| |
(*valeur) = rang; |
| |
break; |
| |
} |
| |
} |
| |
|
| |
free(pivot); |
| |
|
| |
return; |
| |
} |
| |
|
| |
// vim: ts=4 |
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to algebre_lineaire3.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src